From 5aff2870390ef35a96fe6927cd58e635693b2173 Mon Sep 17 00:00:00 2001 From: Pierre-Francois Loos Date: Mon, 3 Jul 2023 14:41:46 +0200 Subject: [PATCH] remove eDFT --- src/GF/dSigmaC_GF2.f90 | 2 + src/eDFT.tgz | Bin 0 -> 46814 bytes src/eDFT/AO_values_grid.f90 | 101 ---- src/eDFT/B88_gga_exchange_energy.f90 | 48 -- src/eDFT/B88_gga_exchange_potential.f90 | 73 --- src/eDFT/C16_lda_correlation_energy.f90 | 93 ---- src/eDFT/C16_lda_correlation_potential.f90 | 131 ------ src/eDFT/CC_B88_gga_exchange_energy.f90 | 100 ---- src/eDFT/CC_B88_gga_exchange_potential.f90 | 125 ----- ..._lda_exchange_derivative_discontinuity.f90 | 170 ------- src/eDFT/CC_lda_exchange_energy.f90 | 110 ----- .../CC_lda_exchange_individual_energy.f90 | 131 ------ src/eDFT/CC_lda_exchange_potential.f90 | 119 ----- src/eDFT/G96_gga_exchange_energy.f90 | 48 -- src/eDFT/G96_gga_exchange_potential.f90 | 64 --- src/eDFT/LYP_gga_correlation_energy.f90 | 73 --- src/eDFT/LYP_gga_correlation_potential.f90 | 156 ------- src/eDFT/PBE_gga_correlation_energy.f90 | 172 ------- src/eDFT/PBE_gga_correlation_potential.f90 | 88 ---- src/eDFT/PBE_gga_exchange_energy.f90 | 49 -- src/eDFT/PBE_gga_exchange_potential.f90 | 67 --- src/eDFT/PW92_lda_correlation_energy.f90 | 120 ----- src/eDFT/PW92_lda_correlation_potential.f90 | 185 -------- src/eDFT/S51_lda_exchange_energy.f90 | 34 -- .../S51_lda_exchange_individual_energy.f90 | 61 --- src/eDFT/S51_lda_exchange_potential.f90 | 45 -- src/eDFT/UKS.f90 | 392 ---------------- src/eDFT/VWN3_lda_correlation_energy.f90 | 137 ------ ...VWN3_lda_correlation_individual_energy.f90 | 181 -------- src/eDFT/VWN3_lda_correlation_potential.f90 | 196 -------- src/eDFT/VWN5_lda_correlation_energy.f90 | 137 ------ ...VWN5_lda_correlation_individual_energy.f90 | 184 -------- src/eDFT/VWN5_lda_correlation_potential.f90 | 193 -------- src/eDFT/W38_lda_correlation_energy.f90 | 52 --- .../W38_lda_correlation_individual_energy.f90 | 62 --- src/eDFT/W38_lda_correlation_potential.f90 | 76 --- src/eDFT/allocate_grid.f90 | 57 --- src/eDFT/auxiliary_energy.f90 | 55 --- src/eDFT/build_grid.f90 | 107 ----- .../correlation_derivative_discontinuity.f90 | 59 --- src/eDFT/correlation_energy.f90 | 59 --- src/eDFT/correlation_individual_energy.f90 | 62 --- src/eDFT/correlation_potential.f90 | 68 --- src/eDFT/density.f90 | 38 -- src/eDFT/density_matrix.f90 | 48 -- src/eDFT/eDFT.f90 | 201 -------- src/eDFT/elda_correlation_energy.f90 | 69 --- .../elda_correlation_individual_energy.f90 | 57 --- src/eDFT/elda_correlation_potential.f90 | 70 --- src/eDFT/electron_number.f90 | 20 - .../exchange_derivative_discontinuity.f90 | 67 --- src/eDFT/exchange_energy.f90 | 69 --- src/eDFT/exchange_individual_energy.f90 | 71 --- src/eDFT/exchange_potential.f90 | 80 ---- src/eDFT/fock_exchange_energy.f90 | 25 - src/eDFT/fock_exchange_individual_energy.f90 | 46 -- src/eDFT/fock_exchange_potential.f90 | 34 -- src/eDFT/generate_shell.f90 | 32 -- ...a_correlation_derivative_discontinuity.f90 | 44 -- src/eDFT/gga_correlation_energy.f90 | 44 -- src/eDFT/gga_correlation_potential.f90 | 46 -- .../gga_exchange_derivative_discontinuity.f90 | 48 -- src/eDFT/gga_exchange_energy.f90 | 53 --- src/eDFT/gga_exchange_individual_energy.f90 | 36 -- src/eDFT/gga_exchange_potential.f90 | 57 --- src/eDFT/gradient_density.f90 | 45 -- src/eDFT/hartree_energy.f90 | 29 -- src/eDFT/hartree_individual_energy.f90 | 55 --- src/eDFT/hartree_potential.f90 | 33 -- ...d_correlation_derivative_discontinuity.f90 | 46 -- src/eDFT/hybrid_correlation_energy.f90 | 58 --- .../hybrid_correlation_individual_energy.f90 | 42 -- src/eDFT/hybrid_correlation_potential.f90 | 69 --- ...brid_exchange_derivative_discontinuity.f90 | 53 --- src/eDFT/hybrid_exchange_energy.f90 | 77 ---- .../hybrid_exchange_individual_energy.f90 | 46 -- src/eDFT/hybrid_exchange_potential.f90 | 91 ---- src/eDFT/individual_energy.f90 | 241 ---------- ...a_correlation_derivative_discontinuity.f90 | 52 --- src/eDFT/lda_correlation_energy.f90 | 52 --- .../lda_correlation_individual_energy.f90 | 51 --- src/eDFT/lda_correlation_potential.f90 | 56 --- .../lda_exchange_derivative_discontinuity.f90 | 51 --- src/eDFT/lda_exchange_energy.f90 | 46 -- src/eDFT/lda_exchange_individual_energy.f90 | 49 -- src/eDFT/lda_exchange_potential.f90 | 49 -- ...a_correlation_derivative_discontinuity.f90 | 34 -- src/eDFT/mgga_correlation_energy.f90 | 36 -- src/eDFT/mgga_correlation_potential.f90 | 38 -- ...mgga_exchange_derivative_discontinuity.f90 | 36 -- src/eDFT/mgga_exchange_energy.f90 | 32 -- src/eDFT/mgga_exchange_individual_energy.f90 | 36 -- src/eDFT/mgga_exchange_potential.f90 | 36 -- src/eDFT/obj/.gitignore | 1 - src/eDFT/one_electron_density.f90 | 47 -- src/eDFT/print_UKS.f90 | 167 ------- src/eDFT/print_individual_energy.f90 | 246 ---------- src/eDFT/read_grid.f90 | 49 -- src/eDFT/read_options_dft.f90 | 431 ------------------ src/eDFT/select_rung.f90 | 49 -- src/eDFT/xc_potential.f90 | 40 -- src/eDFT/xc_potential_grid.f90 | 54 --- 102 files changed, 2 insertions(+), 8318 deletions(-) create mode 100644 src/eDFT.tgz delete mode 100644 src/eDFT/AO_values_grid.f90 delete mode 100644 src/eDFT/B88_gga_exchange_energy.f90 delete mode 100644 src/eDFT/B88_gga_exchange_potential.f90 delete mode 100644 src/eDFT/C16_lda_correlation_energy.f90 delete mode 100644 src/eDFT/C16_lda_correlation_potential.f90 delete mode 100644 src/eDFT/CC_B88_gga_exchange_energy.f90 delete mode 100644 src/eDFT/CC_B88_gga_exchange_potential.f90 delete mode 100644 src/eDFT/CC_lda_exchange_derivative_discontinuity.f90 delete mode 100644 src/eDFT/CC_lda_exchange_energy.f90 delete mode 100644 src/eDFT/CC_lda_exchange_individual_energy.f90 delete mode 100644 src/eDFT/CC_lda_exchange_potential.f90 delete mode 100644 src/eDFT/G96_gga_exchange_energy.f90 delete mode 100644 src/eDFT/G96_gga_exchange_potential.f90 delete mode 100644 src/eDFT/LYP_gga_correlation_energy.f90 delete mode 100644 src/eDFT/LYP_gga_correlation_potential.f90 delete mode 100644 src/eDFT/PBE_gga_correlation_energy.f90 delete mode 100644 src/eDFT/PBE_gga_correlation_potential.f90 delete mode 100644 src/eDFT/PBE_gga_exchange_energy.f90 delete mode 100644 src/eDFT/PBE_gga_exchange_potential.f90 delete mode 100644 src/eDFT/PW92_lda_correlation_energy.f90 delete mode 100644 src/eDFT/PW92_lda_correlation_potential.f90 delete mode 100644 src/eDFT/S51_lda_exchange_energy.f90 delete mode 100644 src/eDFT/S51_lda_exchange_individual_energy.f90 delete mode 100644 src/eDFT/S51_lda_exchange_potential.f90 delete mode 100644 src/eDFT/UKS.f90 delete mode 100644 src/eDFT/VWN3_lda_correlation_energy.f90 delete mode 100644 src/eDFT/VWN3_lda_correlation_individual_energy.f90 delete mode 100644 src/eDFT/VWN3_lda_correlation_potential.f90 delete mode 100644 src/eDFT/VWN5_lda_correlation_energy.f90 delete mode 100644 src/eDFT/VWN5_lda_correlation_individual_energy.f90 delete mode 100644 src/eDFT/VWN5_lda_correlation_potential.f90 delete mode 100644 src/eDFT/W38_lda_correlation_energy.f90 delete mode 100644 src/eDFT/W38_lda_correlation_individual_energy.f90 delete mode 100644 src/eDFT/W38_lda_correlation_potential.f90 delete mode 100644 src/eDFT/allocate_grid.f90 delete mode 100644 src/eDFT/auxiliary_energy.f90 delete mode 100644 src/eDFT/build_grid.f90 delete mode 100644 src/eDFT/correlation_derivative_discontinuity.f90 delete mode 100644 src/eDFT/correlation_energy.f90 delete mode 100644 src/eDFT/correlation_individual_energy.f90 delete mode 100644 src/eDFT/correlation_potential.f90 delete mode 100644 src/eDFT/density.f90 delete mode 100644 src/eDFT/density_matrix.f90 delete mode 100644 src/eDFT/eDFT.f90 delete mode 100644 src/eDFT/elda_correlation_energy.f90 delete mode 100644 src/eDFT/elda_correlation_individual_energy.f90 delete mode 100644 src/eDFT/elda_correlation_potential.f90 delete mode 100644 src/eDFT/electron_number.f90 delete mode 100644 src/eDFT/exchange_derivative_discontinuity.f90 delete mode 100644 src/eDFT/exchange_energy.f90 delete mode 100644 src/eDFT/exchange_individual_energy.f90 delete mode 100644 src/eDFT/exchange_potential.f90 delete mode 100644 src/eDFT/fock_exchange_energy.f90 delete mode 100644 src/eDFT/fock_exchange_individual_energy.f90 delete mode 100644 src/eDFT/fock_exchange_potential.f90 delete mode 100644 src/eDFT/generate_shell.f90 delete mode 100644 src/eDFT/gga_correlation_derivative_discontinuity.f90 delete mode 100644 src/eDFT/gga_correlation_energy.f90 delete mode 100644 src/eDFT/gga_correlation_potential.f90 delete mode 100644 src/eDFT/gga_exchange_derivative_discontinuity.f90 delete mode 100644 src/eDFT/gga_exchange_energy.f90 delete mode 100644 src/eDFT/gga_exchange_individual_energy.f90 delete mode 100644 src/eDFT/gga_exchange_potential.f90 delete mode 100644 src/eDFT/gradient_density.f90 delete mode 100644 src/eDFT/hartree_energy.f90 delete mode 100644 src/eDFT/hartree_individual_energy.f90 delete mode 100644 src/eDFT/hartree_potential.f90 delete mode 100644 src/eDFT/hybrid_correlation_derivative_discontinuity.f90 delete mode 100644 src/eDFT/hybrid_correlation_energy.f90 delete mode 100644 src/eDFT/hybrid_correlation_individual_energy.f90 delete mode 100644 src/eDFT/hybrid_correlation_potential.f90 delete mode 100644 src/eDFT/hybrid_exchange_derivative_discontinuity.f90 delete mode 100644 src/eDFT/hybrid_exchange_energy.f90 delete mode 100644 src/eDFT/hybrid_exchange_individual_energy.f90 delete mode 100644 src/eDFT/hybrid_exchange_potential.f90 delete mode 100644 src/eDFT/individual_energy.f90 delete mode 100644 src/eDFT/lda_correlation_derivative_discontinuity.f90 delete mode 100644 src/eDFT/lda_correlation_energy.f90 delete mode 100644 src/eDFT/lda_correlation_individual_energy.f90 delete mode 100644 src/eDFT/lda_correlation_potential.f90 delete mode 100644 src/eDFT/lda_exchange_derivative_discontinuity.f90 delete mode 100644 src/eDFT/lda_exchange_energy.f90 delete mode 100644 src/eDFT/lda_exchange_individual_energy.f90 delete mode 100644 src/eDFT/lda_exchange_potential.f90 delete mode 100644 src/eDFT/mgga_correlation_derivative_discontinuity.f90 delete mode 100644 src/eDFT/mgga_correlation_energy.f90 delete mode 100644 src/eDFT/mgga_correlation_potential.f90 delete mode 100644 src/eDFT/mgga_exchange_derivative_discontinuity.f90 delete mode 100644 src/eDFT/mgga_exchange_energy.f90 delete mode 100644 src/eDFT/mgga_exchange_individual_energy.f90 delete mode 100644 src/eDFT/mgga_exchange_potential.f90 delete mode 100644 src/eDFT/obj/.gitignore delete mode 100644 src/eDFT/one_electron_density.f90 delete mode 100644 src/eDFT/print_UKS.f90 delete mode 100644 src/eDFT/print_individual_energy.f90 delete mode 100644 src/eDFT/read_grid.f90 delete mode 100644 src/eDFT/read_options_dft.f90 delete mode 100644 src/eDFT/select_rung.f90 delete mode 100644 src/eDFT/xc_potential.f90 delete mode 100644 src/eDFT/xc_potential_grid.f90 diff --git a/src/GF/dSigmaC_GF2.f90 b/src/GF/dSigmaC_GF2.f90 index 4400584..bf7a74f 100644 --- a/src/GF/dSigmaC_GF2.f90 +++ b/src/GF/dSigmaC_GF2.f90 @@ -19,7 +19,9 @@ double precision function dSigmaC_GF2(p,w,eta,nBas,nC,nO,nV,nR,nS,eHF,ERI) integer :: i,j,a,b double precision :: eps +! Initialize + dSigmaC_GF2 = 0d0 ! Occupied part of the correlation self-energy do i=nC+1,nO diff --git a/src/eDFT.tgz b/src/eDFT.tgz new file mode 100644 index 0000000000000000000000000000000000000000..ae7c4bd6c5ed211a703dc8bb089869e908ce6f2d GIT binary patch literal 46814 zcmV)vK$X8AiwFR4!J=dU1MIzNciXtKD0;qL{|e^Zy`CwVvPDvZopt-H<@OMJcRI<5 z)9K-h7OBC}Zd+0`#EO6Yt15sb0D>ea$%>N}x+9YyP?!pZLZMLAKfnBN^j}XK>h*fN z*|g|yi~X&84fdA@%WX88^`_r$z=yi)wp;E0vYJm^FA9s(%Zsum!E|no2lP29 z%94uO+q10U{p4=g9nP)Mc+|)DQTJ}q>s$K(Ah_?(`_tLsr+qB&dIaTJUxMi{2=Dqc z$~>C)Z~IdR|BmMNa8$8`@baYvZ81rP&4qNm@d6-QlWD&@oIzXU43G|c#Ky!GBdFMQ zMqsITZAxD;$$;a)k~^c>1fsEjUXQ!Mo!CDwthbAKs?V~31Ey36_(j(Spbl#$0J-Vk z^}BOvj0cNR7axKuRjPD zck?J2bj2OC5!%*y2&SXq=+@qU@#2Mb#jsP~7{I}~6?_SXci3ANq~EV_c(eI2O|rdh%zvW){kvWuRcSct4ZjR~i{P%)AN8lVE0O&;6wrUK={FVn@A@r& zNB_4G1k^0X0y}tpsUi08qZ0hr=cm&ANkCZ)6q0?fc6&FzA1>~#!FWmpXuO!gEDGkF za<4=73+W@Y1xdy;qtRxWis^dXEK45%&hV9{v{b5T;8@cT{+T7dcBUcxyEaMP?{+3m z@3PyQuDK3LsMl9@a$u0HI@KirSoB(*3Y>w5!_WR6L^F2y3W~d~a$IB`2kZ85 z5H07u@t(Sp7n94aEZ}PfTL15FZ{?9x|7b74>^XafV@As@ngE z5ijuhTS&v5T?Q(a+taBFLB_oK9;iR3{~v#U)9k3r+2+=O0{Y)-*IkwVx4fPFZ!1B- z;~XroQ&c~X;3J^a4ls-8Z=C9Hk??MTdQP3`%vm~*COHDwPA%*BL%$*X!yVQV{(bID z%peR9!hj$Q0Kxzuz#IJg+!>fb2oOR*5CVV@00el0f1f*n5y=P6{n4SlVIK>JpTH#B z;L+)MgU9t(nitl)7!M=qv@FaF*q-X3epqjL?y=iAuOE5mb@+lE4_|8aL$}^IIqqRx z$W!}=ZLi&EP#oWt9k|}%iQn|tW)ylq1-21^9Wb!I*W^H1+BT%EH#`oM#kt3a^=A7x z0vcc>ZKPAy-sW&wl#dCqc$%3*+)@u8X?Cx+ zv(DRCN1J2%#03^agj zu-=&lwByulVwaF=_IWzDr?Yrlyu?n2_+@noHH2ZIzg?Ow^qr3#{;AS4PsJXSgr7Me zDgdj3!&#%W@UJ3l=n)*?O4YXR#<%tohVuw&5pBXD@e#nP2J>KK!^4q{vAlAXiuM2P z33y+N>vBXD`N)yOw0!kA=nn0X56Ph>^dE!ixi8BFooq6UP!~ zPBMR3U(x)TDD!7hQOdAG>Qz2}CY9U*h557otk0 z1v!;xI7O8Yl*$Jcr3^bH?BkUWD!B#9m48gciP)4X%y68&G+k?t)oO!?L!Y50Cage` zDt<5!J0ko@J}FW^qK3jIWpT@&(-??0hdL$^Oi>e~(Uf?-#Tr-sNbr*N> z2INN;CZC-d9ciDP**HK5x8^>rn7SA;AcYCw)3-L^kGUKM(9HIol9^)Rjk&zscg$NG zWAe&J*_TV+5Ab6!7fL8qku?0(Nvo4F!!ze{JWp|UGFUi7U>=D7%br&o z;Q@>Izh*<_|Jsd4bI1Q}BM4J|ed?N=2LY@Mvh?(v+K#0$U};u7y1HLDqlII3fOWr^ zgnj4lU@|c}znMC>&dhVZ09M_ezTF%fbvEt~27qmlYDOCf#LWzbimHsl6OzQr0^AB0 z>-zB-iue(Q3f20d=bkiOk_S_}@i^r0xZYrACeh@OCdPd*pAMJM^K{O1`qm1A*^rtF zEs?d@dt;~|9;q-iq==Cep*?oNFioAV;Mq$2IbWKN;TCoGFsJLFfTQZ6ZXLdR%Dd0s zg}gHlGT$DdKHqU9f)YN%h{Jb5dIEFde&O&ZLN_Tr^b4UO_Du4uXSWUzdX)?7t7psC zH|M9MSQrglmCO3saMjq~NI#L#p*r)9C{{0RvQXfJg&gM;5(Cl$mb**rb?O?S-)$rm zuA_DjfJ{1#C1D>lvQuf?2%c9A&ntxIC-D4Yczy&g)mQ-!kPK+MMUMeYga?_#A*eN^ zF~}K!7=9wJi{5(UJ?Sw+BQ$#feZG7%yZ;eYc$2sOl2FM1HS6mA4{vw>V>>}qXfDD6 zd%76iItKDUx)su+-x9mvR7kePz44na%%uLb-(w7gbFn->PhBxgxXovAu@Jj!Ct7^c zYcs~2?}MoQT2i8C;rY=JnC0xm0)m>#1rP7LDqNPd;qZ%?~MaDm=5Y_0{>?-+6mF~AyCw@~_U#o^v zD}MF$8DT{sVkE82ztvmVrf16l68|?2|MQeKKY6sNTTc z;=%Cuxki7tr_yDwr~AcM(^owc?j~o#0{G1;*uDPqT_<}A8BUr6x+g=A&XzUsIYixiAw$cZ`_V34l7rZQf*u>xZHWo=q zQz!*}8bXW41B(`s>3BqS;B|~P$*ArG*-_z%jWCOX?vvG`FdHVsoXPV+GM`Fu8dYV z>30YC6OwwTsU0Mfq-bg`2m!KlYm&S-=mBv24GojuQgSQ<|Cr?(Qz7sRnR@ix>#?ih z#m1DJ(CIolOim>|8#v?pKGv^)HxD)~DS5{yWrjHXNhJhf zb{o8$Hh4L0kV~+z4Y!eL4=nJ&x(&sSqX_3M+)IRC7!=3CNl_6aDo9i z1yUMD7U*^EJ`gp*3o5-Mnk!Sm6j3#!Jgizbot%sekySAI0!^llQVOH-!$OmIF-4D6 zrv?Q?@MDd8t0-vo1+e~Ak5wvbY^ssb=w?)uP7|zV^>V>fNFtW5Z}&g`$16!BQTz(g4+58)sP_wWUSg*jng(* zs};iLD~wHiN#<-&wV__gB_X1j!h0njp54GM!8Hh~3y)QrsT5JE-j=Oj&9a;94j3Ym z0Ldm|a~o#jcP2bWIoPbL9FftlX#j(8%T@<`(m~CF7h%lw2zn`}eP-|uEL#M~?3$r1 zylDu%7p?$Lu3umk6NGGd68@D$!L0g47q&EbNNCv1pkrC%K`4h5gAm1hM6&89z$(N! zlln1u#%NavPr+xhVmF2PQH!A0BIsE6pkn3BUpBt9&}?jccl1R&&_?(yjz=kCpHn}N zF$f+_x=qk45g;O4K#V~ytttgCWbgv3qVfQt2@eqb$UHzvwAjs24)5uBfMC-+KoHGY zs8vAopgcUee&Kh;1B7ev0O1CCfN;Y+K={pgfY6W!2zNZdv*H0tZuoNQ_k-{NmtAIb zz#*g7;u|wKL2?3JdQVF4iRnWjy(B`DZ9t$bYy(yxRMFc83_++8yR~dV1Sw+>0UCu7 zQiMvsc$@DRZ}a`)t=TVOs$W96U+8>-EdD2}C6MEgnP}m373tv#Avhx#wS-&{+Zs_L z(eqjiJXC?li##iX$qlHS9BQe84bycFjO!fc)Y)*_GU+j!i=6sKFQMT~CJ<3Bw&_hk z#4uJiFOqvcyQ)S7o&QUhwKwbg6+@B!U%T$9=l_kJ{om~b0l)IGfGz>NK0ocmm!nOL zfUJB&Tec1?-pPLb*V4I=RS?lEL9D_3r1t;|4MB)KWTH^8v;FZ6T;@8)J+!hBkkxM@ zat%teyND@u%T3)zq$>e8O}A4(6-GLrknH|$JW&()%B6<0Gb8W?GzQDcVCb_$0d0w^ zYbqCgwIW0~JYYpPPF?f-9m{de0<_5MGs|2zG^t%NL-&!uku>o4x7mTBpt)$Y3f zb6Ffym-aWXu&$_qxb`*vZ@74_Vyu0`D@Fbc)~*yp|9|(7Q|@K9rvF{{J&083|IYvS zmV$sixmcjr|JJB|qc)~=;rk0vYMe=2b@cb)EnwsREaf0JM?ZY09lj~ovt=~3ODJ9k zPS5FgO;YwQyS?eA)ss^uzO#@_r>!h0B+D`d5j}J4bU!0~W3tMJ;RgDqwwN$WsA&&! z7z%u%QelGbvJlx~~qMV*)9g73L?UYON+8Zq`tofp5bdw|iS5G78N8fm6f~50 z)?F^)|EtR!GvKkk5@ZTKX^quxL(Z`AQ-goZalpn{?suYB7=!eHg(9n2D(|hoQnuFz z(pJJ=86>!zOG^lFm7ZV`4g!w70RT_WIwj zyTXB4YS8ZgHf#m1VE@Tb&ad#k?N|7|1W%&rynzBtW6 zic(%JL+2V^cF2*v+Y?TdcU!&PR?m35rn2Dwh;5fV>*zEbFcan%Ec)}Fotits|p?L*3uy*zT4yY=98%jA}0VtP@) zF=~5~?GSmUizV6%#Ola(7dKpNV}TiQPr>Rgt^jN&L3K&Ki^JvTFw5I+D`WeqF$eJr zKo;xUD6VfNXTSOSdQyekx*D&@zOSO2lJb$IXD@b~`?n3U|JMy4{P0l3|NAXZ<^NrO zXa9LCLFdFSksrhkU!VT;=Shxzo}TM3=i_y^JNWK)2fKrysE2=~gP`so>+D>%bIP-d z&)!SPX81Zjd)GYu=VZLJ{3na#^Nv{2EpMhPqrCb{OOZ)KlDfzBUD;{x8qSxZve$CX zy8-2ovO{mJ#suV^80?M;3PPs-{|2vt72W@CHPrjxZfmFiznxH^bE&zJsl9)xanWjg z2_SU|W*dHEp4SzuO{w>9T(N%|Ttiy;cWopO#%lnRnfXNk$bf&s)n&-sZ|jyW0ccV6 zqH8O<|EgZUs?+}4t?dOHrXkq$c>WmI5?92?O8k70%zfhnrR!!VLEJo_uD!B4NNOag54_8jm^RAOCs zrUM@( z(kO$f5U$zTZv0k1@jgGd)!XLlxt=AE8V~VBrdBfN_Y=--gNYs2e-*ncS<`*ZgG-}+ z`(DKgwEj=~L9a8OAo9&Ry}^8|{$IU%qoL~mHCyh^{@Yf9fafX}Fo88Jg`dVfXW5~% zz-0&5|1Nv!(#y@Ok%l2CI{gzV0QW2#lLw-X@1ZuZjDE0qjn)(jn4Tc5y74x3*vc0C z;&ilx1I?KRU1*hk*B|}lR#M4=(d?nG+sJ45c1^?dDk{un2NxoflwFoGV>OhsA6HVV zA;YZn$gl)*l{miXPg`{v7@BI?uyk@jVUuK>TT{4=bUHI`Bkl)c?qCzIXYVxC$Yt+h zu*lv4RG5nlHanp$%$9a%997MvZV6Y0STX63tice9dl=3?@$t516DWExOb)%qkj!3; zhV!3X2UGvFKg7v<1SDvmNWnSd1pvM777VvIDBybbaRICS_RGyaL^C|WXcrMsdLxvu zl5gT0j6XF1m?(Io@et3@-Y0U*@l=*;DhF~%LT%TnR>bEB(f3}|%)$#O^Wu-QtJ62H zE?yEGQZv9^&A)^0INYCEcR>$05$i<>m|4|Z=h=#v1x5)Jwv~OYSTA%;?u>iGV@d0n ziXU@gG<{NlVP1i&#mN1uh?R?18#d5vU@bwhQ(!9P44GPR{LocX_Z*Hg;VI>Vsie*> zHWe7xGR?ecx@8(_@1LF3^744=c8VED>=;y7Oe&!58nJfN*jFd5eZ|0q*g0zQ zpO25Tl6#uu?|#0>O75rY0v*rbYmzti^lFtN~Mdiq(PK|j;l)}%GG5lJn>)u`K}D6{CsuAbLerU3~Dt}$;)7is=-?hVXQoi zG2EG7L`BomRqonfEE}P`c$O141d~2Yhx5K&WouFLV(nMg5Bn-eD=58n7>!(=N@v-8KJ|U)+OO(2VTq?y|n_EIHR`*F3AI#1X5#D6{Y7txm+Mg9V(8ZIF2?4f^vDsbueSa!540W zH8;JdPanBu600(bDk8UBMv|Z8u%AkBgQH`O4)>j*23}GAG&pYi)zb8Qs&IRVg4}d( zX}T*_1{q0Rr3}xY457z49>u83&Y~F>!59Md{`7T*GI`4$;F$woCSvR-;xZlMERJE= z53cjT4#{KNJ$OjMr#lwU&P+H4W*{I&CT-x$0cNBILf+*0z|wTH63aU#W`HDrVA81> zfIb|+?CBq7Q!|@H*&La%>RxQ1U!Q@WCouxZUaX&hP<+_0sAbQm3sy9hK{j|@shd1u za>PlZr<#>iO={tAVA(=RqS~PbFelVe5C0F2lt8KDvZKMEv~J}n&QhsL^`LHtK2>wS znI&it4GmCmVU+en$8JwRPxq}075n!$SrWT~63oYoIa2{~={#3qO$4HzoVe07WRgc*<<2lyw?2Hh&<^m$0o#AXdJJV1IcJ@S5J`&G#6Sd&X ziU_AxPc(S%3VKT?sH3o-)k7Prro=qBb?4f1PCeisfM;Rr5?hs={g*0T-&n!XqA4LE z47uwBT{IERhd#9m?FmFuSU6CYbvFi1KRJ68lnA=`iJv#7b#hfDi0@Ue$25@s&%MTS z#RheN3iN+nzu~L*{~PY^{?Ar|fciQtDDe6eSuhdx88Z)kNRH1ei73bBPkhJxLN1Nz6%AQm@uuds?Ru=`S?MltX2T8Hl@L1m>N4qK=7+g-zReaSLpxGZ~3bKKW}IMYdaxrpil4que24Cv_Sx^v%ha_uJ?P}6l`p{{1&FE zO8TVLxujjylvJ0Sk}@?W)#b*dO#O=&rE;*Jycc)=|XHdthN8{_p4GRiO{{oL>V-QSG?Y{4Lo1^aTO%Q~Qt( zO%i0~dc%`#MoC$6yhh8G zI@j|Vow5Q|5tTSq`%YoRRDJS4@8ksR@@{N>laFA`-rP%Dd0sg}i92e)f4f zw{I&)qR}QH363usPqNT@Qj|8f^3;yZIUOzKJXkAc*a_`WMHwZ_P?$%^G=LmobqN(b z;wGb7kP%~Gm`0!MWkqVXULbaW-B-0!Qzgqv2Coa%%Z)8ooh@JAoTFcaLD~fy3pLAA z?Ob6;RR@J-9$4vIw%Ssm@z5RAc~H9pe5+KdgUk-H#E}zmgm6m05*rDe>!^4IFcWNJ zN!W)<+J=CHWdzSFhUXQ+^AmV}F+4wlmujpqffzm0bW0Wv;n+f^)cD>KX60eT0CI0~ zG({<{CHeNY5<#x4nWnJc*__0V`F>`B`2Synzx${w^F(D7@c(t!Zvp?`Xx5vJdZXU9 zP$R_icKrV~0^h2?-1|SUFaJ-l_kZpI7p&Tub$Gb9*S+fpqv(@Wn_CpIx7X{3i`#U( zkk_IlyV?HigMR^pY_`JZAUv8T7?H6_s+@H*x zu50y6HU&cU2 zrq*n}7z~K9_~j=5ZonqF#)P&MCNoe1(wa_;6oQI!zWq{yc&XY(MTue1ggTkz(5R#o zXF{wnN%p}u2l=r?+AHP>#31Fe1k|oE)CYq^Y>F_&rj<4axHnjSeKbjiO*BboV3F3) zz%3@bdi(3!z@a~(N&45nQF{DSxSfIY3_L-nUxO^H1S)`j4YIrnCV>M#A^yN96{WxF z5F_N=c3nVVwfg$O6YbQ!!BJU;Gx8T?Pk)F=tYx(h=cPs^Pl=A#SrcmS}An zWZZ5ia0Gzvx5v*1!d>gCc&VMf^Xu*ghY2rel&Lv1UWi6C?oe8{KfFWzAt;sI2W1EZ zUwD!O%Z)RHat1HS5JnloC__|0?bG76k6TSjJFq#}|FP$!xoY&%+ z*_Z$K6D>5AI3WRGc*)fEqS|Up50lbEvGmaKqSC|6(nGoQP%NDQ@Y4AnTbN%FZ2U4D z*}^oUOgKm26Khh9^$m*-d34C5Ll$lEXp2YFl|euZt2@4*2T%lG@*$Q_Bf7BvmYEA+ z<9CGTU79#{>}ye8$Q1)PU}+%j43Lqt$-qAY+T$f)R0DKh5;*j!6!Fo(?ZjWa3OZCm z=>WUq7}t#P;=K^bxl|uag+oaRV&C!62^>V=q4o^}cfPovSkwM&aW|i3ngrUnPg`}o zkS&Gsm#-B&F%1n&>t=C(A56b0(c7quPxwtKfpyWrC~T3&>@Js3Ce%>oq>_-=FBpDgZhOGQ9XWM#b0jX#ZQH=lz0 z6oy|sAWg}D^+bJj>H3E)UN?e?LNc~P5-PV(OnXqh3g+YfN2p%^qai5b$z@Q))UN=F zs!(HF0_!%I04Urh#4Fx6+PfTAkY*nSDR%wm0(2WjhlW~KUU)h@GA zUAAJ6Sv3YP>9MEpuors5(Ml=@8^7pCEDlgR+_c`rJ5szeX9Ox0B2fI*6x9E_f!*u> z$Tb5{g0RXEf?AmyPtN-!h}qQaQqM_@YTb|T(RP}B-VeX_DUqDnJ^90FoVrr2_W#&- z_Wy)`f5E>GwNechAI9enKBH8O1i8*=JiYgLGM?gzr)*U? zX3@wGpvWc_X`ED zgS+AEehW834UYQD82otmQ2LNu(NZd-Bd~(Ss$wG-%N&as`HD`P^mIxmkgKXr0Rk2u z<_n5ew%F%|2DTDY3QN5mh15wZooLbmk#9}yfx4a@oN~)*LJU_6#m2?wthGYzFA1g$ zuOeH}md@ z*1gQx8NG?GWNBXMzDh1XkV>8A2e=Juz2m7TF?*b5ls9Mrxp++_`Y+|_^{2xx(DX0x zIGlCIz_yGQ!}%JkKq39FEBF6A&#mw7|86A+sAGf$hO5BE^87rtEsSvg+-Op+u~Q=Y-_Nw$xDESnexuz`?Z35l_kXq%1XRn$0y}tpnP;_AqV%c< zT+Y=1srPEPcjNov;+}YZq#@(QY*P$>A(4YN;MD&?jmM>o>~6uh+ca>dp)+;*-Oj`$ zeebf{gFN&n+_b^m2>tph{z+B`HMVirvAY(euBJP#U>9l{roVflNin>@9^{*5!`tsu zyw`wTmPBKp!xuzqw-Vhi$2X7NMX#Y{u@+tiIN+F{M3W&j0Tvq<4o#CEl@4?;bRgKn zrYeN3tVSU5_WU$68D8e6_v%zK+16zywj7rk`%T^s3hdqSas^^+P`Lm1J$3)z zYV7v^TL}WDn_@ws2;d^$_X94_yWRg*Wx!@9#FnL0aSgWy?Beu>1gql4ziaDU8%P`f ztR#MMl15+nt|w z2AF?<`3IPPfcXcQe_)nB!2AK`4={g#`2)-!7_Bz25qKn70{#r}Cosu2cyxN+;Bj>m zcihAW>Qg6Px;bwmuTjv&7Bg+PnvBO<57%%*gS5x zSd33G?qSP6_E=1V18SUjCk?jdz?kp?-Db1Vj0zmE0_)Ajaa15ixs5~DJwAy_#HiMx zd(v)4B@U<#eybIi$RM@6rrVB645AWS$H(oc#DL;l*Y%oFi5TV95B;Qx0fBFMz8e+D zvK=4Sy;f9Wz}whryUaM?^=OE@so`U6@`tY3<(mY|5xisxUFe&zAIJAcG%+wm`vudm zax}&2pw`#qQ&6K{3)j=>FkD1cD-_uP>HtW*;y)QyrvbAEC~mu>9cY*O9!HMZ2AIxp zSBt||1sDf3T<`>WAsgB_pwA5+>B(SfxXTA*sYY9Om(o?LcjH?g6`RG!WSFfYvN|Lk zVSlBqH72Y^LXgNzVbV!qf1cGxrd^cTLjxKdR{6(@U|tc;onv%Oi6(34V&=gkYcc&K zw)P>ROEQZ{xaU!7gkzsj@|?t6bc0h|8MjG1ZWG4ZWA1iN#$AM z5K?Pamq4jY5Z5Kp)g@5tLY7omA%RerAiFLB)+LbY@|Xyg@LLs70f(93)gG(W24NAk zyhaHtkfe$qgh}D?NukP{5Pl@666XZYhP)|}BP^8XMEJds4WIXruO%B{mUUCLcWa#V z)EKOk3@(Q={UL;K-!Rbr@8j=p{BO7a15UtCo&S2f`yX2g!Ys?df^z#m1hm`#S^BWb z{%>iv0}Np6w5;O~{f6)lcT-FF_t|U@7{I;@@(u_BZ2jOLZpD`H@3Yx1Fn}E&urzi5xYFD z;T^W!lVi5i3D|Z|g4>AT4j9~a!)Mz=gv*k9urrG`U0ojM*4@KqJBCY}I^rhiBo3I2 zDjAQ%L1J+0^+vmS+&E`|DZP8>!aldn;j$mJ2#drwhlj?#hlO*J00SeRkR8Z z!$N<%G-K#HA3pq3rDvXsJthf1b3jx8R)sOBm=^x2Tws8ln}xg@8JUM#LdCAEO{;AS4FPJ?FWq+oU z1+(ki50TR-)>DSwWe)J5|Xn=TTK!|`~Pq;yz3p3 zH@6LMFDc~j|GlQy@)ZAn4cFbB|86Dx-@X59efTt-S?K@KdI)A#u$YhU0kKfC;j49v z$Q8h@{?Ixflj_3#xHlYp1v0}k9U_FW#jinh$M+MmxNVImh@3OWBCmkBiK3hUm*UYL z1mv`iew)EQ>j=C5==bsT@1y@+oOXXXnoYY$n6X1xc{usH_kZ{H{`a@jvtK&z-@g6u zlRn$t_4)PtpZ=AkJL0m1z1Ql8yJ5KZvl*45cL=gsvAXww@KS!UwhOkjIQ$-xZj=yV_$uT&o3uUGBI@8zQSrG;a zWyo{|QzJ=b;Ih8TFo4cCvm~+%PF@NbmfjOD2b1wphVbs^iwu9h97;|CrPm8@net9I zxs95SIa%Xrlr-Ig`s-0iCuUxs65s@jCD6uT`cMfIf?^Ncy>X!1^>Q+Ss(=2>557$#J-4E5~wM>FU_ zZZC@iP$K0VXJ?)KDV&oa9~)9Dd0~%2QDw-#adNqoo2J__;yw%#=GR~CN8QJaby;Tq zbMt7iKgAp8CsNwswh95}r^#ql=I+L{hfO(;vRua}=9WU?q~u6B2fG>3nJz}RJh>QS zKy}m(El8A2H!_KZzNKjiw$X{R8HkqzZ zDfyyFvsS9bLwQ0ST12ag6SWvo${pAe#(~~ z6^JN}d9!2(p5A-sP86eA5>d~T&?6OJu-nZSt7}`9TG;Zp33@JF6;5jxynGm`S)wI; zt4Jcv4mirv9hCxRVOnuI8Sd%Z&X?eB(VvMlO^M9rR>e%|csbvzlUB~CWqr-T{cQ1e z){e4JRF|K|fL>~LB6*2qh*@J=G={0ZQ)`ivAc6ERJW*wQbMP`b1uTD#XM7r$f4EkB zY?gZ%R(Q^3dVE#lII8GuDdWt@aD>jh=YbCpd!rNS# zY)NsevD`FQ462uK8p$wC#FB-gMpFr*Rw9@d`WcD#GNpAz!Z?kPO)p7PWo3mju|iQ- zh6GCxQR(DSCNif&IZ~l`s8H&YE6gd9(`3tEN=R2^QAtUmNWOF`yF*>q2w>~V8$yYfW*kk@FH4uuEm;B}L_rxcMv+&bD|WYg;~sm}#~#V3>qu5_iiarZFv1k=UPzSyjpY z#vu3U*O$C7Smvw)qSem66)c{#ZsfGdKc`}iXu*%gx-{#Yn>b^89p z`-_X`O2?u;FQ#KxKLUzf$Zn5+5FESsmzg=XC!0nJV$m82g+7;*aBAJ?z1Pv8G({c`gRkt^wJs9rvD zp%m>0KrbfUf8GD`wf0x=DVPrXU#!`u;b8t#+tUics+Bzz+fov-D_y5Y*o89mmjYfDz*^?RT9$#;&4<-Bhjq0qfJJRQ z5bAi4SH`9~wR#nN823K{{Qk!c^=(OzCS6<#WKK`p23?(3*z=}dkwxqbuXf-0Vi`;B z&oACze*}i?aOB=Wg`uBq*Pn)#@1@i&JV5$h(oRl9g1;Li`u1Ax<$P@H{Ln?OfyF+a&2hciin_PX?QXX)0uuRHMZlM90Phw7@2(8|YFP;UDxu{GO^6FzcT}>7s+GH@m+81X;M!%@ z40t99P1ihw&yqWAqa<_lQ!rj{2*)D&|FknvC^KE;h9=}XWth&()ypWHo_6m16iQxq z%*^MhhBMjtbX~cOqFHOs`$*l$R#aS60cM@sulIX2ZxD`bElG)Q=|G};?Ne8_L$?nFt=vyN@nb^T5 zU`=ly;V{MbAik{|%?H_!ra`72%he60bEj-x#c!wiU78-{RLgYY`ynQNCL^FQ$ttE- zhT^o+u!d5YiPa$Lv2mHC)=YR@HnQKADQ z;K!0(&JVhu_<;d;tsP56!T>#<0W%N1yO=P(o|#&r3ca&mI`m(}zGzP{FbXS!alBJ` z^!)7d z?xTAb-;(F(h%6=8kthCcwf`ptTL1GMjjUZp!TJwNej{c7#cS-=|7`?;3}j=0Eo?Z> z&YS@LNgEH1>s?)lHzjAwPWRIoI0olpnG)+PM$`Tb`H4BK248^q<2u0Citb|iC73U! z{TgjpC`nXTVUzWIEWVVKxtyJu0EPayaU2kC&HeV$oD!)?qT)MohQf-+sIoF^^-5E( zRI1P<(bTzhmO9=jl`?Rh&~>`5({r5%*C>bQgr3v&oSx@AcqTb6m#%ZU^k6cXvT!L7 z7fUwz`hx*X6&L_!KnbV-31c#5R*3x9ArNhk$&k+bgCUAXfWd&|-TplT6m;hR3*j-G zs`dI4U_9WXEDm{Ly^CigB_9l@vpM4tIm;8c=ouWa-gR8Aq!mU{UL4hpqWn0j7ezHN zDqYm9-yI__B$nmHWqDCqUR+ib)%D`CqNtu1m*wG3fFd8T0z?F&WH4+H<@V~p0S0ar z5*$Ed;BU3+q2F}&=)+@=Jw~qMAG`>ZAA|A|P+s)`^N0ACgJO>aiaj>=QbNRdepMvN zA1CN%=oubrEXm^JZ=NJQQ@&NDycW0TCnjl(-Y^ND!8;n8--iQMnuYW(0w~~ zB)xmeyU*WwzGdX${XK`>Z8;AyhDuPN03J8ga&rmq1gx>f~tVQy7Fqs5oS-P^fF=?Sj8Fwc( z{1!@JCB=XS3UmVQm{f((YYn5n{8-lckKx&@nM87`t2%f5LQ6EY^kUh2uwQC>yuXAV z7?A}(O8d(cFuMD9e+m=(ZXP@vIcDz++5jcsA8&Q;HL(dz#@2Y-BOqEBY7Z$6eu&om z+P@!9zee7kxn5o5f5&G1PsK9Qw5BW+g;SO-;4ha=83;+!GSak&G%X=5FCb0JN7Lfb zv~*Mwj&iNHlx$Rza8gXJs8SVHS{#+IB$TRphbTGYB32(?x`~{%f$vdOE;l5aD? zVqA)+DTNZHvIbsUHkZk=vJ=59E1OGarBZxNDR#-mRIJpBTea*mQer{VAa0diMq;h6 zLdlMiMp+RZi-VvWgL*W2;+_TG?q>a`nM+SIbDnyd*!9CEp%wJK?ZFeF8jI|@m8uP? zYV5rN4}=3Xs89um+4iHX4TgPlskb1JH*7uVBE>gi!UJzYKF3t$qfrx(@JlTueI z#q;k8J1KLjV(qI!JJ{q2<;t_!E5^Vys$|YytW;H~9wRKFTqic6#TbHV6+=|pR7U^MR z{3snUvHD9VO;T1r$?EH}de!u47Vj>L*F4fNqw^;;DHK<6FH1%5KfLR`!N#|(s3*eW+*xE5Oj;O_$d!}1QH1j{~RwZllfA|)QT1AV)+65LA5+B+L))1oe zyYz{j(SCd_F&oK$43xcNaAa@z_ZcS>Yhq1o+sP!8iEZ1qIkD|zV%xTDPHdaqz4`s0 zXLqZ%_Qh^h*Qrx|pO<~^KIeU+K$gC~8O=pJdF zH?==5WZ5a)#0rXUwr{E~{L#!Z{qQ@*mjYaZcfMJ&q9-By z?@m^Yqb1WQUHUJaA8&6Pjr3;w3z4gK4O}%1h>8Eanp7gAq4dSreW29QuswPa?L>E% z$6ov7@90jf9omH)Ow|G_Aht)FVs52Xf9pPA>S80V8K_Z>k#{YTBSRWMgqNo)8sd=u zbMnejI!8-6p>wjj476@XVDu2kHZe>iB?pdPAEc&MXp}>cM(R>&WbNM!RLu0;!kQ{F zQ8sJ}a4hD6Y}7%8d&Q5v+STvZz*RL-{3+C;Ax@wN;fao{hEnI*zroOOW4-#7A=SL1o`%DQWRP#h89 z9c)Zk4LKik$+HN`B~}yXk<+LpnOmwd&}+);ZAc46c* ztc-S;Q9&S;Xdx8w=iblM(hYwLk7`2D*S0VvmvYC{^jf@$9M2Qr-gly-%X^mecPhUf zPpd9vPN5?wrIy%G-N*`}2(`{2f54(Om|L555E<5ycy9oZifF$o+zfkuZ;JK{5N}-PWyusG;oH@S$kkjD=|U zHEjC8Eo%4`^MI)3(>QLJojZRd!hOL&l(kPvFMrd9GgC1TQq7=yojVqOh`QDBv}2U& z%c@!Cb&=or@@~MF`|X?e(Q%7XS6wz0BSch;E?(ORQ*acrFFN$tXweF{-v8#Yvyj{} z%(@psXto?2bgV{7A$s6z+osj;tQP)2-`z8ws?m3|9q;&;J7SSLVvzf*AlwkINd8<` zgvR4PcW~T&Ux|ezbqNb&99BG=8X`1kf@HBE%pwxyPfq+J*aWt*c^PTcL`jmN>qJqy zYG;XJkjGF6SUwCGt%S1dx8PARO<+A~nOwm>Ns`LsJjWykrYcWB{{dS0^nyI8_Maif z^FFJI;f!y%XjQ(VJk$3-a07g}y(>(5O{A<)x!o(~m|)q>cgv-$+9imrzscc8J}%@d z5Ej8FwczRF<~OC#Ug~*bu1v-z8ghcOB~Kt}9KlE(!8jhlbW9+*q~MdM;KQZho2c6b z{C8wDNI^)RfOb5B(Eaa&x&%(gfl7=0wa_;Ktr;9SCJgB$JXaZ@7)}b+@%-DJ9qdQB zx>a%=gk(irMEj3W)wT+X_k%cynFDnl!MCM7P8+c)>^k|OPwEb%ko_*43h3n$sp7~y z%jx0zW}9B|B#q1-841be(O^S6Tet^r=YrbHOkphUG~ZS5Va7SgBSq9Aco!a+}bsbI+#g&B*R+kc)InuKP`uHZL|an?8@a9>114@MD`cF z4#E^!^02O7*&zk5cvvlF6PUbXFV{w1nUU`E=>r^j(T@GtLg^0?HOFvSQ^*jec^U|% zTa3ru=+_^N#s@+u5ZE*um<`7VWK!v6G#Z$*C=kg0=d3QB0zp=@p)Q^R0V9>3-ei10 zG?jkJY@9!WLfQTjtHH#ONIJD^etBVEyX37@uyb*Nn7{5r2(L3Zix0@q1X6q9fBIZ~ z+S-1*;S4Iv$qIw6Bm|{$ziktK_-z{NCoOpt;Wii#MmX8vk%uMzlIZoI#%mZH4RpH2 zBOlHDRods0J?<>{i-%a&Nz}^CM%ui}qh}mB1a>^5Cc!xTbS;f|LC@{%Dv@xkrp!6b zQ7hAF#o?Le)DO>(@L}?Cz=llP)TS^fIxo%U80UfucR?I((x@v}UC4%ATd#2(g(9Pi zA*cC=`LLMYN8R2sKn)O*!}zO7I0v|evgRN*+Er>lf3)h*(!MzQo5*!g9tqOK)o2~l z*_q>VmeW-RH|@ocKTLCC+v3|CG>uw?o$&E-LtE7?zcSXJqsf5E|sf8OOn`iCqGzrW28G3UR4=3(Ll4J zVG-QKe9UQ7F->Up!Y&eOBUlda&1s%o9IeN)XVBjC#;!njYRK_%WCORr7$kcX-~0h`*zCw z&E*7jeh#%OjVt!!_MlYFq54-T$+$hSvWVi|?9Enx{c;zcOF!jP-s{_Q*4l?Rk-O<) zNEbbl{-&nSeo%~Bq6c9DZT&s;*0h>&b!B^Tg(wt>drl0U znMeOKeirN2pYK5{pp(#6aPj9n{I4$ImvVab3bG9$pz=FXi$g4&+a43KSjj+zl$Fqg z2$L%rH?wv=#Wyea*P$xFXBX{WxKa@Qe(b+Agh)yu3$L@Ie->q;xco-9tRXr(`to0S ze6>Qm8vI{czcnB;wdo+2c5rC#EYp;q4O9#wkPBS_$=j&kiyiMouK2IoR|0#p{CvMc zLUbbOP^?&MTL!beIZ>5LZrOzl*DE^Q$y~5%MhPFSY6udAsj8>C4uVJ>0A%Gr&298m z)ypDnf;dM0pF0I|3dhvKYRCNH$&14qb(8~Nt$};Hi-IcRuRU4emQo?LHuHQ|%Mf7Ngc(UkKWS8#qL* zBN4nsTept>d4GSC&xibCzM?yK@l>kKCw?|?h-A>8vEdGwmuHl5VS(MrGL6)84O$KV zXgcUDL|NSHvRBWs8h*d2P|fq7uy~Xvc-IF zY4w}15;BFoRJq{8R}2+bEKIej$m>_YhOkyHX_Kc}(8FMTY+BC!JW_6UpspQ=3I#{8 z$~gLXzXw>lz2OC<0xA^>ep%q9t~({k%g@oW~6)IH8n=)&1)l!Y&?9QHc9 zQKmi(c!lv16D{7*cx(O*2UI+rcz{=Kr1>Rg(o@IWT#ulf{va9uSlB2f+XCPSyr^1S zz~Ub2S%G6&OxZp8A_uPcS1%b@KND*|wN(BC-2t`%d0#iE9?N&;~C(AyDQq5 zChxB_^V^ZxhFGD;sF$Eyt+_8o4`(kVlqW1ypf2pdrtp8Efy;9gEtQZia1l6yrr@<< zuGg3LEVUI+5IF ziF!z+3I-ejb&5iFvF$&^{&#{PBj)nH?F%pECLfzrDNnog3(CE3w*_CY5oerHB%wS0 z{V)Ey;pIJd>opPQCW}sojVSM$n{=1NpVP_Rm5Ug+hc?F6<^w=e*YV{0GkbNV zcztvt2^tvwVPPpWI2wptQeS;&rTg{J|9Cahrg2jJKJa^av;q(CbrQwMK6<TlnIuNG8N;GoxvpA1-zggx&&r3=DUCwAvnoc?O);I%jaKF$lR0R zBt|;;?z3%pWx$f*6X8_c*NaA2hECWpTrZQIJ0btm8^HFdr9Oh=;yiV>`+J+$!!X}W zRL&3_>EM3Awqayw086?iBBH&PudEFtr494Fm|(91&Uc1^y^#UDnIe7@o!s^tmWjJz5+7QJIBH}co$lts@wS%PW{$|*|%`^B!?o4j`W3rO!n~R&nO0WzkCox;m z$iO~52*2|y2*EC#B->^c3nR~|-Y0IBiLe@Ib4!jdtThZ|L+z78mw+)5D=s_yI^ms~ zi-*1$(_68ad1y#f3P(-HiW*C^k`+ZgTtUQH3xseZ2_oFhX0(YB#VJ@p3|T=$MprV> zs%qi*CK<1d!CV&z!HL=r!(EA>T^Ju)#t}G|xl8f`rexSkt5By{{IJ#uQKppOR2eIM z2~+9%(#p@@jYHj-xpheMT4RDxy4{%OpoO1Cx}8Ojb(==0Bt_}RL2UUJOA3gjM5(1Y zepF=w2Kzo;YMt7GQTeS<3r2RrGdEP^Ar8{L^hM}b{)4|`NS-ik*Kg2lZRPt8!>heJ z@ar8&=9L|b+>IDschXJzEWDH{K!D2_QE2~rZORnlX%(W)LNj~sQ*&zs--9k6&keo5 ztzIw)x@@+-=Mw4p9{Q$`=A3l8d6I2i6;z3M@Sv64FXZY6q-9|&Nz~cvZE&ZC?EWKnQOae9OEHr*4aGaa{_xXH(TB2C{4OO6jRd{8euCopf6!y%@m zUZiI7$ZGx3YnqPkA&WdaogB|dS4~eCocJR%2{WCQzcSlv7eZKmtdAJ>8!2wbjEh&B-+3PX?BDfW*YQgyut1-hrA)6KLBK1`YL3909umcAJGx0O0oz#dHxi7l@+1@*|%L0 zelby~9T1WXW0g{#r4xZRaUq+H-&zIA-y=8QO5J8HQw8t(Efaxgx+bjVzv%9}>JI^Y z?j|%E%SrMu?8r1R*^0-ybu%40vU40YRLXW#2s(0DIx?v@(NLOczb1GCf@7W64MVE+ zazzxD$8hs@k#DX{SVPU8t=D33k;ZMq#*fkxdu}E;wVypl_g6Y@^+uL+GP3w^(Bk5v zD}o}yD(+N$4K3^*xl;BG#~tOU57gU4KJPv0d>H)xp!*H?EG#{*a)++qkdv8P&AxU? ze3=|)GJ5uLAm`283edV8yW8i^SEp=zUE>Rv^xe|?Q?LtKm@m{p8SyWg`^jTA&}79I z-HgFnIAVuXHQei9NWhFr=<%A1b4YnUvmU+^vsxUz)|fE1G)(RKoxDNWhat$WSVO1Q z#^r9kaMMW7MPk~7rugr;e&Fr1CP&$VwbkBuZjC7xQ2{7HaTfW6jEf$IaRF4xCGhlF zdUW;KYeNACS8OCAwvtZxy4Wg*0;+HPmOi3`&o};3G|ErIOJKgg6gjQO*l(Sxg_%1r z)HT1M_>bKHrI8uH|Kp%SdglJ35ORq{iD51Fo44v{d^m-8#XAJV@+iE83S?6xcshnw z=)6W`KCE!@t(y8N@b7ExLHQ$CXsTDaQnMo*b(|M2iV}tT0Uc-L8qf=b$u`+Z^xGlh9(1nt#bC<**vXLK%15RLcJ5eHka#n{df1A zFGCnC{54B_^$o$l+G*&{n_dB>YaeM z09l;P(jYW#iVD7&)UVx9kefKCvgQGnr}q+x z>VVHhm&cuvC>zMcC5H{{4)#x2C{&wIz!=UnAS2SqyL+tkkdCn%W-u$dfNrdG=0fCq zk?&nK{b`Y&7`jSs8wBnRpD)PWcT*48|U{zm~xgaQk^?21Z_ycO$T8O^oZNcGN6Mdqu2+kvJyW^Q79Ju z=`(;8+N^`b6pOV7_JW%2VyHf`mRunXusO!xMq2#ffE)REU%$_HLf#YaS`|I=JS2!9A3iEWn-9ajs0)nLx0u| z@`AL7AfK~_%yc!k4;IznbZ>$~Jf?(XeG*sYBL3~4oazZ=eW$`d$+f+&LFXF-6q?kS zU$S&-A;}!A9s^Yg4n9#in*~DEzwP!X&6U7y0~&IeKYDe3q9=F>Puf=9K^-*WIvVsr zZ#btpe=^0{F8=&U&zg|FY0`t_8hA+^SX+c(m}nwABgn{uEr7yaq)xO%e-dStT#E_J zhd)F=YHi9X;4;U#a$-KU%hmkGBz!{ZlDW~F^+fh`1b2j(420Gcn8oGDJ(4RDHZw|h zk+k|j!IyT9$r$P`&@8I_pk+FpQQ#M$N|s+y501YOvw;&EMP*lNZ`j?X4b}nU96FM8 zhk7;-Bl(vZ?4Bj1P#`$ca_wvrxe}ikMk*2Of(E@8k%ss}=Tg-V*ygxDaXjNss@#h z+zamJvqNN9PS{2^rup*zbV8Hc)n;jR$$!1AT!QzRGe>AthddgjyzY-_(XtSm-Y+$B zLy_lWr3z(jHS3D*VmB$F<&i&mZLTysc?@nfIivmOGGT>P{mCC!aOS%PHiK!HJ=(Av zC||l0e-|KKy;GJD+}GA`^<}l!nsqmKf_hU(NVb((9|uOX)?u_z2H&U-y-$Z>db~a< za5RNWaHwKVNf ze{nWwOhpwaojs*=efJsoUBz=~o;r2_0}2{KqMv(Ehs=`C3G9&-J`J*e5*Ltfjc@lw0`6Xt&rH zTBY94w1bj>m#**4=zkk5*KwbSd8x$=L&(J89-G}BQK&0pDd|(8D2Gcaz!pgQNI~%+#nFrmP|2I zk|$g%MMGADzSt0_Wydd^7N|8}mgf68fEWe1x$eI$g&I$djqrHAFyEA+7!fJgxX0qdugnD(CRWvbzlcUD;#t7<=sA3<0cvU9G!83&HWH|vy)AHfteEW zj_Xp&BJV9e)PMo9OmdWnjvN+tOUw#<35S6gyt)!$kmf!+qwh~Q$Ndwqm71|@ zg`HSGC+w`l>+F8spgo&~C8J-peF>Fr zA31o{huQRL>f5@itSC*OPRouaA_;XuP8+1IHDI9^sCB!n)$QXyGe^$USOi(RCHdKh zt1K5a13G;7(#_A*W?b+IXnpR}pJKWU=vP{DP_N<{f}G)kzylKBSGM}7A0H`Kd5Q0S zMrt~d$th`Ewxu{|o$s5EoH!23EH@rqWIZT<5w5hE&{uga%NKV(Rae?CdD{PqGb#gH zIX;B!y4RJi{9Ey>bG{Uj5QtpbNnqT}QIZK5TtI?4KZdc;toip>q7YkC1_|CcQ*m>A zEZJ?C7rC`O*k2Cvd>B*?^YIh_kJp0(`N64@BTMuDyVMi#7GtB6>jp9Py9sfh=jJ@)n_YK%7n7& z|3k^=Gi7d7n5-U|S*U6Z%w#%pDp@UdjFUz*uzm1+EhtARDX^UgDFFdTaKx-Ncf<oHW3$NZpjs9=PR4m0h#5)xr0epNtmu;zMIokLR5l&Ig=jNj9txOj5BN;vx^fiGWufE_uYy8Wx36mWIxYm=2j zt>eT;P>Toseg0Z_nLhI0(RgglRMUcw)>A2-7njB-M#&%_HIG(FlT6I)$!n3Z6S4hD zd(jnYkLs#+nMKmCbES0S*r>X91~hbn0W)qfxeUjuUCt1h%tN{FHA81>ury1|#l-v=feFDZ@p_7tIvou?_cO><=yX~1G)7@2Di z#Ul@y7I!VQx=oWX^T0~rnwQ{AUVQ!d7${{$Wo}QIwRU7n`V0`oEU3?r!ZAs|t%23W zgCi8hHZ*WM{OO%JR>>vw2W&w;fNov7ghELHOwlT@ppMQ?P-6;-me1+~Fj63Rfe(C9 zx37c?d}^U6&~PUqK@U6QWnjo`!>E%GZZmNAm{ce4PCXlIa1CBAih+-Zy%2%2^2!9m zAs5k(V>lg0=kSLHRJkKsRUXxaCp@Dbc?8fOVycg?)FT2oS=S18&DjC<#oF(^?w|qG zKF+)c$(@;4Ogp#+n9vi=>_L;U#=i~|2i`Lcq zx;L8cZvVvP%j2CD-g-7}O0Kda;|=z~)=C1nn>e;MjS?p{2R<1)^0G>|RD5Z>#M(GA zHp5Cv|8^ic^mHrWC&`5(qyGW;IA+8a>kreum#~Skl7kUjvJ+D-ng(XYN(qPQ(Xy~;FYm@BB5egVaL^ozG9|Oy6}6)JV(QP7vF?d$hW!=(5~IOK5(Xf`-iWiel1ADkO2o%gGm3 zq!QG;Ct!dEurCJ^^Vcq~&4a2#2uu@PHM^@~h@J9gjUQg()|WCY;fq#sc5Qxsw7${{ z4?(`|hyLACTOXm2>>41aJ2(7Bg;iXXP(J~rJ1LHrSzoScN2r1J>IN#9rU)ve`53zZu`T`eEUox#7MuO{uuaW$@WZxP*-Ph z#G=Dya{EoK*3~D4g_x_8zi7svQx1Ui=)d?*jOzC2kN@N6YlZ@-0FoF(ow>X)&m-s( z*`w!zV=sfZibf@{=dwpoXj(B?t`rs`FXvxFvYx*2LGoVU(JBz&@y?+nf2^}m5oR>+ zW$R`lVs(Blj@Jv61aeXJQz7Muu>($_)+g%eJc+) z1j@+~DEOu?TsjH)2j}w<%S+~uqE@b4 z$OmKv#L=3w5v&cAiIqetVU58Kp4r%ekLSGLB4D=l73@blkQs{^VjhUIY*UZKeE}+E zf~ROpBQu^ljZM5loVwZw?6|2P_nkasR--2OSOl0Dsf;v;>nsWo_>rPv8w-EKkXGIT zz&61AGqwj9y&vZ@QM?aBb-&WA@x<(?tpN z5j7LdL{yY$nmzc95B`0G_&AFSW_wh$Z{Kge*7P#f!)dI_^>uWqlU&pM<@@8`X+ue^ z%p2saMH*8XQkBqV`3GRT)_ExMTxy)ipr)Vv^TP90Uyp!N0R*Nw1yIb)%B~ninO>Ar2Wyhu5eD5O*>&^ zCVMCT5(c_w7!W^_$^x+GK&d-wPeOPx@3BDpFSRnqAW*=o@s!tpZx+)(;OrbM)%{C& zn*lgLX$XNU@n@%*II30E^hwU(X6A$2lFeSu_1*K9XZcC3b+V(8NKs?dxml z%9r%!g3v&I`Wr(kx?2ul|LeGL33>iHQc*QzkDW=9z+H_rz|(g((-iAA1lw|n7ur7h z{cY*8EA571Au2m1JoRx+=Hh7IPgEKD873?kjB_=Na=+-uPYB3A{%mKM(cgCYkdOBn z(+B*(8*no82f#HMsE%pVc=5zj$H}piQ2r)l0?`*{d*$9aWtDTP^<+>cZT)#>jpQ+P z40Iw?r1QxsZ4eizG9+2Y$Q$j3fKv&aNLZ1~N3`4dB^7+8#zD23`d@Th?TLt@9NEf5KW1rB*C$ z6x{rh*zuN&T{dD7*27`JS`|1I4{ zaf$sn`**MF7NJtXeC+4tV}N#qv*e;`QilKPK)8mh!Q`+Fy8=HNQZ<=cjt62EV$2;C zlixj^+}0BlU6u61d!iZjMwF0){($@f!gnLaF&&=~D*X?d)+UYQ&&T#A@LUI=?gFi(z_ z#3m-oT-E-4)p3LiCw`0_Ie7-mVSLV!?{lTABt=ywnXL4vE{FNrN?rK-^9lI-zwfoa zV6RlZte&WuNeRf%(6G-}^8txt{m(fq{9 z@vV>170}(rqm3-olM|9H{H%h{vW5e`VBADVDY?iB0f8g_1&Mg&iJ9^$O3L+OCoQ=p zB!kM}DJ0ci^~$C+tecMl4mjg)H;cIc?E|*#s$T$+?d^5Yj+6pQQ;Q*(f%|(WWo_LL z1hCmXEB_3PZL0PZ`{<_~NDe0AaG z#|JRCUt@I;D^$b75H+d#R+$t|pK>BbCpv+f{h4wbn9VR&T*TyP%9l z7b00!*qn&Q|3xIIjk3SJaW*%CF$_S3fieU`g#iQq_r)HV=|dC^K!pfG1q=D#6N0|U zkUYY~bxVA);zS1bu&w3&VJ=bL`K}u@-uZU@rwxRj^TY1ATSjDwDil*SSETiXrrFLnZ`F~9j;^N*70O$FiDMA6B*>RFtm+hY_b zOQ!1Uc2Cnwy@tdV1GXmAVoUh3;>67JN}au>wmgcm*z=bz--pOVt;vBA?N+@6vUaY+ zQ^BKTPUhCmX`_;&Y1v#h;S2>68(C9?-YBd4IM+;&^g}#SLmuH`mh75;2_@c zUYLQ^0DmO0Qy=922|OsR6)K>PTK$J#&?E82oH$I6{4XCdX%^>nmsjq9hen`~ZNWiH z3{>4`hvb;*cjp<9dLK@4|~Ah?8Dj0->yZdb|Vk6tqUy8*}+r(V_8_~<3a1=;eRd-)oB&V zd+Dj02c~ZjXI;frK97PiGWHD<=xi*H-0>obVnv5PlLAfXQ=1u#QF)U6GBP!!KGibHe)pJF;XY?W@UB#ZSV+7) z#r}~%7w?H=G9z-#-S73GnDtjx$Y~|+vn(^^r~byN1jo;5zae-N9Y|c~cow;)e|}45 zR?BhePh^4>W+!uLEARC`Itn!FNILW^tk@Wwx|RNR3oR756GAt;_AHbqOyH zPJ)iR=YPM;wmz46%&^?bC zwr3Y~T~X_fJRnz`D&4iFltYh6DuSjO7vz=<-6wBn$|mP?EYK^~FA~a?n|BfF>9(5p zPC3TsQq^x(RM9PKT{O&lKTfyTQ(yYoI^Br*T*$*PdUvXC_(mGTmKD| zXQr$$=2}l9`?rQGsVp$CW`rtr=MF>QqifWIl>ZG`t0|CCm=Y=>ke)Q))jh?e>+NEZ z2&34vtYr3J^60^`yPI340Eg*NlK?Uk)`EcC8L!>MXhF&zBk^B-pZmoAQA3Odx~LLs zq(&l^5gOr8A|ff)xP;0zIhGB}F0CcHbQe=SIsB71y0q(#yl77pU9E_DCIEM z`q|UTCss0W!8`iH@<+qxI zQ{m9#t2C4tzO6FqZUk?$>H?%@T5FHe(i7+T0#;gX%a0lE?8|}&-FMemtak5KBTok7 zK;Uza6&mA!+wXMA6moA6{sc=Okte*{GagI*LFmF;nbp?!h+x%buE*z_npyC3(^LUIsI!53{Xd%L{A zRae4JH*(RPTf)K<4%C)CKDXhAzKDUno`b%WuVD=@^>ulCqP!&^Yi_wW2ZDaS4#dP; zqp&ZIipRTxf^Bgq*9XBL9;;LQ|D77E{jV=yhQ|ASKX0!OMjyWu>ok+;H2ahHUIsi( z`?G{WSA%Mq8kIMQTK@vMWKrC!0Z#{>1WZ> zevhDW^f@v1Q)vfq@Mf1`<@|=he+1U=beJrsq~m7)^SQMa%fVAhcIWxn24SsxDT4m* zz%->?qjE~M|BdR}`B3Uv{C;z=ZmCMIj)2W1>@qiL{!=^{G+YR54c2*Qp=HVfD0pUV zXY6VxB__{H*(8(s>!%j#K3U)x^Qg*zbZyb#7fjT~lY#K*Z4R%y#5YMa9UoLC2Y7{m zgfyjj+RR2!j0xN`$7pg4^Jmd~oApTeT%|%t9iO_HeUe|D`P6@U*a;!C@r(z>Io9L$ zB*D8KgY&)B-c+IJzp|i0V&t{x6IUG2`oG>(yDspH$#JwxJ=JbVidd*#EYpashMABq zNhotisZX6za-E|g_+2yPxv5*Jh# zNl%OvdUZOw)w7Nj+Zz6@E0$iK-t&&Hm*d!U-k^D@ggBp#iufUvb(rK3ga^!xmy6l7 zQDUJ{?9W{nCCa|7aYiYDU6GV<+d!9395s=c<(o?1&u_C$s^oliEm8FT_iXrOvkHJdj$n z!ClPM{q6d=j$W!Y&AuTb>A}bd5ga5ENVJA?)rdR)2>(gK zh0nqrtyQO1#&ng#{W2M^WKhXG&uLK$sjq~mSWTe~3eYkT#l3>G>6!!^U1YkL_I%+H zjCyN~T{PjXHE%xWCJ?&eTzg#B>VCDYXTIX~GSZ1Tcemm{QAFW$IRO^~ydG zEQu(+YjZ;4s+J00d>j{YF~n(ERXDNJXB(+#=N=)xb`6kE_Ifv@Km~f|97r!r2Y+j4wzGNK|ia0Mmv~Py+3(` z8U1j1zxw*Ab~iCeEY0*$gtin~Js<&xo3~eL$Ffw}#-b*HzmFFUZj0e#T%UK+Ojb~_ zRICE%`Qlbx~Fcvqt)>yrG*kz+>$8O*#$2ipYQW#;$9Uzp`1f~E0~q{ z?W~AB8R`mUR4;x&3Q|P*-cJ44bqa!;3&QCr=>l`MlbaRk(ShEDifcmuHSA6R0@0!x zg0AP+7#Pi2AQEuzWc(5^>gm{fq_6Z0&G6F~K}^y;E`n?ryT?Z_@b4d48Zr~t7OG4U zkTetiIay>+rwrFRv;z+zf2BFDuYp^vckzVf*~iKqm$E6E%uSjo2i4NeoEoh2=y$fw ziYAvzliqWiT$<)*`zBKFuBn;;mLIWGW{Z`lvtdk6JpX7hrh=9M30hT@xxLhQ%?lT3 zD9-$59GJF>apZSuByTgfHjRQZS|0anjR?kEpuuhcmR zd^@OftYt679H=5W5~KRh8Y>1-#K?Hx z1|DVaz5Vo+g{SM8G8KOD;+(0zXDNg-sn{}a_4@>RrSYZX2{FD_t}oMWeNI+={v~Zq zG2D;#QtvF(xM-m>qeSj^HRr^SS$%%E?#RBd4YS75m=ke*&z?SeWb#P2jVbvE&3J(| zyY6h-EyymLsKvf0=4^o?;zgcCg4%PpL*lr5;0X@>Tc2Rt_bS~8v{b0-NS%gc*xP^h z8Ns(bGpDTfDYBb#Bu)Y9`j-(;Nrp^*(=CjAA));3O@@0Xr74wvA9%(am2{!m%vp7z zq^|G(vMrG=#Fh1Gs?>sH`8Gz3@A)weaTwWUFODaUmK6k`@tPZpNNy z5>5|j$)i_sb)gb+I82N56oHe8aS(=%^4CEGj|&4FjPS`S?xukn>B#lQgsQ?k%IUix zz!45h9Jc|CNvhfc(r|Z6ZMAYN1~RT#H2%R~T6Po;v}8I|4+4Q-DNWBUvO}_^ zLbm&p){%UFc`BRTnK@RovSu&Xc&F(jYSmW(jjt81xmzT+l~1mmADx*fYMW3Cy&Ps2 z7pgKh`o7cABimJ_=Ib$fJ>bwr-Iltu8EQaE3pDqS$H{EdC#}J`-?fPEULeO6UgODc zuW8(X(L31)y~6f@FN)349W_B|HMQCp8~zIp=g3DKugqN!N9s%ECm)hq+p!tTUoBVt zu@^IR)wLHGd{Ia7ca@;6@mJdB+h3($c1$%TBtW}ad-f!2O~6NNHL%<9^Tfy0{>A;H zedlRe1AeHPf2qVm5oKgIT(sg;`_Iw2wU(bai=Lo5-O?lE=0AW1U2wQcBn>Q7u0_~i z${PD`Tchd}0eLGUR0Do&xh}QIHi^jc4W@&w- zZS>HhKurhJfo9S&GaYH1`sufFeI$~XdGuxN9%$imr#~h$>SgjO_nu1U9GH8dJhf3I zT+^vJZwWmZ`Ds~bv-BmJ+cQ)nxuJQJb6_UHyr*x4Mv=5b8E|)pR2PRBzZngN`!HC5 z?Exc6^>)fmDuE*&&Y#yvFZudu+iN9H(BJ0VTMYuR0+(KX#i$ORd$XynKe6vrF-e&N zAWua*I;Ul+x9@HbD7bZh7FV{sv+NS4iCXA5hEHF)?krjagpB?$+&pp{8l1)F(+Fq) zwt1@{uMX-qfnbvg*wsPTw$gJofZiIW^EV-gS%FKCXLQtEfE#W4)$pZDYW&@%f2W$+ z8*mU-=0^`3Wwx==eb^4hC)HNUg9D#ZMHj`-4ac+`2ygMQdj$@;t71BHP<0Ejz)6#_ zo4edL*NEU|2J?>|ujOwJ-0r6t7e`UBcDLfGbB~_ew(9oYu%PiJ@)S_vwNKa1c3c;5CL4>Z=nd~LB-W4m_Ir3w*{Ap8Q*E{dMDb5EcYoyXyXfv0u zms&N+l}LNFvRi!MB~&b(wzn!F^W1BgO{PEi!9#ezYQ;wtPVXo!2s^no-8GVzMV};; zu}pf7#iNf*(XBMe>QJUkc~c127?7kh1ZwnBoB9}gSJCCW5~`g6L5^a;0zo*~SqX$H z%u)Uxiw^Beac&h~o#IOPa7afVx1Ju2ZM``wvishrt0&)LlMUOA&s#G}f6%9-*?UnZ z!7%%4IE4&TH%N}7n=J*!aYb+hPTm$B$C*H8$C7#2koi&jfIdAgho_#8)hG>|@?97u zAI=;oN`*ga9~8U43`_KSPK_S=KF@ zo%x+S>)(ibQ+MTA!SA81jYqRD8mvj@^_Z(b*}9}eXHre*Bq@fg^!G^_yW3^yljB*I4Sl|DNmF8iV08KmFH9q4Mt^ zuQtIyL9;Yqp_F+k?$f72zm0UZ^e8f(;$F|K=ISf)FQz)M+*4U?B!n{Wx%a<@;8_t9 zX-S~>^ZV3rC(5Ntq}~(XE!F%1=x`^L&IlIEE$}%1y{dqeLP)$IX;u2?`mJm4UXHj- zY*jO%a_8^XyGt96FLv{dl0OrHECg+Cx9}Yfmc;3I%4uXrEyA}_M5;eg#!s3W${`oS z%^o81Q9YOZh^592#6!2eYvT7H2%5jHSsUGDV4at}!cb37`a%xK_aGL=5%i971M_{* zM!)bd@^Fwce$7BH=?)Q2kMr0Zh;MX?J&tz6yx+U%d8t*d$KF9!x~7qK=(skNmW6-D z%)mj4Yj}r2xY&CD8T+96q?f*N`dl6Cjc%)^#&Ox*)w2_n;m~<0gx1#lpdaEt1_E-c z&(gr?swkwv*c$3#=J=&G>ffGk=s&-^lHn9b0wTG%#4)9o1Iy>ZS@j?1S(Z&er9vcT zvj%fJ+c2Q}--=mCnvJb5nAHDA0K7Cq%XC&hH05q#oCK2lSetQ~okir%B72^q(mB6I zNww*&(^R_n(7{%{hl}KYJ(~A%&wulT>(tMGgZ~fm|1mB$?{-qbuGnr8`rU!u<>^f$ z0!h=`4NU#pO?FIrE*0tEqz~+7{6op)KZZoUha=toa0fQ5-s(i(dT0KC#r4g1L(0Ki z$d;{{*c(M-$4VS4b*!aheQ^fW5LP0rR9H)4eGx-yyxBU|o2`JUy0@CsdzxH}QdB=p z?sb;0P`LnQ0OoT_X*92=d5l?GNJalrPh(eC*7F$~@gnl*>GVT6;R#H>+Fa|zyGp}} z9gInWIptW6QcRNKi71|=#S>XPSr$)ReA0Z)b%q(2jQ5E0Jwm@nl<(0`Qc=D~KUs?M zJ%w`j1z$~^MVEomQ)zE8Y|2@{??=!F_*8y~RNYE+NvK;_0}=%wSpX6hAhGy@wG;f* zfYdDkQnv&MlQ}&Mq8|pWyO4McKPo2+-pv=YSR-@>m5!(Ob5BL6rREcKUhTvyKolix zfv`1>XHbd5HlGx*f%26f$1oI1uE@-VnNuj)uh6fg{YcPBRz$QH5v+*pC}Kh?O@>C< z`kGZod`gx33dQ`(AFG^9CtGuu1F{(-1$BGEv=&!iGrHvq#+DX&Q*@dBz)R>1{`t1# zov*g!n>#98mSs6)?`q8P`9haF7B#1z>QI^Jg?%~ZZa{5063*dCVcRQ^8!WXqUO0CF z_V%T+mVeWqU-9$4bHS>Mkuhz?iWTuJv$IW>-6KsO8)nCQ7_Rp<@>LgWT7@{}kS*~= zK3Q&qAZG)#y{-me^?tsnSl_G^8~QgZo-Y94?705J0!N?}0_+vQOOP~ayuUTR9Zd_y zT5AqkYKz7TsBl$QF)0SR_CP~#w5T+LDliTQgCsPI!Gu3@<_n~w7`MoMr5g#>pi#aA z1I8TI!35azCd}G{qv;YjIaQc1%J&_&zK>WxQO1Zakkuop(-MMvWWYrLp8 zUbHk`=*FAxJ9fr2UUoLV#KH_AVK2<`X5%GmysS4~wlrSW8*jc3d%+vu!jrDn=f7QE zG$)lw@9po{g&dy7VPZa5X6@2vUK;lIo%8g(F0b$PkfYivglYNwOD#E&{m;{UKEM*d zuJ|wCsmK3%K_CzI|6^Qi7Br}UnF3W-FzeIyOsV)CAy~)lk&f%jGHZ6v!oY)GgI56_ zx*c~}WEk$*-6ssU<-F7()oNzrT~a0uvUt_%^swEv(_!vVMew!oP+7v&hkSi>B?f%k0aud1D}yzmF1xBap=$Lk5Z$qxv-|ydij(p5uWmP!OIs)Q$$j zojktkLGu4?rkEzFtvjuH! zegVJFano-RA+mErZpZ9~Am>ntA2gls^O}O%H`{YsA zNj$rE^XQMUxzrDlU4NXb*#GmFFf`SVdrSebEB;Fgzn=dga1ZOhk8+u@nB7z`=v;>p z8-D86#yfHS?Oqx!j76(yBa9;Py8(zD1&`go9;3!o~Xf2K*UVh(X zdw3xNuYcLx%+6>5u3V{OMUZP@#McylTNGs}BOz7@%1nh@vktcEh!!*{g`uu!EC*s8 zRw;)X$zlr)EYkJ)P!XTNAYFc*ZOzR&FktTn6mlyx4^LCAyF9pSh6e35q|XlhahQ4*t#nF@2OQ9o8hbQXroVa<=LrnN6UPrj8Ty_bId%}(k>|@N>*Rl$ z=R`FV#jKxrc^;;D>e`8&;d;)*k>L~J3kFpPFSNrzdJ5{!v~%kxsqK2H?|MrB;>b)) z#1r9p9HbM$pUATbp6dYAh#>4pu(N(5(k%4D*p9+f z=582ILg79EAPiy{MPX>mNOjU+em%JJqDV%LOhlFebXQIsH-s_vBHmrk^F$Q5FjPfj zca3xA$6=ZUaTe$9a+!q_-xW^+FJ$cvgs|<%));6o>=KlWBOjn-xd(;Q2wI5!7BHYy z3$ck|* z0SRuKoGan^ewv2)5~iC6mECkALgxu!ignoyTw8`XrxDuUWZ0M$)jIF`NuC3=EOTNh zWDq9HiRT4C=@A3y`yv2(vQ_i)b^4FCC1b#0w#-GAX1*gbnfd8NO51)Sy?_m=@FcuI z06XZOv>fKrPn_6GQ#W>e52$+L322_=bIu2w+i~0|sD`+SH`jrJZj`v8h_f(vCXVd~ zPlRBQ90w>jl!0^=B;_h;8`Lln%goKgJn~{>Ou#XLR%l?$F?E14MFgUaVC|Y%5g3F( zC_r8!g$6hi;RYUZP>(gw3*ip>?iFOxafUne)(;XNc(HG%c^Lc7#DhwqkbIto@Uqah z6_?lf*SbbQNZ)tjrA$RC@@4Fh%-~}HQ`L20RNXFUJ-o{Gqh+$p;xx}v8Tc`90>=eT zAoK?kBxWbO1!+=ZSbG9X1}AreVIj0uoQj(qZtJg7z*!+ zbUEu35+}+V-5$HrJM=0%&R~Gq1tvT1$@Y8f?8b=a7Zwzd=Y^}BuGE}-w&sKQy@mB4rWB= z2M*`~8OTKW1UVj?s4{|wpr5rijRQ--e2${X1zi;km>654_%m^Driv|`Z^ zuf7O9nA=&Bfm-B;6A9V_$}omDVCyc>l5c9p9EuYzZO=}Er5A?@sF$F50vO=8Or3MW z&;u31*0k43Ds9sYs5SFJj)CF}ibZTsa8Pl=a|!E(Al`e%XFj=`w3uG99Dy{W1bK^4dayu7d39Qlw>77V#0(=p8fWz6FAn737NFlK6U?X6a ziIc~nmjVXkI1Yh?LCQXn(u+7lA=Vp-pxM`ofqO8^e2~y04zp#roTy1l8Y5Hcps50M zu~r(X8U>^tpaLwMAWxRTgd`OzCv4J6AUQMy+AT6eUka9BpE$V_+BpanuSz2AgAo`Z4OxOy;^0h#Yuhmk!e^q?W=z{K(d6O*vB>~EGckBP*+d_Fw@s{ZJ5VFi=o(JD^j?<0>PD9O3d!(5egc zbkk4Vbh%7}MC2~0oy0?M7!5-Ov^5a)o~Oq0mE-qL^-v~BYP$gpDDWl_zO(=WY>zWI zn5x1HVRp4IJ8*dZG6hW+xM>2CDNlj?JE&iFG#eBgSL>9Y;7<0Ujz?%Z!i}WJqKpi&;m#Guwb{wV={0BY9^#SO)WA@y~ z)$Op!=PCgjXKo~N5V2Vp$UL1;Z-MC;!wSO;My_5VC^p*{mWwMgU&thLk^~7ZpHK${ zR~>QD18Bz&T9-Zyt|4UR1~qgF?M~r%x_Q^ z14YFK0SV@_4?EG%U2x^MQ92 z)X}$s?5v5dW}IExM4n_p`@i1hC?tR!7|i>v`)o+`fUUjZ{%hmC{hnMyO2Ik z(xQS6rUWXAfoz|<)uc;cv|-MLZVv1&MH>bTRnm4DFhI6P7HmT|HAdTWqB!+k-~e6* zD%XU>1JFvqWklej5CbxP@$+@IxqgApkQaYjZ~pP(|J=Sz-@iCtB`?rZ^gIT2G|Q3z z2`FAJ9hpu-u$9TUWXsgRy}|ZtlN_x}XrZ5az|u09Dc%wn_aoqM#I7q&4bv+eu(hQQVU4#%xI+T_cg(p-S|zE0E@yzsxgF0DUh( z?4sNNIm$H^up30=1bV%-VD_yV84N8*MbI^~G=*t1A!b8#$Y&yk>w-~B;F8hTOa^Rr8RwwO$Q<-03FaEu$P&J??ztj> z&iRqsxpZ!b$HYU%9z-zR(o}#bA|B{+s4-#!{~$lU7fGu&2NkmEmL2_LFCw}o#mj@k(q_PV#0RiB|z$mf_ zshUKmj86z$8M8HscI~^S<+~8A4lu7`5&I}$0jjYZI91v($Ku6lZ+s}oK7Po7_ zlxQIP;yzp)ps$wdDgpQ05M-U*Vm$XQvjcsUY(c>R1cIOoyA`D#mw14*D;YT72P4vU z?Ak)n7^giguyK$9C?9@de2lZ^aFC^IG%y64RY<+|v-g?}477A311=DwbhO$w%Kw7h zbv-_~0s1{`P{Q_I8G$izeLhiuP=psm%yU03%m9fG<_L!fB0ca>Fbw3A*hQ~2@DW4= z+6{2J&>y+{k6rU3j{OK!4A4dDN<#07IF6q$`Gk!E*9J>hGl5ZS{)ijjXJi}Mpt<CAC^}v%HFlgiv^5s!(ahzU(&sYjZQ1~JWq}VT< z0MQthDj)*H<%Gz$MVs@rH=F?51@n@F60VQVNq=mx33AQIb~z|qGZT?s03GdeLfl8L z(YDYFLEZD6Jr?x{lFgY2C^CVNVEsic!#T*nBC@l6PJ1BDpp9t3?-K(+qiP2ni7xth zf#G?h{OYQwPRKYMde$QlAlgs4f7lbXPuQIPJX|%w0K_}HKovTL&!?RaEX@J!cQ0QJ z;lPlWpk@Oscu$Y-pvR+3J(mV%L2ZXWf!5B)dX#a_xCR3Y(18O}r)@e9a_g%OyB;5- zAPO;(PTOFkqi3LrKvAACflwX*cdw#nMg&+(P&2pbz0b-0TPrA7YNB2 z;tHnb2((Qq0MKF-M;>Kgb_&KG=PJ%9TBBv)1h4?d*DL+w{lC;p zAp$;}KD0OhAwSHANwgp;zZyXRi4OX@o|NMkTL5QZeoC7&5Z}ecf3yt-x{)ay3q!9M z3=f1jm^jhS)fVaybNpcK0JW|NY`0EzwL4IdP>i8H9G)M6A`&^>{=6Q?6e35sp~K*X z0vBToctb*(wd2R*gdRpd*ngg8F#~)@&?n&=yq{NxTtjs&__8ui7~=K$iqB`gfA1SMCBerSU@qh3<~XLsFxG*MNz;E zkS{?}7HNUgQ+ANWZ`%;KvFwr{&&c4*lB z{yypuYWu8y=z>HB31+OCj|&JOT;q)7U}277!|i?CATCE9s8ATR#sZ>;`P7O0Wff(N zup%HS3Hny)zS=WPfto0N&INF53NWNl+jk=Z2?%olEHZ(GHfT>B{*g|{It{M$*_sc) zf~k*AS$nuclhB3?l!NhI3BA#Txxd*5yFc|2bZ|5Gp;dz8Au=gDf&lNBS z9MjFPSI8J44;^Lajk&r1PwyXtA-v+H7 zhS?t;>_EK)P2K<_VC?N8*mq!bHT8=YgDOB^R7JKM+I#x_iTD6yV1NWYAFKz3uiaZo z2t%&mYNh~g86W}maDd+3ZPZJbJK+GP59);L=$%^Q9JQoTyROG4e*khd!2Jv3BSL62 zX|7k`Fy0YL=}oi4{Jto^yg;&Ef|!6_N3IT+?}%BYIv)2=U@Qq3X)ZdA_XuP{KxJnF zu&HqQAw(IwzvCETx*R4MT9G|^3#!0nGy_mb!rmY0B*u_?&w%5DZYu11*{p|wRt5%X zXQ8KO(K!DuE}RGh7ECDgQtao=#$ddNfkUGicT(@+)I}<(_Us}s(E33alinTnv*TQs z!ZCn`v_IDG8ks@vY(%0Ie8eNrmVhm2Q)#@v81cxKS%AOT6cQ6L+kC7~8~BnZI7DJ1 zpyQ5oA0uru=K(@;K@^3)7##D1Bg?eH09~>OLuj>kw9^xD{NAHdp=F-Mq zF&8^R2{0Tluv-E^$2f}-@l`4S1sL#;yY27h-bQN16=4QAL><9`>8`pKTeKXo^jK~T&bM|rJKLpO# z;nMDP8zZ)uvjm}qE-;%&%d-&=MJ|0wq}b<=kEbns9KJ`*-=kN4kq z1@8I@I^w1Keb0me$6(0;pj!ZcwfFHo2b2>b;FATI3@}Js>D|{=OvrR111Ok5Al|~B zn9**3w(79(`J6%T9LBHinYn=ki3m9!!@zbx6ZeMuW~qyY!r_C$0c{2oY#;wMjf0e& z5+krXaZ9v6)PGGG3S`I$E(!!lBv+30U+V~Du6hT!lLf;KI~F*G`JSnZt}jfu=%*a- zd!{k0qRka7G&-f0W_R*E6Cyz!<T8DU;H(Ct{XDtEPdJ<-Z_CAgF9tR$hau9Kd$o_EIeSp`Ux)?}KeiB{r zV7SRazGr%M5c2oS0N5okkLHfEp8e1?1wx0-O90{oxIxj|(^;(g6}r4_FpWc>c7l)h zXH)A~C_#V`yq<@9E{Y6cyS%&#Q;~sh4}0kr;paR3*F-&$6b1xP7lW{G*}H$U0O2SK zj8>udSUM5o)E&NO>JBJGd;(*5xD)z%k!+mrS$XJfFEZePeqp0&tAxqetT@#gi z0U&g+@0pkjaBV*NU{8WMSLB%(;7Ua#2^QW*FhX2WEy9g=`meDcP=Pliv?;TV+mVc` z-`k9M7Q%@Pc(grd&kbUvi3!1#?;s3aH}XR5S{UJv#f}OoIIIW^XHXC9c4ud|FPsc& zA-VYzL;~#Q!1cSctMvG>9SV`K`9#Fce>Qrk_V8m9%7n|cZ{WkgJObBm(Y||p&xkK! zEGb~xJfL{LB^+p!?-{YjHjNTwpihahnLEA1*frsCO)hk7u%a+)$!PB|;vIm69GK$^ z8_3yjC5%yCa73Q)xaJyyJ_1l{{_mkrG##8!e(jyjxCV_exJtwg|uL@05~1o=w@ ziqJM{M(B$1w2ys&*BYbG*@ka~ffC9UzILSd`-f==*?v-0Kfvt|QO|~@VLQ9AYdrJ> zV5`J1k!arlGHf$C;#x#9;9v!=<)OJe#`jD_AtK*spoa>f>=4KCWq?EXqwZkjYy$>6^D{Zc(qjm%qa^cMyvmsuE#)OUm4DGQ%tAN9N z&xj`JxEu`Fu-H_+E-}XUjChhxz*#0x4AMu~5xLUudq!MIV|^n;#RQC{4k{kydq(6* z5pfa>F^3cGw77%s8QUujS4)Vl79bhTp2zr}5t$%xIYv>t2*W_@E5m%x*h}eh&r}G; z0w}+pJu0&oQHnHtAGj9`SedPtj|Vu45jPkj#b97MM7Wpx`meD?((`=|(vv6+wBa~* zL$AbWmMG%zLeQM-B4fgMUpDF2GT=%(*i10_G4tpizGoaw+*`xIfwqf&9)HB1W0fx{ zV!8?F%MNa}E`mcle9u$|^m)lEx)M~?2*lbRzGnbbsrVu7$pJmCNO3yOPh9OhLqHLT zd^^xtoc42K17TG?4bk2cV10y9OFZZ<-*dHV0O5d&=t(c=+^{>w_l%}#$bp0HAYHNF z-eNRT1CB;a2nQOHQ*A*T?k+}KBnS;)flXN z9?o0O>l&G1zUKh*!c{%@z(NaLiq_fFQ;dV+R=Ye9A})hQMb@M7-fSmwfR=b09aPc5 zTJ#5djG>E+p(6;)Cuav8S;cyGKSS5NO57nNbl71otP!qaqzq3Q?Fn%!R}ox3-h&OV z_p6BT5Vs}yfrvtJ$6UuqbiTufQ}`aHc=OsF|NSmv7y{qrBZ)heeO!jUn}-~6=~sJ` z2r%e$Zn0=G)c1@qf+~my-~bj}={R~JXM{%d=gYzIe`i> zzqZzZN4v3c3_>P@0AS?00T_pJA2&9TN9b|d!%abfEQ0YzZ&ZesMIIjn=qa>NI(uiU z!sbOj$DohFK*Duel01xY86&ZaXK?1~}XfSm;8dJSO%1=JI!PU#kYoh(m`P&`7mQcdX}`8X9nnN`b38 zw%^XL26~=pj3SSNb=}Ygb=}$1^Gx&?MFzwWEd{-_y~FcNo8u!sDlX;Y4>S$$^gQFM zL&xR-JWOs-WJw@Wew+kh^aI@9y3a0ULXfbH9tMD7j17`|d9rb@W_3Oc!HaOQMrzA^(5`2j4(c$7 ziIU%;oj=rTj13W7^K&9?J$C0!?Dg^@#}ifFTm>=0IQ7U(=-A^9r_)|ofEdC6t4O+q z2X$nIXH>-a7J7u|W4OC7I7b@hdBzhOBwGgY(6cLi2czjndY%R4+I1Wb%g3Xdy#01i zV;61|5mF~(DjL?zsi(I;+j#N_9$-$@odE^Ne?VA~!M9vF;L6uV*f_B>;6 z`ObezZ0H3cd~M&vFwWmgu4!&)5p>`2!ri-`F`b?8BBQb!fT#=k0_H%!HX={>BILk= zAPhWLj`TcZcW}oPgCreXZw#V4C$(2w_zi-_ggcl(dLOSg_Lt5FVc|!2#6~npV_gDi2c&cnYBI+2jChhPf(?P8 zLp&@pGL7^+Bd%n193sI3M8I6_I5caN=NSP@$vjGcKO5*du$_)=t$i+H4-+tWt^o{{ zXUA)|Y=^nA$z3V=Vl5rQCo!SX2+uS2Qo24P8HtAsNaCPlJkLlewBwos@_-}ynxPNz zJOh^CpWrYea(38d4EtEmGbUm8xw;94dMH73x%+vZai6B|^3fELi;k_R$FsG=^Nfjt zgOHOOs8Vi~=V7GhnKrU>(JJu-A+#^-5uRt1UzjGP0^{OdTp&K3>#f`K>>Hlv5OdLb zm_P`+xQFNY_dbC7aQ&_qo&UaLR^`#%PGavr{~g!=>?v?XSLM{Qr#7CDBM;}lKgM-^ zn{3v%Ag;4%KNZX_--2MVzGSPj&o|cPU*c=)<&W0p^V)io&L@+n(^u<@tJ|AwdV9Ia zu5UK0^d?&p%;^uWUrrg!X$f;OnNC+1SLdsAbu+yLJ(C_>rsucIZ2Igf-ozK#4KTFl zpP%6yzPp4MOn;3xt2jB&u2tci>@3?@_<4CVTV2kl?E2=LDYY63F4wnEXL_~C($zII z!mI%WRmW5>=Yt>v3WflF`QwbRRYKlb1CXk*eR+KaPqFVmtkd|sweQpR3*cPbT9>!h z>TSzA8)Y}KwMndvwYj#o*4H65;?pZ@YvUjKo4~&mzrnv>POpYR$Pq$L5ORQ!0|fX6 z|9&~mhe3!DLQD{1fDi)&_y+%eIgN)vSms}sU#;bK2_1*O*n0ZN)kkbCvs68$&s={F zgZ*_0XvH_+$L5+op!z1(@HVjqxQS1TpN0ZX6yQVwPE_rr0Gt$nlLBxu83H*=Prq6j zj$?*H0e=QHCZx0KS$?&NY4^oT0Rd%;JWlI)z2L9Jdz&PC9rt| zEc{boa|KokPXkqDgXg%ODKt>^%n6_40$l+##)rqw(ta`Xm-ganwOEL`0vaozHkgxM zs9u$*@<+~dM>=+(0qbWHi(&(aE3S~2uD%j;#a96~zp>!IIh3{4+m~zL2H!fCW?J;% z(s)3RR&VhUvCK&^JR5A>MZBE>DCGCE)mzJ%&#T{)=I?_4j!gz2M^LhS_!S?{;OQ|u zoxj+y*InZ;u0qh}g%(_? zd|Z2cJXK@Is^?!{%;4dI{w!urRTOUL&3EDqfNBVG7E!&vT2J*268rJ()fA29%__O2 zL9Byb<%p~QfGGg7_4E3CImg-1EC*;Iy5BCg&`}_G`b>!(S0!>*BG)ByqeRR~#JWV> z_BK7w@MA&u`mO4=_F_GI@MA&ux&i98)&@N*@MA&ux-IIqy*a;7V~8k_fN*jjQ+wdw z+$fiu<#H;QL%G~67n|i`Di=e!xH9Ly6r~l5OvFo_R>I*`-20z=vFZg|4d(SK({1b5ex%Z{;UwdD2>Pv3+ zC9nFD1K7L(n{%-Fj=rctr@rL1zU1@Tdu9odhwe*0?|o@!Ut;P@Z1yFt`Vs@!xBwe- zu53}DrZ@CF@>QoZs`x27C4t^(ky5SEHoW9OXlq*^JdAoy<~&j)kH4Z zaa2}sXHmqw)ckM!st{waH^m^}XW52wU}I&sj>|TboUg$V)q9KIXcX!kvw9)#CurBo zuy#&hT*FzHhat8dHo#JJTr6Z{zAh~kWjYCme%FT<+b$%|6IO$WySEX)mOZPf4w}h ze*I*9vQGZ%JL}{>Z&NFK|IzyJ1sx1utR?;Z-g>iz|KGi_-lWzCaz*10);diuZ!fG@ z+tc*(dX;9@a{ZrWTTi}pJF6=MObG$2?0Ons!`wYT$Ion=u5OeEyZE{3z`k$)^|rt| zehjOi1`GZ|aZox}X?)&YoDbv>@Hp0!A?|c2H^aiieCe-V4FL+IHA50ZxW~>g$bUlr z{}QXD@kUP_U2#awpDH)%pf`OQSsrF1chrun3$u7oCt#+}m?N0*J*3`;FAXR1pnAwm z%y^3-W29=SQ8HpRhP1TaP^*|JV`D>xS6oufdV6*KUH~8-<^bUPri*?+tvA~}tG#=( zU&WS4f+58DWk@L{S!ONcwv$_w(r5@%W&&%{5&W|=q~Zj4K`(_gYkV4A;~mx*QGPr6 z4e7Wy{P5q@q=991a|V`92SYxIZ;hT#hmF|w^=q@%AOxvOV_x**#k<*HjQ)7B9aA_R zQ<%_1?QUKJ+lIX#(YmsD+jP&iFy$^`rs?uGn>fvM4uU}ecPkpa6>7q(4(&j1RKJcEh8N-BwfKTzWv^Eglib(BS zc7If`bcAG8!#6Js?>0kws)wQh?gieFT3XoRPmk~E0zAJ58|`M5D%<0?djvh{KwAsW z@dClZ5%sMxO_Xee`-|K2*#`_N9ZphJ^7xLE+U%=$Y#Q^|loxGbr z7&3~TOAmyNt$~eg3pToUu9@pIqnBh5d(%-1GIW`XFl^nWeZd8~Xq{{yZhZL0f`=KR z)EJ_)Wr%t=-OdIrobl1=^eXmVY*5M}fyP@W={+OA5cp+k#A-S0{$4XJa9dBn$anxQ z3F^f@)VLq0o7LXdDc{?Azuj$-!HNb<7SOfN*5m{`CjYo8PwO07D9sgpRZ?osCjBU= zoI{W{Ws&uxMBg`au0yrVu}(A?Q>|lmv3Y{V6DlTdCOCVbV$aW}@tpOx8fTTl#D6UaL;p4== zwP`Osu!oC+Ne2hK&w2X#_Tp-~$*ynDZ|-@5lIqowGmcj4lym+Bbg7@LlTToYgCYld z6)EIoo1^_lW(bfmDO}dcXancR3kzru{%zr3YSFk^GNVE-Bi$?`(df`KhR3Uo2?O7^LBN9{_J}C_U+4R z0qtttmG$9}^g#uENNZ%JG8$lb2!Jf(Ngh6_M3UVMN*}PX&a7X7n$BMSI5dSo(K&Sc zs}urT9?L?cnB_Up7?ipu`yJ@pBuF!v05(?bu3y?O92uzH^(8^`ifZW|a78%@Uj8^u z;_DSP^Nq2BJGtA&`^LU{79W2`fw%C~p#V~f1*Y$!_Fd}l6LYsv%Vr@al3_3aet*y^ zD-OLTvY@!v^1gjR=m>$A8}BJdzl_+Qz1sfp@%2j#j)uWloWXDK`~{Sqzt~WibI&4^ z-muYDapo194_I|}dq&-5=$zqfbgX)p;T;tsR1x(<%SI4mI0&BD4NvTZCo6bzH#}Lu zn>2dM1{bGYD_+{il~N^OrG>_Eg>>3{QDR*bdoN0mprsi>%#~}k@N2b1Fn7zPgHm_r zi}XLtH~0K(b+bCVTyL^_f5#5}4|A2*^gq`-=zouMEuOCrv*>UguETY>{spi95C7m- IVE}9e0GS9!3jhEB literal 0 HcmV?d00001 diff --git a/src/eDFT/AO_values_grid.f90 b/src/eDFT/AO_values_grid.f90 deleted file mode 100644 index 67b672a..0000000 --- a/src/eDFT/AO_values_grid.f90 +++ /dev/null @@ -1,101 +0,0 @@ -subroutine AO_values_grid(nBas,nShell,CenterShell,TotAngMomShell,KShell,DShell,ExpShell, & - nGrid,root,AO,dAO) - -! Compute values of the AOs and their derivatives with respect to the cartesian coordinates - - implicit none - include 'parameters.h' - -! Input variables - - integer,intent(in) :: nBas,nShell - double precision,intent(in) :: CenterShell(maxShell,ncart) - integer,intent(in) :: TotAngMomShell(maxShell) - integer,intent(in) :: KShell(maxShell) - double precision,intent(in) :: DShell(maxShell,maxK) - double precision,intent(in) :: ExpShell(maxShell,maxK) - double precision,intent(in) :: root(ncart,nGrid) - integer,intent(in) :: nGrid - -! Local variables - - integer :: atot,nShellFunction,a(ncart) - integer,allocatable :: ShellFunction(:,:) - double precision :: rASq,xA,yA,zA,norm_coeff,prim - - integer :: iSh,iShF,iK,iG,iBas - -! Output variables - - double precision,intent(out) :: AO(nBas,nGrid) - double precision,intent(out) :: dAO(ncart,nBas,nGrid) - -! Initialization - - iBas = 0 - AO(:,:) = 0d0 - dAO(:,:,:) = 0d0 - -!------------------------------------------------------------------------ -! Loops over shells -!------------------------------------------------------------------------ - do iSh=1,nShell - - atot = TotAngMomShell(iSh) - nShellFunction = (atot*atot + 3*atot + 2)/2 - allocate(ShellFunction(1:nShellFunction,1:3)) - call generate_shell(atot,nShellFunction,ShellFunction) - - do iShF=1,nShellFunction - - iBas = iBas + 1 - a(:) = ShellFunction(iShF,:) - - do iG=1,nGrid - - xA = root(1,iG) - CenterShell(iSh,1) - yA = root(2,iG) - CenterShell(iSh,2) - zA = root(3,iG) - CenterShell(iSh,3) - -! Calculate distance for exponential - - rASq = xA**2 + yA**2 + zA**2 - -!------------------------------------------------------------------------ -! Loops over contraction degrees -!------------------------------------------------------------------------- - do iK=1,KShell(iSh) - -! Calculate the exponential part - - prim = DShell(iSh,iK)*norm_coeff(ExpShell(iSh,iK),a)*exp(-ExpShell(iSh,iK)*rASq) - AO(iBas,iG) = AO(iBas,iG) + prim - - prim = -2d0*ExpShell(iSh,iK)*prim - dAO(:,iBas,iG) = dAO(:,iBas,iG) + prim - - enddo - - dAO(1,iBas,iG) = xA**(a(1)+1)*yA**a(2)*zA**a(3)*dAO(1,iBas,iG) - if(a(1) > 0) dAO(1,iBas,iG) = dAO(1,iBas,iG) + dble(a(1))*xA**(a(1)-1)*yA**a(2)*zA**a(3)*AO(iBas,iG) - - dAO(2,iBas,iG) = xA**a(1)*yA**(a(2)+1)*zA**a(3)*dAO(2,iBas,iG) - if(a(2) > 0) dAO(2,iBas,iG) = dAO(2,iBas,iG) + dble(a(2))*xA**a(1)*yA**(a(2)-1)*zA**a(3)*AO(iBas,iG) - - dAO(3,iBas,iG) = xA**a(1)*yA**a(2)*zA**(a(3)+1)*dAO(3,iBas,iG) - if(a(3) > 0) dAO(3,iBas,iG) = dAO(3,iBas,iG) + dble(a(3))*xA**a(1)*yA**a(2)*zA**(a(3)-1)*AO(iBas,iG) - -! Calculate polynmial part - - AO(iBas,iG) = xA**a(1)*yA**a(2)*zA**a(3)*AO(iBas,iG) - - enddo - - enddo - deallocate(ShellFunction) - enddo -!------------------------------------------------------------------------ -! End loops over shells -!------------------------------------------------------------------------ - -end subroutine AO_values_grid diff --git a/src/eDFT/B88_gga_exchange_energy.f90 b/src/eDFT/B88_gga_exchange_energy.f90 deleted file mode 100644 index ed7e221..0000000 --- a/src/eDFT/B88_gga_exchange_energy.f90 +++ /dev/null @@ -1,48 +0,0 @@ -subroutine B88_gga_exchange_energy(nGrid,weight,rho,drho,Ex) - -! Compute Becke's 88 GGA exchange energy - - implicit none - - include 'parameters.h' - -! Input variables - - integer,intent(in) :: nGrid - double precision,intent(in) :: weight(nGrid) - double precision,intent(in) :: rho(nGrid) - double precision,intent(in) :: drho(3,nGrid) - -! Local variables - - integer :: iG - double precision :: b - double precision :: r,g,x - -! Output variables - - double precision :: Ex - -! Coefficients for B88 GGA exchange functional - - b = 0.0042d0 - -! Compute GGA exchange energy - - Ex = 0d0 - - do iG=1,nGrid - - r = max(0d0,rho(iG)) - - if(r > threshold) then - g = drho(1,iG)**2 + drho(2,iG)**2 + drho(3,iG)**2 - x = sqrt(g)/r**(4d0/3d0) - - Ex = Ex + weight(iG)*r**(4d0/3d0)*(CxLSDA - b*x**2/(1d0 + 6d0*b*x*asinh(x))) - - end if - - end do - -end subroutine B88_gga_exchange_energy diff --git a/src/eDFT/B88_gga_exchange_potential.f90 b/src/eDFT/B88_gga_exchange_potential.f90 deleted file mode 100644 index 02d2ca7..0000000 --- a/src/eDFT/B88_gga_exchange_potential.f90 +++ /dev/null @@ -1,73 +0,0 @@ -subroutine B88_gga_exchange_potential(nGrid,weight,nBas,AO,dAO,rho,drho,Fx) - -! Compute Becke's GGA exchange potential - - implicit none - include 'parameters.h' - -! Input variables - - integer,intent(in) :: nGrid - double precision,intent(in) :: weight(nGrid) - integer,intent(in) :: nBas - double precision,intent(in) :: AO(nBas,nGrid) - double precision,intent(in) :: dAO(3,nBas,nGrid) - double precision,intent(in) :: rho(nGrid) - double precision,intent(in) :: drho(3,nGrid) - -! Local variables - - integer :: mu,nu,iG - double precision :: b - double precision :: vAO,gAO - double precision :: r,g,x,dxdr,dxdg,f - -! Output variables - - double precision,intent(out) :: Fx(nBas,nBas) - -! Coefficients for B88 GGA exchange functional - - b = 0.0042d0 - -! Compute GGA exchange matrix in the AO basis - - Fx(:,:) = 0d0 - - do mu=1,nBas - do nu=1,nBas - do iG=1,nGrid - - r = max(0d0,rho(iG)) - - if(r > threshold) then - - vAO = weight(iG)*AO(mu,iG)*AO(nu,iG) - - g = drho(1,iG)**2 + drho(2,iG)**2 + drho(3,iG)**2 - x = sqrt(g)/r**(4d0/3d0) - dxdr = - 4d0*sqrt(g)/(3d0*r**(7d0/3d0))/x - dxdg = + 1d0/(2d0*sqrt(g)*r**(4d0/3d0))/x - - f = b*x**2/(1d0 + 6d0*b*x*asinh(x)) - - Fx(mu,nu) = Fx(mu,nu) + vAO*( & - 4d0/3d0*r**(1d0/3d0)*(CxLSDA - f) & - - 2d0*r**(4d0/3d0)*dxdr*f & - + r**(4d0/3d0)*dxdr*(6d0*b*x*asinh(x) + 6d0*b*x**2/sqrt(1d0+x**2))*f/(1d0 + 6d0*b*x*asinh(x)) ) - - gAO = drho(1,iG)*(dAO(1,mu,iG)*AO(nu,iG) + AO(mu,iG)*dAO(1,nu,iG)) & - + drho(2,iG)*(dAO(2,mu,iG)*AO(nu,iG) + AO(mu,iG)*dAO(2,nu,iG)) & - + drho(3,iG)*(dAO(3,mu,iG)*AO(nu,iG) + AO(mu,iG)*dAO(3,nu,iG)) - gAO = weight(iG)*gAO - - Fx(mu,nu) = Fx(mu,nu) + 2d0*gAO*r**(4d0/3d0)*dxdg*( & - - 2d0*f + (6d0*b*x*asinh(x) + 6d0*b*x**2/sqrt(1d0+x**2))*f/(1d0 + 6d0*b*x*asinh(x)) ) - - end if - - end do - end do - end do - -end subroutine B88_gga_exchange_potential diff --git a/src/eDFT/C16_lda_correlation_energy.f90 b/src/eDFT/C16_lda_correlation_energy.f90 deleted file mode 100644 index 3b9df41..0000000 --- a/src/eDFT/C16_lda_correlation_energy.f90 +++ /dev/null @@ -1,93 +0,0 @@ -subroutine C16_lda_correlation_energy(nGrid,weight,rho,Ec) - -! Compute unrestricted Chachiyo's LDA correlation energy - - implicit none - include 'parameters.h' - -! Input variables - - integer,intent(in) :: nGrid - double precision,intent(in) :: weight(nGrid) - double precision,intent(in) :: rho(nGrid,nspin) - -! Local variables - - integer :: iG - double precision :: ra,rb,r,rs - double precision :: a_p,b_p,ec_p - double precision :: a_f,b_f,ec_f - double precision :: z,fz,ec_z - -! Output variables - - double precision :: Ec(nsp) - -! Coefficients for Chachiyo's LDA correlation - - a_p = (log(2d0) - 1d0)/(2d0*pi**2) - b_p = 20.4562557d0 - - a_f = (log(2d0) - 1d0)/(4d0*pi**2) - b_f = 27.4203609d0 - -! Compute LDA correlation energy - - Ec(:) = 0d0 - - do iG=1,nGrid - -! Spin-up and spin-down densities - - ra = max(0d0,rho(iG,1)) - rb = max(0d0,rho(iG,2)) - -! Total density - - r = ra + rb - -! Spin-up part contribution - - if(ra > threshold) then - - rs = (4d0*pi*ra/3d0)**(-1d0/3d0) - ec_f = a_f*log(1d0 + b_f/rs + b_f/rs**2) - - Ec(1) = Ec(1) + weight(iG)*ec_f*ra - - endif - -! Opposite-spin contribution - - if(r > threshold) then - - rs = (4d0*pi*r/3d0)**(-1d0/3d0) - ec_p = a_p*log(1d0 + b_p/rs + b_p/rs**2) - ec_f = a_f*log(1d0 + b_f/rs + b_f/rs**2) - - z = (ra-rb)/r - fz = (1d0 + z)**(4d0/3d0) + (1d0 - z)**(4d0/3d0) - 2d0 - fz = fz/(2d0*(2d0**(1d0/3d0) - 1d0)) - - ec_z = ec_p + (ec_f - ec_p)*fz - - Ec(2) = Ec(2) + weight(iG)*ec_z*r - - endif - -! Spin-down contribution - - if(rb > threshold) then - - rs = (4d0*pi*rb/3d0)**(-1d0/3d0) - ec_f = a_f*log(1d0 + b_f/rs + b_f/rs**2) - - Ec(3) = Ec(3) + weight(iG)*ec_f*rb - - endif - - enddo - - Ec(2) = Ec(2) - Ec(1) - Ec(3) - -end subroutine C16_lda_correlation_energy diff --git a/src/eDFT/C16_lda_correlation_potential.f90 b/src/eDFT/C16_lda_correlation_potential.f90 deleted file mode 100644 index aa58e0b..0000000 --- a/src/eDFT/C16_lda_correlation_potential.f90 +++ /dev/null @@ -1,131 +0,0 @@ -subroutine C16_lda_correlation_potential(nGrid,weight,nBas,AO,rho,Fc) - -! Compute unrestricted LDA correlation potential - - implicit none -include 'parameters.h' - -! Input variables - - integer,intent(in) :: nGrid - double precision,intent(in) :: weight(nGrid) - integer,intent(in) :: nBas - double precision,intent(in) :: AO(nBas,nGrid) - double precision,intent(in) :: rho(nGrid,nspin) - -! Local variables - - integer :: mu,nu,iG - double precision :: ra,rb,r,rs - double precision :: a_p,b_p,ec_p,decdrs_p,decdra_p,decdrb_p - double precision :: a_f,b_f,ec_f,decdrs_f,decdra_f,decdrb_f - double precision :: ec_z,decdra_z,decdrb_z - double precision :: z,dzdra,dzdrb,fz,dfzdz,dfzdra,dfzdrb - double precision :: drsdra,drsdrb,dFcdra,dFcdrb - -! Output variables - - double precision,intent(out) :: Fc(nBas,nBas,nspin) - -! Coefficients for Chachiyo's LDA correlation - - a_p = (log(2d0) - 1d0)/(2d0*pi**2) - b_p = 20.4562557d0 - - a_f = (log(2d0) - 1d0)/(4d0*pi**2) - b_f = 27.4203609d0 - -! Compute LDA correlation matrix in the AO basis - - Fc(:,:,:) = 0d0 - - do mu=1,nBas - do nu=1,nBas - do iG=1,nGrid - -! Spin-up and spin-down densities - - ra = max(0d0,rho(iG,1)) - rb = max(0d0,rho(iG,2)) - -! Total density - - r = ra + rb - -! Spin-up part contribution - - if(ra > threshold) then - - rs = (4d0*pi*r/3d0)**(-1d0/3d0) - - ec_p = a_p*log(1d0 + b_p/rs + b_p/rs**2) - ec_f = a_f*log(1d0 + b_f/rs + b_f/rs**2) - - z = (ra-rb)/r - - fz = (1d0 + z)**(4d0/3d0) + (1d0 - z)**(4d0/3d0) - 2d0 - fz = fz/(2d0*(2d0**(1d0/3d0) - 1d0)) - - ec_z = ec_p + (ec_f - ec_p)*fz - - dzdra = (1d0 - z)/r - dfzdz = (4d0/3d0)*((1d0 + z)**(1d0/3d0) - (1d0 - z)**(1d0/3d0))/(2d0*(2d0**(1d0/3d0) - 1d0)) - dfzdra = dzdra*dfzdz - - drsdra = - (36d0*pi)**(-1d0/3d0)*r**(-4d0/3d0) - - decdrs_p = - a_p/rs**2*(b_p + 2d0*b_p/rs)/(1d0 + b_p/rs + b_p/rs**2) - decdrs_f = - a_f/rs**2*(b_f + 2d0*b_f/rs)/(1d0 + b_f/rs + b_f/rs**2) - - decdra_p = drsdra*decdrs_p - decdra_f = drsdra*decdrs_f - - decdra_z = decdra_p + (decdra_f - decdra_p)*fz + (ec_f - ec_p)*dfzdra - - dFcdra = decdra_z*r + ec_z - - Fc(mu,nu,1) = Fc(mu,nu,1) + weight(iG)*AO(mu,iG)*AO(nu,iG)*dFcdra - - endif - -! Spin-down part contribution - - if(rb > threshold) then - - rs = (4d0*pi*r/3d0)**(-1d0/3d0) - - ec_p = a_p*log(1d0 + b_p/rs + b_p/rs**2) - ec_f = a_f*log(1d0 + b_f/rs + b_f/rs**2) - - z = (ra-rb)/r - - fz = (1d0 + z)**(4d0/3d0) + (1d0 - z)**(4d0/3d0) - 2d0 - fz = fz/(2d0*(2d0**(1d0/3d0) - 1d0)) - - ec_z = ec_p + (ec_f - ec_p)*fz - - dzdrb = - (1d0 + z)/r - dfzdz = (4d0/3d0)*((1d0 + z)**(1d0/3d0) - (1d0 - z)**(1d0/3d0))/(2d0*(2d0**(1d0/3d0) - 1d0)) - dfzdrb = dzdrb*dfzdz - - drsdrb = - (36d0*pi)**(-1d0/3d0)*r**(-4d0/3d0) - - decdrs_p = - a_p/rs**2*(b_p + 2d0*b_p/rs)/(1d0 + b_p/rs + b_p/rs**2) - decdrs_f = - a_f/rs**2*(b_f + 2d0*b_f/rs)/(1d0 + b_f/rs + b_f/rs**2) - - decdrb_p = drsdrb*decdrs_p - decdrb_f = drsdrb*decdrs_f - - decdrb_z = decdrb_p + (decdrb_f - decdrb_p)*fz + (ec_f - ec_p)*dfzdrb - - dFcdrb = decdrb_z*r + ec_z - - Fc(mu,nu,2) = Fc(mu,nu,2) + weight(iG)*AO(mu,iG)*AO(nu,iG)*dFcdrb - - endif - - enddo - enddo - enddo - -end subroutine C16_lda_correlation_potential diff --git a/src/eDFT/CC_B88_gga_exchange_energy.f90 b/src/eDFT/CC_B88_gga_exchange_energy.f90 deleted file mode 100644 index e655909..0000000 --- a/src/eDFT/CC_B88_gga_exchange_energy.f90 +++ /dev/null @@ -1,100 +0,0 @@ -subroutine CC_B88_gga_exchange_energy(nEns,wEns,nCC,aCC,nGrid,weight,& - rho,drho,Cx_choice,Ex) - -! Compute the unrestricted version of the curvature-corrected exchange functional - - implicit none - include 'parameters.h' - -! Input variables - - integer,intent(in) :: nEns - double precision,intent(in) :: wEns(nEns) - integer,intent(in) :: nCC - double precision,intent(in) :: aCC(nCC,nEns-1) - integer,intent(in) :: nGrid - double precision,intent(in) :: weight(nGrid) - double precision,intent(in) :: rho(nGrid) - double precision,intent(in) :: drho(3,nGrid) - integer,intent(in) :: Cx_choice - -! Local variables - - integer :: iG - double precision :: b - double precision :: r,g,x - - double precision :: a1,b1,c1,d1,w1 - double precision :: a2,b2,c2,d2,w2 - double precision :: Fx1,Fx2,Cx - -! Output variables - - double precision :: Ex - -! Coefficients for B88 GGA exchange functional - - b = 0.0042d0 - -! Defining enhancements factor for weight-dependent functionals - -! Parameters for first state - - a1 = aCC(1,1) - b1 = aCC(2,1) - c1 = aCC(3,1) - d1 = aCC(4,1) - -! Parameters for second state - - a2 = aCC(1,2) - b2 = aCC(2,2) - c2 = aCC(3,2) - d2 = aCC(4,2) - - - w1 = wEns(2) - Fx1 = 1d0 + a1*w1 + b1*w1**2 + c1*w1**3 + d1*w1**4 - - w2 = wEns(3) - Fx2 = 1d0 + a2*w2 + b2*w2**2 + c2*w2**3 + d2*w2**4 - - - select case (Cx_choice) - - case(1) - Cx = Fx1 - - case(2) - Cx = Fx2 - - case(3) - Cx = Fx2*Fx1 - - case default - Cx = 1.d0 - - end select - - -! Compute GIC-GGA exchange energy - - Ex = 0d0 - - do iG=1,nGrid - - r = max(0d0,rho(iG)) - - if(r > threshold) then - g = drho(1,iG)**2 + drho(2,iG)**2 + drho(3,iG)**2 - x = sqrt(g)/r**(4d0/3d0) - - Ex = Ex + weight(iG)*r**(4d0/3d0)*(CxLSDA - b*x**2/(1d0 + 6d0*b*x*asinh(x))) - - end if - - end do - - Ex = Cx*Ex - -end subroutine CC_B88_gga_exchange_energy diff --git a/src/eDFT/CC_B88_gga_exchange_potential.f90 b/src/eDFT/CC_B88_gga_exchange_potential.f90 deleted file mode 100644 index 01f4d8d..0000000 --- a/src/eDFT/CC_B88_gga_exchange_potential.f90 +++ /dev/null @@ -1,125 +0,0 @@ -subroutine CC_B88_gga_exchange_potential(nEns,wEns,nCC,aCC,nGrid,weight,nBas,& - AO,dAO,rho,drho,Cx_choice,doNcentered,Fx) - -! Compute the unrestricted version of the curvature-corrected exchange potential - - implicit none - include 'parameters.h' - -! Input variables - - integer,intent(in) :: nEns - double precision,intent(in) :: wEns(nEns) - integer,intent(in) :: nCC - double precision,intent(in) :: aCC(nCC,nEns-1) - integer,intent(in) :: nGrid - double precision,intent(in) :: weight(nGrid) - integer,intent(in) :: nBas - double precision,intent(in) :: AO(nBas,nGrid) - double precision,intent(in) :: dAO(3,nBas,nGrid) - double precision,intent(in) :: rho(nGrid) - double precision,intent(in) :: drho(3,nGrid) - integer,intent(in) :: Cx_choice - logical,intent(in) :: doNcentered - -! Local variables - - integer :: mu,nu,iG - double precision :: b - double precision :: vAO,gAO - double precision :: r,g,x,dxdr,dxdg,f - double precision :: a1,b1,c1,d1,w1 - double precision :: a2,b2,c2,d2,w2 - double precision :: Fx1,Fx2,Cx - -! Output variables - - double precision,intent(out) :: Fx(nBas,nBas) - -! Coefficients for B88 GGA exchange functional - - b = 0.0042d0 - -! Defining enhancements factor for weight-dependent functionals - -! Parameters for first state - - a1 = aCC(1,1) - b1 = aCC(2,1) - c1 = aCC(3,1) - d1 = aCC(4,1) - -! Parameters for second state - - a2 = aCC(1,2) - b2 = aCC(2,2) - c2 = aCC(3,2) - d2 = aCC(4,2) - - w1 = wEns(2) - Fx1 = 1d0 + a1*w1 + b1*w1**2 + c1*w1**3 + d1*w1**4 - - w2 = wEns(3) - Fx2 = 1d0 + a2*w2 + b2*w2**2 + c2*w2**3 + d2*w2**4 - - select case (Cx_choice) - - case(1) - Cx = Fx1 - - case(2) - Cx = Fx2 - - case(3) - Cx = Fx2*Fx1 - - case default - Cx = 1.d0 - - end select - - -! Compute GGA exchange matrix in the AO basis - - Fx(:,:) = 0d0 - - do mu=1,nBas - do nu=1,nBas - do iG=1,nGrid - - r = max(0d0,rho(iG)) - - if(r > threshold) then - - vAO = weight(iG)*AO(mu,iG)*AO(nu,iG) - - g = drho(1,iG)**2 + drho(2,iG)**2 + drho(3,iG)**2 - x = sqrt(g)/r**(4d0/3d0) - dxdr = - 4d0*sqrt(g)/(3d0*r**(7d0/3d0))/x - dxdg = + 1d0/(2d0*sqrt(g)*r**(4d0/3d0))/x - - f = b*x**2/(1d0 + 6d0*b*x*asinh(x)) - - Fx(mu,nu) = Fx(mu,nu) + vAO*( & - 4d0/3d0*r**(1d0/3d0)*(CxLSDA - f) & - - 2d0*r**(4d0/3d0)*dxdr*f & - + r**(4d0/3d0)*dxdr*(6d0*b*x*asinh(x) + 6d0*b*x**2/sqrt(1d0+x**2))*f/(1d0 + 6d0*b*x*asinh(x)) ) - - gAO = drho(1,iG)*(dAO(1,mu,iG)*AO(nu,iG) + AO(mu,iG)*dAO(1,nu,iG)) & - + drho(2,iG)*(dAO(2,mu,iG)*AO(nu,iG) + AO(mu,iG)*dAO(2,nu,iG)) & - + drho(3,iG)*(dAO(3,mu,iG)*AO(nu,iG) + AO(mu,iG)*dAO(3,nu,iG)) - gAO = weight(iG)*gAO - - Fx(mu,nu) = Fx(mu,nu) + 2d0*gAO*r**(4d0/3d0)*dxdg*( & - - 2d0*f + (6d0*b*x*asinh(x) + 6d0*b*x**2/sqrt(1d0+x**2))*f/(1d0 + 6d0*b*x*asinh(x)) ) - - end if - - end do - end do - end do - - Fx(:,:) = Cx*Fx(:,:) - -end subroutine CC_B88_gga_exchange_potential - diff --git a/src/eDFT/CC_lda_exchange_derivative_discontinuity.f90 b/src/eDFT/CC_lda_exchange_derivative_discontinuity.f90 deleted file mode 100644 index e7998d2..0000000 --- a/src/eDFT/CC_lda_exchange_derivative_discontinuity.f90 +++ /dev/null @@ -1,170 +0,0 @@ -subroutine CC_lda_exchange_derivative_discontinuity(nEns,wEns,nCC,aCC,nGrid,weight,rhow,Cx_choice,& - doNcentered,kappa,ExDD) - - -! Compute the unrestricted version of the curvature-corrected exchange ensemble derivative - - implicit none - include 'parameters.h' - -! Input variables - - integer,intent(in) :: nEns - double precision,intent(in) :: wEns(nEns) - integer,intent(in) :: nCC - double precision,intent(in) :: aCC(nCC,nEns-1) - integer,intent(in) :: nGrid - double precision,intent(in) :: weight(nGrid) - double precision,intent(in) :: rhow(nGrid) - integer,intent(in) :: Cx_choice - logical,intent(in) :: doNcentered - double precision,intent(in) :: kappa(nEns) - -! Local variables - - integer :: iEns,jEns - integer :: iG - double precision :: r - double precision,allocatable :: dExdw(:) - double precision,external :: Kronecker_delta - - double precision :: a1,b1,c1,d1,w1 - double precision :: a2,b2,c2,d2,w2 - double precision :: dCxdw1,dCxdw2 - -! Output variables - - double precision,intent(out) :: ExDD(nEns) - -! External variable - - double precision,external :: electron_number - - -! Memory allocation - - allocate(dExdw(nEns)) - - -! Defining enhancements factor for weight-dependent functionals - - if (doNcentered) then - -! Parameters for first state - - a1 = aCC(1,1) - b1 = aCC(2,1) - c1 = aCC(3,1) - d1 = aCC(4,1) - -! Parameters for second state - - a2 = aCC(1,2) - b2 = aCC(2,2) - c2 = aCC(3,2) - d2 = aCC(4,2) - - w1 = wEns(2) - w2 = wEns(3) - - select case (Cx_choice) - - case(1) - dCxdw1 = a1 + 2.d0*b1*w1 + 3.d0*c1*w1**2 + 4.d0*d1*w1**3 - dCxdw2 = 0.d0 - - case(2) - dCxdw1 = 0.d0 - dCxdw2 = a2 + 2.d0*b2*w2 + 3.d0*c2*w2**2 + 4.d0*d2*w2**3 - - case(3) - dCxdw1 = (a1 + 2.d0*b1*w1 + 3.d0*c1*w1**2 + 4.d0*d1*w1**3) & - * (1d0 + a2*w2 + b2*w2**2 + c2*w2**3 + d2*w2**4) - - dCxdw2 = (1d0 + a1*w1 + b1*w1**2 + c1*w1**3 + d1*w1**4) & - * (a2 + 2.d0*b2*w2 + 3.d0*c2*w2**2 + 4.d0*d2*w2**3) - - case default - dCxdw1 = 0d0 - dCxdw2 = 0d0 - - end select - - else - -! Parameters for first state - - a1 = aCC(1,1) - b1 = aCC(2,1) - c1 = aCC(3,1) - -! Parameters for second state - - a2 = aCC(1,2) - b2 = aCC(2,2) - c2 = aCC(3,2) - - w1 = wEns(2) - w2 = wEns(3) - - select case (Cx_choice) - - case(1) - dCxdw1 = (0.5d0*b1 + (2d0*a1 + 0.5d0*c1)*(w1 - 0.5d0) - (1d0 - w1)*w1*(3d0*b1 + 4d0*c1*(w1 - 0.5d0))) - dCxdw2 = 0.d0 - - case(2) - dCxdw1 = 0.d0 - dCxdw2 =(0.5d0*b2 + (2d0*a2 + 0.5d0*c2)*(w2 - 0.5d0) - (1d0 - w2)*w2*(3d0*b2 + 4d0*c2*(w2 - 0.5d0))) - - case(3) - dCxdw1 = (0.5d0*b1 + (2d0*a1 + 0.5d0*c1)*(w1 - 0.5d0) - (1d0 - w1)*w1*(3d0*b1 + 4d0*c1*(w1 - 0.5d0))) & - * (1d0 - w2*(1d0 - w2)*(a2 + b2*(w2 - 0.5d0) + c2*(w2 - 0.5d0)**2)) - - dCxdw2 = (1d0 - w1*(1d0 - w1)*(a1 + b1*(w1 - 0.5d0) + c1*(w1 - 0.5d0)**2)) & - * (0.5d0*b2 + (2d0*a2 + 0.5d0*c2)*(w2 - 0.5d0) - (1d0 - w2)*w2*(3d0*b2 + 4d0*c2*(w2 - 0.5d0))) - - case default - dCxdw1 = 0d0 - dCxdw2 = 0d0 - - end select - end if - - - dCxdw1 = CxLSDA*dCxdw1 - dCxdw2 = CxLSDA*dCxdw2 - - dExdw(:) = 0d0 - - do iG=1,nGrid - - r = max(0d0,rhow(iG)) - - if(r > threshold) then - - dExdw(1) = 0d0 - dExdw(2) = dExdw(2) + weight(iG)*dCxdw1*r**(4d0/3d0) - dExdw(3) = dExdw(3) + weight(iG)*dCxdw2*r**(4d0/3d0) - - end if - - end do - - ExDD(:) = 0d0 - - do iEns=1,nEns - do jEns=2,nEns - - if(doNcentered) then - - ExDD(iEns) = ExDD(iEns) + (Kronecker_delta(iEns,jEns) - kappa(iEns)*wEns(jEns))*dExdw(jEns) - else - - ExDD(iEns) = ExDD(iEns) + (Kronecker_delta(iEns,jEns) - wEns(jEns))*dExdw(jEns) - end if - - end do - end do - -end subroutine CC_lda_exchange_derivative_discontinuity diff --git a/src/eDFT/CC_lda_exchange_energy.f90 b/src/eDFT/CC_lda_exchange_energy.f90 deleted file mode 100644 index d4a07d0..0000000 --- a/src/eDFT/CC_lda_exchange_energy.f90 +++ /dev/null @@ -1,110 +0,0 @@ -subroutine CC_lda_exchange_energy(nEns,wEns,nCC,aCC,nGrid,weight,rho,Cx_choice,doNcentered,Ex) - -! Compute the unrestricted version of the curvature-corrected exchange functional - - implicit none - include 'parameters.h' - -! Input variables - - integer,intent(in) :: nEns - double precision,intent(in) :: wEns(nEns) - integer,intent(in) :: nCC - double precision,intent(in) :: aCC(nCC,nEns-1) - integer,intent(in) :: nGrid - double precision,intent(in) :: weight(nGrid) - double precision,intent(in) :: rho(nGrid) - integer,intent(in) :: Cx_choice - logical,intent(in) :: doNcentered - -! Local variables - - integer :: iG - double precision :: r - - double precision :: a1,b1,c1,d1,w1 - double precision :: a2,b2,c2,d2,w2 - double precision :: Fx1,Fx2,Cx - -! Output variables - - double precision :: Ex - - -! Defining enhancements factor for weight-dependent functionals - - if(doNcentered) then - -! Parameters for first state - - a1 = aCC(1,1) - b1 = aCC(2,1) - c1 = aCC(3,1) - d1 = aCC(4,1) - -! Parameters for second state - - a2 = aCC(1,2) - b2 = aCC(2,2) - c2 = aCC(3,2) - d2 = aCC(4,2) - - - w1 = wEns(2) - Fx1 = 1d0 + a1*w1 + b1*w1**2 + c1*w1**3 + d1*w1**4 - - w2 = wEns(3) - Fx2 = 1d0 + a2*w2 + b2*w2**2 + c2*w2**3 + d2*w2**4 - - else - -! Parameters for first state - - a1 = aCC(1,1) - b1 = aCC(2,1) - c1 = aCC(3,1) - -! Parameters for second state - - a2 = aCC(1,2) - b2 = aCC(2,2) - c2 = aCC(3,2) - - - w1 = wEns(2) - Fx1 = 1d0 - w1*(1d0 - w1)*(a1 + b1*(w1 - 0.5d0) + c1*(w1 - 0.5d0)**2) - - w2 = wEns(3) - Fx2 = 1d0 - w2*(1d0 - w2)*(a2 + b2*(w2 - 0.5d0) + c2*(w2 - 0.5d0)**2) - - endif - - select case (Cx_choice) - - case(1) - Cx = CxLSDA*Fx1 - - case(2) - Cx = CxLSDA*Fx2 - - case(3) - Cx = CxLSDA*Fx2*Fx1 - - case default - Cx = CxLSDA - - end select - -! Compute GIC-LDA exchange energy - - Ex = 0d0 - - do iG=1,nGrid - - r = max(0d0,rho(iG)) - - if(r > threshold) Ex = Ex + weight(iG)*Cx*r**(1d0/3d0)*r - - enddo - -end subroutine CC_lda_exchange_energy diff --git a/src/eDFT/CC_lda_exchange_individual_energy.f90 b/src/eDFT/CC_lda_exchange_individual_energy.f90 deleted file mode 100644 index 29b0778..0000000 --- a/src/eDFT/CC_lda_exchange_individual_energy.f90 +++ /dev/null @@ -1,131 +0,0 @@ -subroutine CC_lda_exchange_individual_energy(nEns,wEns,nCC,aCC,nGrid,weight,rhow,rho,Cx_choice,doNcentered,LZx,Ex) - - -! Compute the unrestricted version of the curvature-corrected exchange functional - - implicit none - include 'parameters.h' - -! Input variables - - integer,intent(in) :: nEns - double precision,intent(in) :: wEns(nEns) - integer,intent(in) :: nCC - double precision,intent(in) :: aCC(nCC,nEns-1) - integer,intent(in) :: nGrid - double precision,intent(in) :: weight(nGrid) - double precision,intent(in) :: rhow(nGrid,nspin) - double precision,intent(in) :: rho(nGrid,nspin,nEns) - integer,intent(in) :: Cx_choice - logical,intent(in) :: doNcentered - -! Local variables - - integer :: iG,iEns,ispin - double precision :: r,rI - double precision :: e,dedr - - double precision :: a1,b1,c1,d1,w1 - double precision :: a2,b2,c2,d2,w2 - double precision :: Fx1,Fx2,Cx - -! Output variables - - double precision,intent(out) :: LZx(nspin) - double precision,intent(out) :: Ex(nspin,nEns) - -! Defining enhancements factor for weight-dependent functionals - - if(doNcentered) then - -! Parameters for first state - - a1 = aCC(1,1) - b1 = aCC(2,1) - c1 = aCC(3,1) - d1 = aCC(4,1) - -! Parameters for second state - - a2 = aCC(1,2) - b2 = aCC(2,2) - c2 = aCC(3,2) - d2 = aCC(4,2) - - w1 = wEns(2) - Fx1 = 1d0 + a1*w1 + b1*w1**2 + c1*w1**3 + d1*w1**4 - - w2 = wEns(3) - Fx2 = 1d0 + a2*w2 + b2*w2**2 + c2*w2**3 + d2*w2**4 - - else - -! Parameters for first state - - a1 = aCC(1,1) - b1 = aCC(2,1) - c1 = aCC(3,1) - -! Parameters for second state - - a2 = aCC(1,2) - b2 = aCC(2,2) - c2 = aCC(3,2) - - w1 = wEns(2) - Fx1 = 1d0 - w1*(1d0 - w1)*(a1 + b1*(w1 - 0.5d0) + c1*(w1 - 0.5d0)**2) - - w2 = wEns(3) - Fx2 = 1d0 - w2*(1d0 - w2)*(a2 + b2*(w2 - 0.5d0) + c2*(w2 - 0.5d0)**2) - - endif - - select case (Cx_choice) - - case(1) - Cx = CxLSDA*Fx1 - - case(2) - Cx = CxLSDA*Fx2 - - case(3) - Cx = CxLSDA*Fx2*Fx1 - - case default - Cx = CxLSDA - - end select - -! Compute LDA exchange matrix in the AO basis - - Ex(:,:) = 0d0 - LZx(:) = 0d0 - - do ispin=1,nspin - - do iG=1,nGrid - - r = max(0d0,rhow(iG,ispin)) - - if(r > threshold) then - - e = Cx*r**(+1d0/3d0) - dedr = 1d0/3d0*Cx*r**(-2d0/3d0) - - LZx(ispin) = LZx(ispin) - weight(iG)*dedr*r*r - - do iEns=1,nEns - - rI = max(0d0,rho(iG,ispin,iEns)) - - if(rI > threshold) Ex(ispin,iEns) = Ex(ispin,iEns) + weight(iG)*(e+dedr*r)*rI - - end do - - endif - - enddo - - enddo - -end subroutine CC_lda_exchange_individual_energy diff --git a/src/eDFT/CC_lda_exchange_potential.f90 b/src/eDFT/CC_lda_exchange_potential.f90 deleted file mode 100644 index 7cc753e..0000000 --- a/src/eDFT/CC_lda_exchange_potential.f90 +++ /dev/null @@ -1,119 +0,0 @@ -subroutine CC_lda_exchange_potential(nEns,wEns,nCC,aCC,nGrid,weight,nBas,AO,rho,Cx_choice,doNcentered,Fx) - -! Compute the unrestricted version of the curvature-corrected exchange potential - - implicit none - include 'parameters.h' - -! Input variables - - integer,intent(in) :: nEns - double precision,intent(in) :: wEns(nEns) - integer,intent(in) :: nCC - double precision,intent(in) :: aCC(nCC,nEns-1) - integer,intent(in) :: nGrid - double precision,intent(in) :: weight(nGrid) - integer,intent(in) :: nBas - double precision,intent(in) :: AO(nBas,nGrid) - double precision,intent(in) :: rho(nGrid) - integer,intent(in) :: Cx_choice - logical,intent(in) :: doNcentered - -! Local variables - - integer :: mu,nu,iG - double precision :: r,vAO - - double precision :: a1,b1,c1,d1,w1 - double precision :: a2,b2,c2,d2,w2 - double precision :: Fx1,Fx2,Cx - -! Output variables - - double precision,intent(out) :: Fx(nBas,nBas) - - -! Defining enhancements factor for weight-dependent functionals - - if(doNcentered) then - -! Parameters for first state - - a1 = aCC(1,1) - b1 = aCC(2,1) - c1 = aCC(3,1) - d1 = aCC(4,1) - -! Parameters for second state - - a2 = aCC(1,2) - b2 = aCC(2,2) - c2 = aCC(3,2) - d2 = aCC(4,2) - - w1 = wEns(2) - Fx1 = 1d0 + a1*w1 + b1*w1**2 + c1*w1**3 + d1*w1**4 - - w2 = wEns(3) - Fx2 = 1d0 + a2*w2 + b2*w2**2 + c2*w2**3 + d2*w2**4 - - else - -! Parameters for first state - - a1 = aCC(1,1) - b1 = aCC(2,1) - c1 = aCC(3,1) - -! Parameters for second state - - a2 = aCC(1,2) - b2 = aCC(2,2) - c2 = aCC(3,2) - - w1 = wEns(2) - Fx1 = 1d0 - w1*(1d0 - w1)*(a1 + b1*(w1 - 0.5d0) + c1*(w1 - 0.5d0)**2) - - w2 = wEns(3) - Fx2 = 1d0 - w2*(1d0 - w2)*(a2 + b2*(w2 - 0.5d0) + c2*(w2 - 0.5d0)**2) - - endif - - select case (Cx_choice) - - case(1) - Cx = CxLSDA*Fx1 - - case(2) - Cx = CxLSDA*Fx2 - - case(3) - Cx = CxLSDA*Fx2*Fx1 - - case default - Cx = CxLSDA - - end select - -! Compute LDA exchange matrix in the AO basis - - Fx(:,:) = 0d0 - - do mu=1,nBas - do nu=1,nBas - do iG=1,nGrid - - r = max(0d0,rho(iG)) - - if(r > threshold) then - - vAO = weight(iG)*AO(mu,iG)*AO(nu,iG) - Fx(mu,nu) = Fx(mu,nu) + vAO*4d0/3d0*Cx*r**(1d0/3d0) - - endif - - enddo - enddo - enddo - -end subroutine CC_lda_exchange_potential diff --git a/src/eDFT/G96_gga_exchange_energy.f90 b/src/eDFT/G96_gga_exchange_energy.f90 deleted file mode 100644 index 93c3ece..0000000 --- a/src/eDFT/G96_gga_exchange_energy.f90 +++ /dev/null @@ -1,48 +0,0 @@ -subroutine G96_gga_exchange_energy(nGrid,weight,rho,drho,Ex) - -! Compute Gill's 96 GGA exchange energy - - implicit none - - include 'parameters.h' - -! Input variables - - integer,intent(in) :: nGrid - double precision,intent(in) :: weight(nGrid) - double precision,intent(in) :: rho(nGrid) - double precision,intent(in) :: drho(ncart,nGrid) - -! Local variables - - integer :: iG - double precision :: beta - double precision :: r,g - -! Output variables - - double precision :: Ex - -! Coefficients for G96 GGA exchange functional - - beta = 1d0/137d0 - -! Compute GGA exchange energy - - Ex = 0d0 - - do iG=1,nGrid - - r = max(0d0,rho(iG)) - - if(r > threshold) then - - g = drho(1,iG)**2 + drho(2,iG)**2 + drho(3,iG)**2 - - Ex = Ex + weight(iG)*r**(4d0/3d0)*(CxLSDA - beta*g**(3d0/4d0)/r**2) - - end if - - end do - -end subroutine G96_gga_exchange_energy diff --git a/src/eDFT/G96_gga_exchange_potential.f90 b/src/eDFT/G96_gga_exchange_potential.f90 deleted file mode 100644 index 029354c..0000000 --- a/src/eDFT/G96_gga_exchange_potential.f90 +++ /dev/null @@ -1,64 +0,0 @@ -subroutine G96_gga_exchange_potential(nGrid,weight,nBas,AO,dAO,rho,drho,Fx) - -! Compute Gill's GGA exchange poential - - implicit none - include 'parameters.h' - -! Input variables - - integer,intent(in) :: nGrid - double precision,intent(in) :: weight(nGrid) - integer,intent(in) :: nBas - double precision,intent(in) :: AO(nBas,nGrid) - double precision,intent(in) :: dAO(3,nBas,nGrid) - double precision,intent(in) :: rho(nGrid) - double precision,intent(in) :: drho(3,nGrid) - -! Local variables - - integer :: mu,nu,iG - double precision :: beta - double precision :: r,g,vAO,gAO - -! Output variables - - double precision,intent(out) :: Fx(nBas,nBas) - -! Coefficients for G96 GGA exchange functional - - beta = +1d0/137d0 - -! Compute GGA exchange matrix in the AO basis - - Fx(:,:) = 0d0 - - do mu=1,nBas - do nu=1,nBas - do iG=1,nGrid - - r = max(0d0,rho(iG)) - g = drho(1,iG)**2 + drho(2,iG)**2 + drho(3,iG)**2 - - if(r > threshold) then - - vAO = weight(iG)*AO(mu,iG)*AO(nu,iG) - Fx(mu,nu) = Fx(mu,nu) & - + vAO*(4d0/3d0*r**(1d0/3d0)*(CxLSDA - beta*g**(3d0/4d0)/r**2) & - + 2d0*beta*g**(3d0/4d0)/r**(5d0/3d0)) - - gAO = drho(1,iG)*(dAO(1,mu,iG)*AO(nu,iG) + AO(mu,iG)*dAO(1,nu,iG)) & - + drho(2,iG)*(dAO(2,mu,iG)*AO(nu,iG) + AO(mu,iG)*dAO(2,nu,iG)) & - + drho(3,iG)*(dAO(3,mu,iG)*AO(nu,iG) + AO(mu,iG)*dAO(3,nu,iG)) - - gAO = weight(iG)*gAO - - Fx(mu,nu) = Fx(mu,nu) - 2d0*gAO*3d0/4d0*beta*g**(-1d0/4d0)/r**(2d0/3d0) - - endif - - enddo - enddo - enddo - -end subroutine G96_gga_exchange_potential diff --git a/src/eDFT/LYP_gga_correlation_energy.f90 b/src/eDFT/LYP_gga_correlation_energy.f90 deleted file mode 100644 index a86295a..0000000 --- a/src/eDFT/LYP_gga_correlation_energy.f90 +++ /dev/null @@ -1,73 +0,0 @@ -subroutine LYP_gga_correlation_energy(nGrid,weight,rho,drho,Ec) - -! Compute unrestricted LYP GGA correlation energy - - implicit none - - include 'parameters.h' - -! Input variables - - integer,intent(in) :: nGrid - double precision,intent(in) :: weight(nGrid) - double precision,intent(in) :: rho(nGrid,nspin) - double precision,intent(in) :: drho(ncart,nGrid,nspin) - -! Local variables - - integer :: iG - double precision :: ra,rb,r - double precision :: ga,gab,gb,g - - double precision :: a,b,c,d - double precision :: Cf,omega,delta - -! Output variables - - double precision :: Ec(nsp) - -! Parameters of the functional - - a = 0.04918d0 - b = 0.132d0 - c = 0.2533d0 - d = 0.349d0 - - Cf = 3d0/10d0*(3d0*pi**2)**(2d0/3d0) - -! Initialization - - Ec(:) = 0d0 - - do iG=1,nGrid - - ra = max(0d0,rho(iG,1)) - rb = max(0d0,rho(iG,2)) - r = ra + rb - - if(r > threshold) then - - ga = drho(1,iG,1)*drho(1,iG,1) + drho(2,iG,1)*drho(2,iG,1) + drho(3,iG,1)*drho(3,iG,1) - gb = drho(1,iG,2)*drho(1,iG,2) + drho(2,iG,2)*drho(2,iG,2) + drho(3,iG,2)*drho(3,iG,2) - gab = drho(1,iG,1)*drho(1,iG,2) + drho(2,iG,1)*drho(2,iG,2) + drho(3,iG,1)*drho(3,iG,2) - g = ga + 2d0*gab + gb - - omega = exp(-c*r**(-1d0/3d0))/(1d0 + d*r**(-1d0/3d0))*r**(-11d0/3d0) - delta = c*r**(-1d0/3d0) + d*r**(-1d0/3d0)/(1d0 + d*r**(-1d0/3d0)) - - Ec(2) = Ec(2) - weight(iG)*4d0*a/(1d0 + d*r**(-1d0/3d0))*ra*rb/r & - - weight(iG)*a*b*omega*ra*rb*( & - 2d0**(11d0/3d0)*Cf*(ra**(8d0/3d0) + rb**(8d0/3d0)) & - + (47d0/18d0 - 7d0*delta/18d0)*g & - - (5d0/2d0 - delta/18d0)*(ga + gb) & - - (delta - 11d0)/9d0*(ra/r*ga + rb/r*gb) ) & - - weight(iG)*a*b*omega*( & - - 2d0*r**2/3d0*g & - + (2d0*r**2/3d0 - ra**2)*gb & - + (2d0*r**2/3d0 - rb**2)*ga ) - - end if - - end do - -end subroutine LYP_gga_correlation_energy diff --git a/src/eDFT/LYP_gga_correlation_potential.f90 b/src/eDFT/LYP_gga_correlation_potential.f90 deleted file mode 100644 index d30507d..0000000 --- a/src/eDFT/LYP_gga_correlation_potential.f90 +++ /dev/null @@ -1,156 +0,0 @@ -subroutine LYP_gga_correlation_potential(nGrid,weight,nBas,AO,dAO,rho,drho,Fc) - -! Compute LYP correlation potential - - implicit none - include 'parameters.h' - -! Input variables - - integer,intent(in) :: nGrid - double precision,intent(in) :: weight(nGrid) - integer,intent(in) :: nBas - double precision,intent(in) :: AO(nBas,nGrid) - double precision,intent(in) :: dAO(ncart,nBas,nGrid) - double precision,intent(in) :: rho(nGrid,nspin) - double precision,intent(in) :: drho(ncart,nGrid,nspin) - -! Local variables - - integer :: mu,nu,iG - double precision :: vAO,gaAO,gbAO - double precision :: ra,rb,r - double precision :: ga,gab,gb,g - double precision :: dfdra,dfdrb - double precision :: dfdga,dfdgab,dfdgb - double precision :: dodra,dodrb,dddra,dddrb - - double precision :: a,b,c,d - double precision :: Cf,omega,delta - -! Output variables - - double precision,intent(out) :: Fc(nBas,nBas,nspin) - -! Prameter of the functional - - a = 0.04918d0 - b = 0.132d0 - c = 0.2533d0 - d = 0.349d0 - - Cf = 3d0/10d0*(3d0*pi**2)**(2d0/3d0) - -! Compute matrix elements in the AO basis - - Fc(:,:,:) = 0d0 - - do mu=1,nBas - do nu=1,nBas - do iG=1,nGrid - - ra = max(0d0,rho(iG,1)) - rb = max(0d0,rho(iG,2)) - r = ra + rb - - if(r > threshold) then - - ga = drho(1,iG,1)*drho(1,iG,1) + drho(2,iG,1)*drho(2,iG,1) + drho(3,iG,1)*drho(3,iG,1) - gb = drho(1,iG,2)*drho(1,iG,2) + drho(2,iG,2)*drho(2,iG,2) + drho(3,iG,2)*drho(3,iG,2) - gab = drho(1,iG,1)*drho(1,iG,2) + drho(2,iG,1)*drho(2,iG,2) + drho(3,iG,1)*drho(3,iG,2) - g = ga + 2d0*gab + gb - - omega = exp(-c*r**(-1d0/3d0))/(1d0 + d*r**(-1d0/3d0))*r**(-11d0/3d0) - delta = c*r**(-1d0/3d0) + d*r**(-1d0/3d0)/(1d0 + d*r**(-1d0/3d0)) - - vAO = weight(iG)*AO(mu,iG)*AO(nu,iG) - - dodra = (d/(3d0*r**(4d0/3d0)*(1d0 + d*r**(-1d0/3d0))) + c/(3d0*r**(4d0/3d0)) - 11d0/(3d0*r))*omega - dodrb = dodra - - dddra = - c/3d0*r**(-4d0/3d0) & - + d**2/(3d0*(1d0 + d*r**(-1d0/3d0))**2)*r**(-5d0/3d0) & - - d/(3d0*(1d0 + d*r**(-1d0/3d0)))*r**(-4d0/3d0) - dddrb = dddra - - dfdra = - 4d0*a/(1d0 + d*r**(-1d0/3d0))*rb/r & - - 4d0/3d0*a*d/(1d0 + d*r**(-1d0/3d0))**2*ra*rb/r**(7d0/3d0) & - + 4d0*a/(1d0 + d*r**(-1d0/3d0))*ra*rb/r**2 & - - a*b*omega*rb*( & - + 2d0**(11d0/3d0)*Cf*(ra**(8d0/3d0) + rb**(8d0/3d0)) & - + (47d0/18d0 - 7d0*delta/18d0)*g & - - (5d0/2d0 - delta/18d0)*(ga + gb) & - - (delta - 11d0)/9d0*(ra/r*ga + rb/r*gb) & - - 4d0/3d0*r/rb*g & - + (4d0/3d0*r/rb - 2d0*ra/rb)*gb & - + 4d0/3d0*r/rb*ga ) & - - a*b*omega*ra*rb*( & - + 8d0/3d0*2d0**(11d0/3d0)*Cf*ra**(5d0/3d0) & - - 7d0*dddra/18d0*g & - + dddra/18d0*(ga + gb) & - - dddra/9d0*(ra/r*ga + rb/r*gb) & - - (delta - 11d0)/(9d0*r)*(-ra/r*ga - rb/r*gb + ga) ) & - - a*b*dodra*ra*rb*( & - + 2d0**(11d0/3d0)*Cf*(ra**(8d0/3d0) + rb**(8d0/3d0)) & - + (47d0/18d0 - 7d0*delta/18d0)*g & - - (5d0/2d0 - delta/18d0)*(ga + gb) & - - (delta - 11d0)/9d0*(ra/r*ga + rb/r*gb) ) & - - a*b*dodra*( & - - 2d0*r**2/3d0*g & - + (2d0*r**2/3d0 - ra**2)*gb & - + (2d0*r**2/3d0 - rb**2)*ga ) - - dfdrb = - 4d0*a/(1d0 + d*r**(-1d0/3d0))*ra/r & - - 4d0/3d0*a*d/(1d0 + d*r**(-1d0/3d0))**2*ra*rb/r**(7d0/3d0) & - + 4d0*a/(1d0 + d*r**(-1d0/3d0))*ra*rb/r**2 & - - a*b*omega*ra*( & - + 2d0**(11d0/3d0)*Cf*(ra**(8d0/3d0) + rb**(8d0/3d0)) & - + (47d0/18d0 - 7d0*delta/18d0)*g & - - (5d0/2d0 - delta/18d0)*(ga + gb) & - - (delta - 11d0)/9d0*(ra/r*ga + rb/r*gb) & - - 4d0/3d0*r/ra*g & - + (4d0/3d0*r/ra - 2d0*rb/ra)*ga & - + 4d0/3d0*r/ra*gb ) & - - a*b*omega*ra*rb*( & - + 8d0/3d0*2d0**(11d0/3d0)*Cf*rb**(5d0/3d0) & - - 7d0*dddrb/18d0*g & - + dddrb/18d0*(ga + gb) & - - dddrb/9d0*(ra/r*ga + rb/r*gb) & - - (delta - 11d0)/(9d0*r)*(-ra/r*ga - rb/r*gb + gb) ) & - - a*b*dodrb*ra*rb*( & - + 2d0**(11d0/3d0)*Cf*(ra**(8d0/3d0) + rb**(8d0/3d0)) & - + (47d0/18d0 - 7d0*delta/18d0)*g & - - (5d0/2d0 - delta/18d0)*(ga + gb) & - - (delta - 11d0)/9d0*(ra/r*ga + rb/r*gb) ) & - - a*b*dodrb*( & - - 2d0*r**2/3d0*g & - + (2d0*r**2/3d0 - ra**2)*gb & - + (2d0*r**2/3d0 - rb**2)*ga ) - - Fc(mu,nu,1) = Fc(mu,nu,1) + vAO*dfdra - Fc(mu,nu,2) = Fc(mu,nu,2) + vAO*dfdrb - - gaAO = drho(1,iG,1)*(dAO(1,mu,iG)*AO(nu,iG) + AO(mu,iG)*dAO(1,nu,iG)) & - + drho(2,iG,1)*(dAO(2,mu,iG)*AO(nu,iG) + AO(mu,iG)*dAO(2,nu,iG)) & - + drho(3,iG,1)*(dAO(3,mu,iG)*AO(nu,iG) + AO(mu,iG)*dAO(3,nu,iG)) - gaAO = weight(iG)*gaAO - - gbAO = drho(1,iG,2)*(dAO(1,mu,iG)*AO(nu,iG) + AO(mu,iG)*dAO(1,nu,iG)) & - + drho(2,iG,2)*(dAO(2,mu,iG)*AO(nu,iG) + AO(mu,iG)*dAO(2,nu,iG)) & - + drho(3,iG,2)*(dAO(3,mu,iG)*AO(nu,iG) + AO(mu,iG)*dAO(3,nu,iG)) - gbAO = weight(iG)*gbAO - - dfdga = -a*b*omega*(-rb**2 + ra*rb*(1d0/9d0 - (delta-11d0)/9d0*ra/r - delta/3d0)) - dfdgab = -a*b*omega*(-4d0/3d0*r**2 + 2d0*ra*rb*(47d0/18d0 - 7d0*delta/18d0)) - dfdgb = -a*b*omega*(-ra**2 + ra*rb*(1d0/9d0 - (delta-11d0)/9d0*rb/r - delta/3d0)) - - Fc(mu,nu,1) = Fc(mu,nu,1) + 2d0*gaAO*dfdga + gbAO*dfdgab - Fc(mu,nu,2) = Fc(mu,nu,2) + 2d0*gbAO*dfdgb + gaAO*dfdgab - - end if - - end do - end do - end do - -end subroutine LYP_gga_correlation_potential diff --git a/src/eDFT/PBE_gga_correlation_energy.f90 b/src/eDFT/PBE_gga_correlation_energy.f90 deleted file mode 100644 index c93d812..0000000 --- a/src/eDFT/PBE_gga_correlation_energy.f90 +++ /dev/null @@ -1,172 +0,0 @@ -subroutine PBE_gga_correlation_energy(nGrid,weight,rho,drho,Ec) - -! Compute unrestricted PBE GGA correlation energy - - implicit none - - include 'parameters.h' - -! Input variables - - integer,intent(in) :: nGrid - double precision,intent(in) :: weight(nGrid) - double precision,intent(in) :: rho(nGrid,nspin) - double precision,intent(in) :: drho(ncart,nGrid,nspin) - -! Local variables - - integer :: iG - double precision :: ra,rb,r,rs,z - double precision :: ga,gab,gb,g - - double precision :: a,b,c,d - double precision :: gam,beta - - double precision :: A_p,a1_p,b1_p,b2_p,b3_p,b4_p - double precision :: A_f,a1_f,b1_f,b2_f,b3_f,b4_f - double precision :: A_a,a1_a,b1_a,b2_a,b3_a,b4_a - - double precision :: ec_z,ec_p,ec_f,ec_a - double precision :: fz,d2fz - - double precision :: H,kf,ks,t,phi - -! Output variables - - double precision :: Ec(nsp) - -! Parameters for PW92 - - A_p = 0.031091d0 - a1_p = 0.21370d0 - b1_p = 7.5957d0 - b2_p = 3.5876d0 - b3_p = 1.6382d0 - b4_p = 0.49294d0 - - A_f = 0.015545d0 - a1_f = 0.20548d0 - b1_f = 14.1189d0 - b2_f = 6.1977d0 - b3_f = 3.3662d0 - b4_f = 0.62517d0 - - A_a = 0.016887d0 - a1_a = 0.11125d0 - b1_a = 10.357d0 - b2_a = 3.6231d0 - b3_a = 0.88026d0 - b4_a = 0.49671d0 - -! Parameters PBE - - gam = (1d0 - log(2d0))/pi**2 - beta = 0.066725d0 - -! Initialization - - Ec(:) = 0d0 - - do iG=1,nGrid - - ra = max(0d0,rho(iG,1)) - rb = max(0d0,rho(iG,2)) - r = ra + rb - z = (ra - rb)/r - -! alpha-alpha contribution - - if(ra > threshold) then - - rs = (4d0*pi*ra/3d0)**(-1d0/3d0) - - ec_f = b1_f*sqrt(rs) + b2_f*rs + b3_f*rs**(3d0/2d0) + b4_f*rs**2 - ec_f = -2d0*A_f*(1d0 + a1_f*rs)*log(1d0 + 1d0/(2d0*A_f*ec_f)) - - ga = drho(1,iG,1)*drho(1,iG,1) + drho(2,iG,1)*drho(2,iG,1) + drho(3,iG,1)*drho(3,iG,1) - - kf = (3d0*pi**2*ra)**(1d0/3d0) - ks = sqrt(4d0*kf/pi) - phi = 1d0 - t = sqrt(ga)/(2d0*phi*ks*ra) - - A = beta/gam/(exp(-ec_f/(gam*phi**3)) - 1d0) - - H = gam*phi**3*log(1d0 + beta/gam*t**2*((1d0 + A*t**2)/(1d0 + A*t**2 + A**2*t**4))) - - Ec(1) = Ec(1) + weight(iG)*(ec_f + H)*ra - - end if - - r = ra + rb - -! alpha-beta contribution - - if(r > threshold) then - - rs = (4d0*pi*r/3d0)**(-1d0/3d0) - - fz = (1d0 + z)**(4d0/3d0) + (1d0 - z)**(4d0/3d0) - 2d0 - fz = fz/(2d0*(2d0**(1d0/3d0) - 1d0)) - d2fz = 4d0/(9d0*(2**(1d0/3d0) - 1d0)) - - ec_p = b1_p*sqrt(rs) + b2_p*rs + b3_p*rs**(3d0/2d0) + b4_p*rs**2 - ec_p = -2d0*A_p*(1d0 + a1_p*rs)*log(1d0 + 1d0/(2d0*A_p*ec_p)) - - ec_f = b1_f*sqrt(rs) + b2_f*rs + b3_f*rs**(3d0/2d0) + b4_f*rs**2 - ec_f = -2d0*A_f*(1d0 + a1_f*rs)*log(1d0 + 1d0/(2d0*A_f*ec_f)) - - ec_a = b1_a*sqrt(rs) + b2_a*rs + b3_a*rs**(3d0/2d0) + b4_a*rs**2 - ec_a = +2d0*A_a*(1d0 + a1_a*rs)*log(1d0 + 1d0/(2d0*A_a*ec_a)) - - ec_z = ec_p + ec_a*fz/d2fz*(1d0-z**4) + (ec_f - ec_p)*fz*z**4 - - ga = drho(1,iG,1)*drho(1,iG,1) + drho(2,iG,1)*drho(2,iG,1) + drho(3,iG,1)*drho(3,iG,1) - gb = drho(1,iG,2)*drho(1,iG,2) + drho(2,iG,2)*drho(2,iG,2) + drho(3,iG,2)*drho(3,iG,2) - gab = drho(1,iG,1)*drho(1,iG,2) + drho(2,iG,1)*drho(2,iG,2) + drho(3,iG,1)*drho(3,iG,2) - g = ga + 2d0*gab + gb - - rs = (4d0*pi*r/3d0)**(-1d0/3d0) - kf = (3d0*pi**2*r)**(1d0/3d0) - ks = sqrt(4d0*kf/pi) - phi = ((1d0 + z)**(2d0/3d0) + (1d0 - z)**(2d0/3d0))/2d0 - t = sqrt(g)/(2d0*phi*ks*r) - - A = beta/gam/(exp(-ec_p/(gam*phi**3)) - 1d0) - - H = gam*phi**3*log(1d0 + beta/gam*t**2*((1d0 + A*t**2)/(1d0 + A*t**2 + A**2*t**4))) - - Ec(2) = Ec(2) - weight(iG)*(ec_p + H)*r - - end if - -! beta-beta contribution - - if(rb > threshold) then - - rs = (4d0*pi*rb/3d0)**(-1d0/3d0) - - ec_f = b1_f*sqrt(rs) + b2_f*rs + b3_f*rs**(3d0/2d0) + b4_f*rs**2 - ec_f = -2d0*A_f*(1d0 + a1_f*rs)*log(1d0 + 1d0/(2d0*A_f*ec_f)) - - gb = drho(1,iG,2)*drho(1,iG,2) + drho(2,iG,2)*drho(2,iG,2) + drho(3,iG,2)*drho(3,iG,2) - - kf = (3d0*pi**2*rb)**(1d0/3d0) - ks = sqrt(4d0*kf/pi) - phi = 1d0 - t = sqrt(gb)/(2d0*phi*ks*rb) - - A = beta/gam/(exp(-ec_f/(gam*phi**3)) - 1d0) - - H = gam*phi**3*log(1d0 + beta/gam*t**2*((1d0 + A*t**2)/(1d0 + A*t**2 + A**2*t**4))) - - Ec(3) = Ec(3) + weight(iG)*(ec_f + H)*rb - - end if - - end do - - Ec(2) = Ec(2) - Ec(1) - Ec(3) - - -end subroutine PBE_gga_correlation_energy diff --git a/src/eDFT/PBE_gga_correlation_potential.f90 b/src/eDFT/PBE_gga_correlation_potential.f90 deleted file mode 100644 index 40e5f3d..0000000 --- a/src/eDFT/PBE_gga_correlation_potential.f90 +++ /dev/null @@ -1,88 +0,0 @@ -subroutine PBE_gga_correlation_potential(nGrid,weight,nBas,AO,dAO,rho,drho,Fc) - -! Compute LYP correlation potential - - implicit none - include 'parameters.h' - -! Input variables - - integer,intent(in) :: nGrid - double precision,intent(in) :: weight(nGrid) - integer,intent(in) :: nBas - double precision,intent(in) :: AO(nBas,nGrid) - double precision,intent(in) :: dAO(ncart,nBas,nGrid) - double precision,intent(in) :: rho(nGrid,nspin) - double precision,intent(in) :: drho(ncart,nGrid,nspin) - -! Local variables - - integer :: mu,nu,iG - double precision :: vAO,gaAO,gbAO - double precision :: ra,rb,r - double precision :: ga,gab,gb,g - double precision :: dfdra,dfdrb - double precision :: dfdga,dfdgab,dfdgb - double precision :: dodra,dodrb,dddra,dddrb - - double precision :: a,b,c,d - double precision :: Cf,omega,delta - -! Output variables - - double precision,intent(out) :: Fc(nBas,nBas,nspin) - -! Prameter of the functional - -! Compute matrix elements in the AO basis - - call PW92_lda_correlation_potential(nGrid,weight,nBas,AO,rho,Fc) - - do mu=1,nBas - do nu=1,nBas - do iG=1,nGrid - - ra = max(0d0,rho(iG,1)) - rb = max(0d0,rho(iG,2)) - r = ra + rb - - if(r > threshold) then - - ga = drho(1,iG,1)*drho(1,iG,1) + drho(2,iG,1)*drho(2,iG,1) + drho(3,iG,1)*drho(3,iG,1) - gb = drho(1,iG,2)*drho(1,iG,2) + drho(2,iG,2)*drho(2,iG,2) + drho(3,iG,2)*drho(3,iG,2) - gab = drho(1,iG,1)*drho(1,iG,2) + drho(2,iG,1)*drho(2,iG,2) + drho(3,iG,1)*drho(3,iG,2) - g = ga + 2d0*gab + gb - - vAO = weight(iG)*AO(mu,iG)*AO(nu,iG) - - dfdra = 0d0 - dfdrb = 0d0 - - Fc(mu,nu,1) = Fc(mu,nu,1) + vAO*dfdra - Fc(mu,nu,2) = Fc(mu,nu,2) + vAO*dfdrb - - gaAO = drho(1,iG,1)*(dAO(1,mu,iG)*AO(nu,iG) + AO(mu,iG)*dAO(1,nu,iG)) & - + drho(2,iG,1)*(dAO(2,mu,iG)*AO(nu,iG) + AO(mu,iG)*dAO(2,nu,iG)) & - + drho(3,iG,1)*(dAO(3,mu,iG)*AO(nu,iG) + AO(mu,iG)*dAO(3,nu,iG)) - gaAO = weight(iG)*gaAO - - gbAO = drho(1,iG,2)*(dAO(1,mu,iG)*AO(nu,iG) + AO(mu,iG)*dAO(1,nu,iG)) & - + drho(2,iG,2)*(dAO(2,mu,iG)*AO(nu,iG) + AO(mu,iG)*dAO(2,nu,iG)) & - + drho(3,iG,2)*(dAO(3,mu,iG)*AO(nu,iG) + AO(mu,iG)*dAO(3,nu,iG)) - gbAO = weight(iG)*gbAO - - dfdga = 0d0 - dfdgab = 0d0 - dfdgb = 0d0 - - - Fc(mu,nu,1) = Fc(mu,nu,1) + 2d0*gaAO*dfdga + gbAO*dfdgab - Fc(mu,nu,2) = Fc(mu,nu,2) + 2d0*gbAO*dfdgb + gaAO*dfdgab - - end if - - end do - end do - end do - -end subroutine PBE_gga_correlation_potential diff --git a/src/eDFT/PBE_gga_exchange_energy.f90 b/src/eDFT/PBE_gga_exchange_energy.f90 deleted file mode 100644 index 5c76336..0000000 --- a/src/eDFT/PBE_gga_exchange_energy.f90 +++ /dev/null @@ -1,49 +0,0 @@ -subroutine PBE_gga_exchange_energy(nGrid,weight,rho,drho,Ex) - -! Compute PBE GGA exchange energy - - implicit none - - include 'parameters.h' - -! Input variables - - integer,intent(in) :: nGrid - double precision,intent(in) :: weight(nGrid) - double precision,intent(in) :: rho(nGrid) - double precision,intent(in) :: drho(3,nGrid) - -! Local variables - - integer :: iG - double precision :: mupbe,kappa - double precision :: r,g,s2 - -! Output variables - - double precision :: Ex - -! Coefficients for PBE exchange functional - - mupbe = ((1d0/2d0**(1d0/3d0))/(2d0*(3d0*pi**2)**(1d0/3d0)))**2*0.21951d0 - kappa = 0.804d0 - -! Compute GGA exchange energy - - Ex = 0d0 - - do iG=1,nGrid - - r = max(0d0,rho(iG)) - - if(r > threshold) then - g = drho(1,iG)**2 + drho(2,iG)**2 + drho(3,iG)**2 - s2 = g/r**(8d0/3d0) - - Ex = Ex + weight(iG)*CxLSDA*r**(4d0/3d0)*(1d0 + kappa - kappa/(1d0 + mupbe*s2/kappa)) - - end if - - end do - -end subroutine PBE_gga_exchange_energy diff --git a/src/eDFT/PBE_gga_exchange_potential.f90 b/src/eDFT/PBE_gga_exchange_potential.f90 deleted file mode 100644 index 81a7687..0000000 --- a/src/eDFT/PBE_gga_exchange_potential.f90 +++ /dev/null @@ -1,67 +0,0 @@ -subroutine PBE_gga_exchange_potential(nGrid,weight,nBas,AO,dAO,rho,drho,Fx) - -! Compute PBE GGA exchange potential - - implicit none - include 'parameters.h' - -! Input variables - - integer,intent(in) :: nGrid - double precision,intent(in) :: weight(nGrid) - integer,intent(in) :: nBas - double precision,intent(in) :: AO(nBas,nGrid) - double precision,intent(in) :: dAO(3,nBas,nGrid) - double precision,intent(in) :: rho(nGrid) - double precision,intent(in) :: drho(3,nGrid) - -! Local variables - - integer :: mu,nu,iG - double precision :: mupbe,kappa - double precision :: r,g,s2,vAO,gAO - -! Output variables - - double precision,intent(out) :: Fx(nBas,nBas) - -! Coefficients for PBE exchange functional - - mupbe = ((1d0/2d0**(1d0/3d0))/(2d0*(3d0*pi**2)**(1d0/3d0)))**2*0.21951d0 - kappa = 0.804d0 - -! Compute GGA exchange matrix in the AO basis - - Fx(:,:) = 0d0 - - do mu=1,nBas - do nu=1,nBas - do iG=1,nGrid - - r = max(0d0,rho(iG)) - - if(r > threshold) then - - g = drho(1,iG)**2 + drho(2,iG)**2 + drho(3,iG)**2 - s2 = g/r**(8d0/3d0) - - vAO = weight(iG)*AO(mu,iG)*AO(nu,iG) - - Fx(mu,nu) = Fx(mu,nu) & - + vAO*4d0/3d0*CxLSDA*r**(1d0/3d0)*(1d0 + kappa - kappa/(1d0 + mupbe*s2/kappa)) & - - vAO*8d0/3d0*CxLSDA*r**(1d0/3d0)*mupbe*s2/(1d0 + mupbe*s2/kappa)**2 - - gAO = drho(1,iG)*(dAO(1,mu,iG)*AO(nu,iG) + AO(mu,iG)*dAO(1,nu,iG)) & - + drho(2,iG)*(dAO(2,mu,iG)*AO(nu,iG) + AO(mu,iG)*dAO(2,nu,iG)) & - + drho(3,iG)*(dAO(3,mu,iG)*AO(nu,iG) + AO(mu,iG)*dAO(3,nu,iG)) - gAO = weight(iG)*gAO - - Fx(mu,nu) = Fx(mu,nu) + 2d0*gAO*CxLSDA*r**(-4d0/3d0)*mupbe/(1d0 + mupbe*s2/kappa)**2 - - end if - - end do - end do - end do - -end subroutine PBE_gga_exchange_potential diff --git a/src/eDFT/PW92_lda_correlation_energy.f90 b/src/eDFT/PW92_lda_correlation_energy.f90 deleted file mode 100644 index 7b13588..0000000 --- a/src/eDFT/PW92_lda_correlation_energy.f90 +++ /dev/null @@ -1,120 +0,0 @@ -subroutine PW92_lda_correlation_energy(nGrid,weight,rho,Ec) - -! Compute unrestricted PW92 LDA correlation energy - - implicit none - - include 'parameters.h' - -! Input variables - - integer,intent(in) :: nGrid - double precision,intent(in) :: weight(nGrid) - double precision,intent(in) :: rho(nGrid,nspin) - -! Local variables - - integer :: iG - double precision :: ra,rb,r,rs,z - double precision :: A_p,a1_p,b1_p,b2_p,b3_p,b4_p - double precision :: A_f,a1_f,b1_f,b2_f,b3_f,b4_f - double precision :: A_a,a1_a,b1_a,b2_a,b3_a,b4_a - - double precision :: ec_z,ec_p,ec_f,ec_a - double precision :: fz,d2fz - -! Output variables - - double precision :: Ec(nsp) - -! Parameters of the functional - - A_p = 0.031091d0 - a1_p = 0.21370d0 - b1_p = 7.5957d0 - b2_p = 3.5876d0 - b3_p = 1.6382d0 - b4_p = 0.49294d0 - - A_f = 0.015545d0 - a1_f = 0.20548d0 - b1_f = 14.1189d0 - b2_f = 6.1977d0 - b3_f = 3.3662d0 - b4_f = 0.62517d0 - - A_a = 0.016887d0 - a1_a = 0.11125d0 - b1_a = 10.357d0 - b2_a = 3.6231d0 - b3_a = 0.88026d0 - b4_a = 0.49671d0 - -! Initialization - - Ec(:) = 0d0 - - do iG=1,nGrid - - ra = max(0d0,rho(iG,1)) - rb = max(0d0,rho(iG,2)) - r = ra + rb - z = (ra - rb)/r - -! alpha-alpha contribution - - if(ra > threshold) then - - rs = (4d0*pi*ra/3d0)**(-1d0/3d0) - - ec_f = b1_f*sqrt(rs) + b2_f*rs + b3_f*rs**(3d0/2d0) + b4_f*rs**2 - ec_f = -2d0*A_f*(1d0 + a1_f*rs)*log(1d0 + 1d0/(2d0*A_f*ec_f)) - - Ec(1) = Ec(1) + weight(iG)*ec_f*ra - - end if - -! alpha-beta contribution - - if(r > threshold) then - - rs = (4d0*pi*r/3d0)**(-1d0/3d0) - - fz = (1d0 + z)**(4d0/3d0) + (1d0 - z)**(4d0/3d0) - 2d0 - fz = fz/(2d0*(2d0**(1d0/3d0) - 1d0)) - - d2fz = 4d0/(9d0*(2**(1d0/3d0) - 1d0)) - - ec_p = b1_p*sqrt(rs) + b2_p*rs + b3_p*rs**(3d0/2d0) + b4_p*rs**2 - ec_p = -2d0*A_p*(1d0 + a1_p*rs)*log(1d0 + 1d0/(2d0*A_p*ec_p)) - - ec_f = b1_f*sqrt(rs) + b2_f*rs + b3_f*rs**(3d0/2d0) + b4_f*rs**2 - ec_f = -2d0*A_f*(1d0 + a1_f*rs)*log(1d0 + 1d0/(2d0*A_f*ec_f)) - - ec_a = b1_a*sqrt(rs) + b2_a*rs + b3_a*rs**(3d0/2d0) + b4_a*rs**2 - ec_a = +2d0*A_a*(1d0 + a1_a*rs)*log(1d0 + 1d0/(2d0*A_a*ec_a)) - - ec_z = ec_p + ec_a*fz/d2fz*(1d0-z**4) + (ec_f - ec_p)*fz*z**4 - - Ec(2) = Ec(2) + weight(iG)*ec_z*r - - end if - -! beta-beta contribution - - if(rb > threshold) then - - rs = (4d0*pi*rb/3d0)**(-1d0/3d0) - - ec_f = b1_f*sqrt(rs) + b2_f*rs + b3_f*rs**(3d0/2d0) + b4_f*rs**2 - ec_f = -2d0*A_f*(1d0 + a1_f*rs)*log(1d0 + 1d0/(2d0*A_f*ec_f)) - - Ec(3) = Ec(3) + weight(iG)*ec_f*rb - - end if - - end do - - Ec(2) = Ec(2) - Ec(1) - Ec(3) - -end subroutine PW92_lda_correlation_energy diff --git a/src/eDFT/PW92_lda_correlation_potential.f90 b/src/eDFT/PW92_lda_correlation_potential.f90 deleted file mode 100644 index 32dad64..0000000 --- a/src/eDFT/PW92_lda_correlation_potential.f90 +++ /dev/null @@ -1,185 +0,0 @@ -subroutine PW92_lda_correlation_potential(nGrid,weight,nBas,AO,rho,Fc) - -! Compute unrestricted PW92 LDA correlation potential - - implicit none - - include 'parameters.h' - -! Input variables - - integer,intent(in) :: nGrid - double precision,intent(in) :: weight(nGrid) - integer,intent(in) :: nBas - double precision,intent(in) :: AO(nBas,nGrid) - double precision,intent(in) :: rho(nGrid,nspin) - -! Local variables - - integer :: mu,nu,iG - double precision :: ra,rb,r,rs,z,t,dt - double precision :: A_p,a1_p,b1_p,b2_p,b3_p,b4_p - double precision :: A_f,a1_f,b1_f,b2_f,b3_f,b4_f - double precision :: A_a,a1_a,b1_a,b2_a,b3_a,b4_a - double precision :: dfzdz,decdrs_p,decdrs_f,decdrs_a - double precision :: dzdra,dfzdra,drsdra,decdra_p,decdra_f,decdra_a,decdra - double precision :: dzdrb,dfzdrb,drsdrb,decdrb_p,decdrb_f,decdrb_a,decdrb - - double precision :: ec_z,ec_p,ec_f,ec_a - double precision :: fz,d2fz - -! Output variables - - double precision :: Fc(nBas,nBas,nspin) - -! Parameters of the functional - - A_p = 0.031091d0 - a1_p = 0.21370d0 - b1_p = 7.5957d0 - b2_p = 3.5876d0 - b3_p = 1.6382d0 - b4_p = 0.49294d0 - - A_f = 0.015545d0 - a1_f = 0.20548d0 - b1_f = 14.1189d0 - b2_f = 6.1977d0 - b3_f = 3.3662d0 - b4_f = 0.62517d0 - - A_a = 0.016887d0 - a1_a = 0.11125d0 - b1_a = 10.357d0 - b2_a = 3.6231d0 - b3_a = 0.88026d0 - b4_a = 0.49671d0 - -! Initialization - - Fc(:,:,:) = 0d0 - - do mu=1,nBas - do nu=1,nBas - do iG=1,nGrid - - ra = max(0d0,rho(iG,1)) - rb = max(0d0,rho(iG,2)) - -! spin-up contribution - - if(ra > threshold) then - - r = ra + rb - rs = (4d0*pi*r/3d0)**(-1d0/3d0) - z = (ra - rb)/r - - fz = (1d0 + z)**(4d0/3d0) + (1d0 - z)**(4d0/3d0) - 2d0 - fz = fz/(2d0*(2d0**(1d0/3d0) - 1d0)) - - d2fz = 4d0/(9d0*(2**(1d0/3d0) - 1d0)) - - ec_p = b1_p*sqrt(rs) + b2_p*rs + b3_p*rs**(3d0/2d0) + b4_p*rs**2 - ec_p = -2d0*A_p*(1d0 + a1_p*rs)*log(1d0 + 1d0/(2d0*A_p*ec_p)) - - ec_f = b1_f*sqrt(rs) + b2_f*rs + b3_f*rs**(3d0/2d0) + b4_f*rs**2 - ec_f = -2d0*A_f*(1d0 + a1_f*rs)*log(1d0 + 1d0/(2d0*A_f*ec_f)) - - ec_a = b1_a*sqrt(rs) + b2_a*rs + b3_a*rs**(3d0/2d0) + b4_a*rs**2 - ec_a = +2d0*A_a*(1d0 + a1_a*rs)*log(1d0 + 1d0/(2d0*A_a*ec_a)) - - ec_z = ec_p + ec_a*fz/d2fz*(1d0-z**4) + (ec_f - ec_p)*fz*z**4 - - dzdra = (1d0 - z)/r - dfzdz = (4d0/3d0)*((1d0 + z)**(1d0/3d0) - (1d0 - z)**(1d0/3d0))/(2d0*(2d0**(1d0/3d0) - 1d0)) - dfzdra = dzdra*dfzdz - drsdra = - (36d0*pi)**(-1d0/3d0)*r**(-4d0/3d0) - - t = b1_p*sqrt(rs) + b2_p*rs + b3_p*rs**(3d0/2d0) + b4_p*rs**2 - dt = 0.5d0*b1_p*sqrt(rs) + b2_p*rs + 1.5d0*b3_p*rs**(3d0/2d0) + 2d0*b4_p*rs**2 - decdrs_p = (1d0 + a1_p*rs)/rs*dt/(t**2*(1d0 + 1d0/(2d0*A_p*t))) & - - 2d0*A_p*a1_p*log(1d0 + 1d0/(2d0*A_p*t)) - - t = b1_f*sqrt(rs) + b2_f*rs + b3_f*rs**(3d0/2d0) + b4_f*rs**2 - dt = 0.5d0*b1_f*sqrt(rs) + b2_f*rs + 1.5d0*b3_f*rs**(3d0/2d0) + 2d0*b4_f*rs**2 - decdrs_f = (1d0 + a1_f*rs)/rs*dt/(t**2*(1d0 + 1d0/(2d0*A_f*t))) & - - 2d0*A_f*a1_f*log(1d0 + 1d0/(2d0*A_f*t)) - - t = b1_a*sqrt(rs) + b2_a*rs + b3_a*rs**(3d0/2d0) + b4_a*rs**2 - dt = 0.5d0*b1_a*sqrt(rs) + b2_a*rs + 1.5d0*b3_a*rs**(3d0/2d0) + 2d0*b4_a*rs**2 - decdrs_a = (1d0 + a1_a*rs)/rs*dt/(t**2*(1d0 + 1d0/(2d0*A_a*t))) & - - 2d0*A_a*a1_a*log(1d0 + 1d0/(2d0*A_a*t)) - - decdra_p = drsdra*decdrs_p - decdra_f = drsdra*decdrs_f - decdra_a = drsdra*decdrs_a - - decdra = decdra_p + decdra_a*fz/d2fz*(1d0-z**4) + ec_a*dfzdra/d2fz*(1d0-z**4) - 4d0*ec_a*fz/d2fz*dzdra*z**3 & - + (decdra_f - decdra_p)*fz*z**4 + (ec_f - ec_p)*dfzdra*z**4 + 4d0*(ec_f - ec_p)*fz*dzdra*z**3 - - Fc(mu,nu,1) = Fc(mu,nu,1) + weight(iG)*AO(mu,iG)*AO(nu,iG)*(ec_z + decdra*r) - - end if - -! spin-down contribution - - if(rb > threshold) then - - r = ra + rb - rs = (4d0*pi*r/3d0)**(-1d0/3d0) - z = (ra - rb)/r - - fz = (1d0 + z)**(4d0/3d0) + (1d0 - z)**(4d0/3d0) - 2d0 - fz = fz/(2d0*(2d0**(1d0/3d0) - 1d0)) - - d2fz = 4d0/(9d0*(2**(1d0/3d0) - 1d0)) - - ec_p = b1_p*sqrt(rs) + b2_p*rs + b3_p*rs**(3d0/2d0) + b4_p*rs**2 - ec_p = -2d0*A_p*(1d0 + a1_p*rs)*log(1d0 + 1d0/(2d0*A_p*ec_p)) - - ec_f = b1_f*sqrt(rs) + b2_f*rs + b3_f*rs**(3d0/2d0) + b4_f*rs**2 - ec_f = -2d0*A_f*(1d0 + a1_f*rs)*log(1d0 + 1d0/(2d0*A_f*ec_f)) - - ec_a = b1_a*sqrt(rs) + b2_a*rs + b3_a*rs**(3d0/2d0) + b4_a*rs**2 - ec_a = +2d0*A_a*(1d0 + a1_a*rs)*log(1d0 + 1d0/(2d0*A_a*ec_a)) - - ec_z = ec_p + ec_a*fz/d2fz*(1d0-z**4) + (ec_f - ec_p)*fz*z**4 - - dzdrb = - (1d0 + z)/r - dfzdz = (4d0/3d0)*((1d0 + z)**(1d0/3d0) - (1d0 - z)**(1d0/3d0))/(2d0*(2d0**(1d0/3d0) - 1d0)) - dfzdrb = dzdrb*dfzdz - - drsdrb = - (36d0*pi)**(-1d0/3d0)*r**(-4d0/3d0) - - - t = b1_p*sqrt(rs) + b2_p*rs + b3_p*rs**(3d0/2d0) + b4_p*rs**2 - dt = 0.5d0*b1_p*sqrt(rs) + b2_p*rs + 1.5d0*b3_p*rs**(3d0/2d0) + 2d0*b4_p*rs**2 - decdrs_p = (1d0 + a1_p*rs)/rs*dt/(t**2*(1d0 + 1d0/(2d0*A_p*t))) & - - 2d0*A_p*a1_p*log(1d0 + 1d0/(2d0*A_p*t)) - - t = b1_f*sqrt(rs) + b2_f*rs + b3_f*rs**(3d0/2d0) + b4_f*rs**2 - dt = 0.5d0*b1_f*sqrt(rs) + b2_f*rs + 1.5d0*b3_f*rs**(3d0/2d0) + 2d0*b4_f*rs**2 - decdrs_f = (1d0 + a1_f*rs)/rs*dt/(t**2*(1d0 + 1d0/(2d0*A_f*t))) & - - 2d0*A_f*a1_f*log(1d0 + 1d0/(2d0*A_f*t)) - - t = b1_a*sqrt(rs) + b2_a*rs + b3_a*rs**(3d0/2d0) + b4_a*rs**2 - dt = 0.5d0*b1_a*sqrt(rs) + b2_a*rs + 1.5d0*b3_a*rs**(3d0/2d0) + 2d0*b4_a*rs**2 - decdrs_a = (1d0 + a1_a*rs)/rs*dt/(t**2*(1d0 + 1d0/(2d0*A_a*t))) & - - 2d0*A_a*a1_a*log(1d0 + 1d0/(2d0*A_a*t)) - - decdrb_p = drsdrb*decdrs_p - decdrb_f = drsdrb*decdrs_f - decdrb_a = drsdrb*decdrs_a - - decdrb = decdrb_p + decdrb_a*fz/d2fz*(1d0-z**4) + ec_a*dfzdrb/d2fz*(1d0-z**4) - 4d0*ec_a*fz/d2fz*dzdrb*z**3 & - + (decdrb_f - decdrb_p)*fz*z**4 + (ec_f - ec_p)*dfzdrb*z**4 + 4d0*(ec_f - ec_p)*fz*dzdrb*z**3 - - Fc(mu,nu,2) = Fc(mu,nu,2) + weight(iG)*AO(mu,iG)*AO(nu,iG)*(ec_z + decdrb*r) - - end if - - end do - end do - end do - -end subroutine PW92_lda_correlation_potential diff --git a/src/eDFT/S51_lda_exchange_energy.f90 b/src/eDFT/S51_lda_exchange_energy.f90 deleted file mode 100644 index 1173c4c..0000000 --- a/src/eDFT/S51_lda_exchange_energy.f90 +++ /dev/null @@ -1,34 +0,0 @@ -subroutine S51_lda_exchange_energy(nGrid,weight,rho,Ex) - -! Compute Slater's LDA exchange energy - - implicit none - include 'parameters.h' - -! Input variables - - integer,intent(in) :: nGrid - double precision,intent(in) :: weight(nGrid) - double precision,intent(in) :: rho(nGrid) - -! Local variables - - integer :: iG - double precision :: r - -! Output variables - - double precision :: Ex - -! Compute LDA exchange energy - - Ex = 0d0 - do iG=1,nGrid - - r = max(0d0,rho(iG)) - - if(r > threshold) Ex = Ex + weight(iG)*CxLSDA*r**(1d0/3d0)*r - - enddo - -end subroutine S51_lda_exchange_energy diff --git a/src/eDFT/S51_lda_exchange_individual_energy.f90 b/src/eDFT/S51_lda_exchange_individual_energy.f90 deleted file mode 100644 index 7bb4313..0000000 --- a/src/eDFT/S51_lda_exchange_individual_energy.f90 +++ /dev/null @@ -1,61 +0,0 @@ -subroutine S51_lda_exchange_individual_energy(nEns,nGrid,weight,rhow,rho,LZx,Ex) - -! Compute the restricted version of Slater's LDA exchange individual energy - - implicit none - include 'parameters.h' - -! Input variables - - integer,intent(in) :: nEns - integer,intent(in) :: nGrid - double precision,intent(in) :: weight(nGrid) - double precision,intent(in) :: rhow(nGrid,nspin) - double precision,intent(in) :: rho(nGrid,nspin,nEns) - -! Local variables - - integer :: iG - integer :: iEns - integer :: ispin - double precision :: r - double precision :: rI - double precision :: e - double precision :: dedr - -! Output variables - - double precision,intent(out) :: LZx(nspin) - double precision,intent(out) :: Ex(nspin,nEns) - - LZx(:) = 0d0 - Ex(:,:) = 0d0 - - do ispin=1,nspin - - do iG=1,nGrid - - r = max(0d0,rhow(iG,ispin)) - - if(r > threshold) then - - e = CxLSDA*r**(+1d0/3d0) - dedr = 1d0/3d0*CxLSDA*r**(-2d0/3d0) - - LZx(ispin) = LZx(ispin) - weight(iG)*dedr*r*r - - do iEns=1,nEns - - rI = max(0d0,rho(iG,ispin,iEns)) - - if(rI > threshold) Ex(ispin,iEns) = Ex(ispin,iEns) + weight(iG)*(e + dedr*r)*rI - - end do - - endif - - enddo - - enddo - -end subroutine S51_lda_exchange_individual_energy diff --git a/src/eDFT/S51_lda_exchange_potential.f90 b/src/eDFT/S51_lda_exchange_potential.f90 deleted file mode 100644 index 4c0978e..0000000 --- a/src/eDFT/S51_lda_exchange_potential.f90 +++ /dev/null @@ -1,45 +0,0 @@ -subroutine S51_lda_exchange_potential(nGrid,weight,nBas,AO,rho,Fx) - -! Compute Slater's LDA exchange potential - - implicit none - include 'parameters.h' - -! Input variables - - integer,intent(in) :: nGrid - double precision,intent(in) :: weight(nGrid) - integer,intent(in) :: nBas - double precision,intent(in) :: AO(nBas,nGrid) - double precision,intent(in) :: rho(nGrid) - -! Local variables - - integer :: mu,nu,iG - double precision :: r,vAO - -! Output variables - - double precision,intent(out) :: Fx(nBas,nBas) - -! Compute LDA exchange matrix in the AO basis - - Fx(:,:) = 0d0 - do mu=1,nBas - do nu=1,nBas - do iG=1,nGrid - - r = max(0d0,rho(iG)) - - if(r > threshold) then - - vAO = weight(iG)*AO(mu,iG)*AO(nu,iG) - Fx(mu,nu) = Fx(mu,nu) + vAO*4d0/3d0*CxLSDA*r**(1d0/3d0) - - endif - - enddo - enddo - enddo - -end subroutine S51_lda_exchange_potential diff --git a/src/eDFT/UKS.f90 b/src/eDFT/UKS.f90 deleted file mode 100644 index afa4914..0000000 --- a/src/eDFT/UKS.f90 +++ /dev/null @@ -1,392 +0,0 @@ -subroutine UKS(x_rung,x_DFA,c_rung,c_DFA,nEns,wEns,nCC,aCC,nGrid,weight,maxSCF,thresh,max_diis,guess_type,mix,level_shift, & - nNuc,ZNuc,rNuc,ENuc,nBas,AO,dAO,S,T,V,Hc,ERI,dipole_int,X,occnum,Cx_choice,doNcentered,Ew,eKS,c,Pw,Vxc) - -! Perform unrestricted Kohn-Sham calculation for ensembles - - implicit none - include 'parameters.h' - -! Input variables - - integer,intent(in) :: x_rung,c_rung - integer,intent(in) :: x_DFA,c_DFA - integer,intent(in) :: nEns - double precision,intent(in) :: wEns(nEns) - integer,intent(in) :: nCC - double precision,intent(in) :: aCC(nCC,nEns-1) - integer,intent(in) :: nGrid - double precision,intent(in) :: weight(nGrid) - integer,intent(in) :: maxSCF - integer,intent(in) :: max_diis - integer,intent(in) :: guess_type - logical,intent(in) :: mix - double precision,intent(in) :: level_shift - double precision,intent(in) :: thresh - integer,intent(in) :: nBas - double precision,intent(in) :: AO(nBas,nGrid) - double precision,intent(in) :: dAO(ncart,nBas,nGrid) - - integer,intent(in) :: nNuc - double precision,intent(in) :: ZNuc(nNuc) - double precision,intent(in) :: rNuc(nNuc,ncart) - double precision,intent(in) :: ENuc - - double precision,intent(in) :: S(nBas,nBas) - double precision,intent(in) :: T(nBas,nBas) - double precision,intent(in) :: V(nBas,nBas) - double precision,intent(in) :: Hc(nBas,nBas) - double precision,intent(in) :: X(nBas,nBas) - double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas) - double precision,intent(in) :: dipole_int(nBas,nBas,ncart) - double precision,intent(in) :: occnum(nBas,nspin,nEns) - integer,intent(in) :: Cx_choice - logical,intent(in) :: doNcentered - -! Local variables - - integer :: xc_rung - logical :: LDA_centered = .false. - integer :: nSCF - integer :: nBasSq - integer :: n_diis - integer :: nO(nspin,nEns) - double precision :: Conv - double precision :: rcond(nspin) - double precision :: ET(nspin) - double precision :: EV(nspin) - double precision :: EH(nsp) - double precision :: Ex(nspin) - double precision :: Ec(nsp) - double precision :: dipole(ncart) - - double precision,allocatable :: cp(:,:,:) - double precision,allocatable :: J(:,:,:) - double precision,allocatable :: F(:,:,:) - double precision,allocatable :: Fp(:,:,:) - double precision,allocatable :: Fx(:,:,:) - double precision,allocatable :: FxHF(:,:,:) - double precision,allocatable :: Fc(:,:,:) - double precision,allocatable :: err(:,:,:) - double precision,allocatable :: err_diis(:,:,:) - double precision,allocatable :: F_diis(:,:,:) - double precision,external :: trace_matrix - double precision,external :: electron_number - - double precision,allocatable :: rhow(:,:) - double precision,allocatable :: drhow(:,:,:) - double precision :: nEl(nspin) - - double precision,allocatable :: P(:,:,:,:) - double precision,allocatable :: rho(:,:,:) - double precision,allocatable :: drho(:,:,:,:) - - integer :: ispin,iEns,iBas - -! Output variables - - double precision,intent(out) :: Ew - double precision,intent(out) :: eKS(nBas,nspin) - double precision,intent(out) :: Pw(nBas,nBas,nspin) - double precision,intent(out) :: c(nBas,nBas,nspin) - double precision,intent(out) :: Vxc(nBas,nspin) - -! Hello world - - write(*,*) - write(*,*)'************************************************' - write(*,*)'* Unrestricted Kohn-Sham calculation *' - write(*,*)'* *** for ensembles *** *' - write(*,*)'************************************************' - write(*,*) - -! Useful stuff - - nBasSq = nBas*nBas - -!------------------------------------------------------------------------ -! Rung of Jacob's ladder -!------------------------------------------------------------------------ - - xc_rung = max(x_rung,c_rung) - -! Memory allocation - - allocate(cp(nBas,nBas,nspin),J(nBas,nBas,nspin),F(nBas,nBas,nspin),Fp(nBas,nBas,nspin), & - Fx(nBas,nBas,nspin),FxHF(nBas,nBas,nspin),Fc(nBas,nBas,nspin),err(nBas,nBas,nspin), & - rhow(nGrid,nspin),drhow(ncart,nGrid,nspin), & - err_diis(nBasSq,max_diis,nspin),F_diis(nBasSq,max_diis,nspin), & - P(nBas,nBas,nspin,nEns),rho(nGrid,nspin,nEns),drho(ncart,nGrid,nspin,nEns)) - -! Guess coefficients and eigenvalues - - nO(:,:) = 0 - do iEns=1,nEns - do ispin=1,nspin - nO(ispin,iEns) = int(sum(occnum(:,ispin,iEns))) - end do - end do - - do ispin=1,nspin - call mo_guess(nBas,guess_type,S,Hc,X,c(:,:,ispin)) - end do - -! Mix guess for UHF solution in singlet states - - if(mix) then - write(*,*) '!! guess mixing disabled in UKS !!' - write(*,*) - end if - -! Initialization - - nSCF = 0 - conv = 1d0 - - nEl(:) = 0d0 - Ex(:) = 0d0 - Ec(:) = 0d0 - - Fx(:,:,:) = 0d0 - FxHF(:,:,:) = 0d0 - Fc(:,:,:) = 0d0 - - n_diis = 0 - F_diis(:,:,:) = 0d0 - err_diis(:,:,:) = 0d0 - rcond(:) = 1d0 - -!------------------------------------------------------------------------ -! Main SCF loop -!------------------------------------------------------------------------ - - write(*,*) - write(*,*)'------------------------------------------------------------------------------------------' - write(*,'(1X,A1,1X,A3,1X,A1,1X,A16,1X,A1,1X,A16,1X,A1,1X,A16,1X,A1,1X,A10,1X,A1,1X,A10,1X,A1,1X)') & - '|','#','|','E(KS)','|','Ex(KS)','|','Ec(KS)','|','Conv','|','nEl','|' - write(*,*)'------------------------------------------------------------------------------------------' - - do while(Conv > thresh .and. nSCF < maxSCF) - -! Increment - - nSCF = nSCF + 1 - -!------------------------------------------------------------------------ -! Compute density matrix -!------------------------------------------------------------------------ - - call density_matrix(nBas,nEns,c(:,:,:),P(:,:,:,:),occnum(:,:,:)) - -! Weight-dependent density matrix - - Pw(:,:,:) = 0d0 - do iEns=1,nEns - Pw(:,:,:) = Pw(:,:,:) + wEns(iEns)*P(:,:,:,iEns) - end do - -!------------------------------------------------------------------------ -! Compute one-electron density and its gradient if necessary -!------------------------------------------------------------------------ - - do ispin=1,nspin - do iEns=1,nEns - call density(nGrid,nBas,P(:,:,ispin,iEns),AO(:,:),rho(:,ispin,iEns)) - end do - end do - -! Weight-dependent one-electron density - - rhow(:,:) = 0d0 - do iEns=1,nEns - rhow(:,:) = rhow(:,:) + wEns(iEns)*rho(:,:,iEns) - end do - - if(xc_rung > 1) then - -! Ground state density - - do ispin=1,nspin - do iEns=1,nEns - call gradient_density(nGrid,nBas,P(:,:,ispin,iEns),AO(:,:),dAO(:,:,:),drho(:,:,ispin,iEns)) - end do - end do - -! Weight-dependent one-electron density - - drhow(:,:,:) = 0d0 - do iEns=1,nEns - drhow(:,:,:) = drhow(:,:,:) + wEns(iEns)*drho(:,:,:,iEns) - end do - - end if - -!------------------------------------------------------------------------ -! Compute Hxc potential and Fock operator -!------------------------------------------------------------------------ - -! Compute Hartree potential - - do ispin=1,nspin - call hartree_potential(nBas,Pw(:,:,ispin),ERI,J(:,:,ispin)) - end do - -! Compute exchange potential - - do ispin=1,nspin - call exchange_potential(x_rung,x_DFA,LDA_centered,nEns,wEns,nCC,aCC,nGrid,weight,nBas, & - Pw(:,:,ispin),ERI,AO,dAO,rhow(:,ispin),drhow(:,:,ispin), & - Cx_choice,doNcentered,Fx(:,:,ispin),FxHF(:,:,ispin)) - end do - -! Compute correlation potential - - call correlation_potential(c_rung,c_DFA,nEns,wEns,nGrid,weight,nBas,AO,dAO,rhow,drhow,Fc) - -! Build Fock operator - - do ispin=1,nspin - F(:,:,ispin) = Hc(:,:) + J(:,:,ispin) + J(:,:,mod(ispin,2)+1) + Fx(:,:,ispin) + Fc(:,:,ispin) - end do - -! Check convergence - - do ispin=1,nspin - err(:,:,ispin) = matmul(F(:,:,ispin),matmul(Pw(:,:,ispin),S(:,:))) - matmul(matmul(S(:,:),Pw(:,:,ispin)),F(:,:,ispin)) - end do - - if(nSCF > 1) Conv = maxval(abs(err(:,:,:))) - -! DIIS extrapolation - - n_diis = min(n_diis+1,max_diis) - do ispin=1,nspin - - if(rcond(ispin) > 1d-15) then - - call DIIS_extrapolation(rcond(ispin),nBasSq,nBasSq,n_diis, & - err_diis(:,:,ispin),F_diis(:,:,ispin),err(:,:,ispin),F(:,:,ispin)) - else - - n_diis = 0 - - end if - - end do - -! Level-shifting - - if(level_shift > 0d0 .and. Conv > thresh) then - - do ispin=1,nspin - call level_shifting(level_shift,nBas,maxval(nO(ispin,:)),S,c,F(:,:,ispin)) - end do - - end if - -! Transform Fock matrix in orthogonal basis - - do ispin=1,nspin - Fp(:,:,ispin) = matmul(transpose(X(:,:)),matmul(F(:,:,ispin),X(:,:))) - end do - -! Diagonalize Fock matrix to get eigenvectors and eigenvalues - - cp(:,:,:) = Fp(:,:,:) - do ispin=1,nspin - call diagonalize_matrix(nBas,cp(:,:,ispin),eKS(:,ispin)) - end do - -! Back-transform eigenvectors in non-orthogonal basis - - do ispin=1,nspin - c(:,:,ispin) = matmul(X(:,:),cp(:,:,ispin)) - end do - -!------------------------------------------------------------------------ -! Compute KS energy -!------------------------------------------------------------------------ - -! Kinetic energy - - do ispin=1,nspin - ET(ispin) = trace_matrix(nBas,matmul(Pw(:,:,ispin),T(:,:))) - end do - -! Potential energy - - do ispin=1,nspin - EV(ispin) = trace_matrix(nBas,matmul(Pw(:,:,ispin),V(:,:))) - end do - -! Hartree energy - - call hartree_energy(nBas,Pw,J,EH) - -! Exchange energy - - do ispin=1,nspin - call exchange_energy(x_rung,x_DFA,LDA_centered,nEns,wEns,nCC,aCC,nGrid,weight,nBas, & - Pw(:,:,ispin),FxHF(:,:,ispin),rhow(:,ispin),drhow(:,:,ispin), & - Cx_choice,doNcentered,Ex(ispin)) - end do - -! Correlation energy - - call correlation_energy(c_rung,c_DFA,nEns,wEns,nGrid,weight,rhow,drhow,Ec) - -! Total energy - - Ew = sum(ET(:)) + sum(EV(:)) + sum(EH(:)) + sum(Ex(:)) + sum(Ec(:)) - -! Check the grid accuracy by computing the number of electrons - - do ispin=1,nspin - nEl(ispin) = electron_number(nGrid,weight,rhow(:,ispin)) - end do - -! Dump results - - write(*,'(1X,A1,1X,I3,1X,A1,1X,F16.10,1X,A1,1X,F16.10,1X,A1,1X,F16.10,1X,A1,1X,F10.6,1X,A1,1X,F10.6,1X,A1,1X)') & - '|',nSCF,'|',Ew + ENuc,'|',sum(Ex(:)),'|',sum(Ec(:)),'|',Conv,'|',sum(nEl(:)),'|' - - end do - write(*,*)'------------------------------------------------------------------------------------------' - -! print*,'Ensemble energy:',Ew + ENuc,'au' - - -!------------------------------------------------------------------------ -! End of SCF loop -!------------------------------------------------------------------------ - -! Did it actually converge? - - if(nSCF == maxSCF) then - - write(*,*) - write(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!' - write(*,*)' Convergence failed ' - write(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!' - write(*,*) - - stop - - end if - -! Compute final KS energy - - call dipole_moment(nBas,Pw(:,:,1)+Pw(:,:,2),nNuc,ZNuc,rNuc,dipole_int,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 - - call xc_potential(nBas,c,Fx,Fc,Vxc) - -!------------------------------------------------------------------------ -! Compute individual energies from ensemble energy -!------------------------------------------------------------------------ - - call individual_energy(x_rung,x_DFA,c_rung,c_DFA,LDA_centered,nEns,wEns,nCC,aCC,nGrid,weight,nBas, & - AO,dAO,T,V,ERI,ENuc,eKS,Pw,rhow,drhow,J,Fx,FxHF,Fc,P,rho,drho,occnum,Cx_choice,doNcentered,Ew) - -end subroutine UKS diff --git a/src/eDFT/VWN3_lda_correlation_energy.f90 b/src/eDFT/VWN3_lda_correlation_energy.f90 deleted file mode 100644 index b5b2aa5..0000000 --- a/src/eDFT/VWN3_lda_correlation_energy.f90 +++ /dev/null @@ -1,137 +0,0 @@ -subroutine VWN3_lda_correlation_energy(nGrid,weight,rho,Ec) - -! Compute unrestricted VWN3 LDA correlation energy - - implicit none - - include 'parameters.h' - -! Input variables - - integer,intent(in) :: nGrid - double precision,intent(in) :: weight(nGrid) - double precision,intent(in) :: rho(nGrid,nspin) - -! Local variables - - integer :: iG - double precision :: ra,rb,r,rs,x,z - double precision :: a_p,x0_p,xx0_p,b_p,c_p,x_p,q_p - double precision :: a_f,x0_f,xx0_f,b_f,c_f,x_f,q_f - double precision :: a_a,x0_a,xx0_a,b_a,c_a,x_a,q_a - - double precision :: ec_z,ec_p,ec_f,ec_a - double precision :: fz,d2fz - -! Output variables - - double precision :: Ec(nsp) - -! Parameters of the functional - - a_p = +0.0621814d0/2d0 - x0_p = -0.409286d0 - b_p = +13.0720d0 - c_p = +42.7198d0 - - a_f = +0.0621814d0/4d0 - x0_f = -0.743294d0 - b_f = +20.1231d0 - c_f = +101.578d0 - - a_a = -1d0/(6d0*pi**2) - x0_a = -0.0047584D0 - b_a = 1.13107d0 - c_a = 13.0045d0 - -! Initialization - - Ec(:) = 0d0 - - do iG=1,nGrid - - ra = max(0d0,rho(iG,1)) - rb = max(0d0,rho(iG,2)) - r = ra + rb - z = (ra - rb)/r - -! alpha-alpha contribution - - if(ra > threshold) then - - rs = (4d0*pi*ra/3d0)**(-1d0/3d0) - x = sqrt(rs) - - x_f = x*x + b_f*x + c_f - xx0_f = x0_f*x0_f + b_f*x0_f + c_f - q_f = sqrt(4d0*c_f - b_f*b_f) - - ec_f = a_f*( log(x**2/x_f) + 2d0*b_f/q_f*atan(q_f/(2d0*x + b_f)) & - - b_f*x0_f/xx0_f*( log((x - x0_f)**2/x_f) + 2d0*(b_f + 2d0*x0_f)/q_f*atan(q_f/(2d0*x + b_f)) ) ) - - Ec(1) = Ec(1) + weight(iG)*ec_f*ra - - end if - -! alpha-beta contribution - - if(r > threshold) then - - rs = (4d0*pi*r/3d0)**(-1d0/3d0) - x = sqrt(rs) - - fz = (1d0 + z)**(4d0/3d0) + (1d0 - z)**(4d0/3d0) - 2d0 - fz = fz/(2d0*(2d0**(1d0/3d0) - 1d0)) - - d2fz = 4d0/(9d0*(2**(1d0/3d0) - 1d0)) - - x_p = x*x + b_p*x + c_p - x_f = x*x + b_f*x + c_f - x_a = x*x + b_a*x + c_a - - xx0_p = x0_p*x0_p + b_p*x0_p + c_p - xx0_f = x0_f*x0_f + b_f*x0_f + c_f - xx0_a = x0_a*x0_a + b_a*x0_a + c_a - - q_p = sqrt(4d0*c_p - b_p*b_p) - q_f = sqrt(4d0*c_f - b_f*b_f) - q_a = sqrt(4d0*c_a - b_a*b_a) - - ec_p = a_p*( log(x**2/x_p) + 2d0*b_p/q_p*atan(q_p/(2d0*x + b_p)) & - - b_p*x0_p/xx0_p*( log((x - x0_p)**2/x_p) + 2d0*(b_p + 2d0*x0_p)/q_p*atan(q_p/(2d0*x + b_p)) ) ) - - ec_f = a_f*( log(x**2/x_f) + 2d0*b_f/q_f*atan(q_f/(2d0*x + b_f)) & - - b_f*x0_f/xx0_f*( log((x - x0_f)**2/x_f) + 2d0*(b_f + 2d0*x0_f)/q_f*atan(q_f/(2d0*x + b_f)) ) ) - - ec_a = a_a*( log(x**2/x_a) + 2d0*b_a/q_a*atan(q_a/(2d0*x + b_a)) & - - b_a*x0_a/xx0_a*( log((x - x0_a)**2/x_a) + 2d0*(b_a + 2d0*x0_a)/q_a*atan(q_a/(2d0*x + b_a)) ) ) - - ec_z = ec_p + ec_a*fz/d2fz*(1d0-z**4) + (ec_f - ec_p)*fz*z**4 - - Ec(2) = Ec(2) + weight(iG)*ec_z*r - - end if - -! beta-beta contribution - - if(rb > threshold) then - - rs = (4d0*pi*rb/3d0)**(-1d0/3d0) - x = sqrt(rs) - - x_f = x*x + b_f*x + c_f - xx0_f = x0_f*x0_f + b_f*x0_f + c_f - q_f = sqrt(4d0*c_f - b_f*b_f) - - ec_f = a_f*( log(x**2/x_f) + 2d0*b_f/q_f*atan(q_f/(2d0*x + b_f)) & - - b_f*x0_f/xx0_f*( log((x - x0_f)**2/x_f) + 2d0*(b_f + 2d0*x0_f)/q_f*atan(q_f/(2d0*x + b_f)) ) ) - - Ec(3) = Ec(3) + weight(iG)*ec_f*rb - - end if - - end do - - Ec(2) = Ec(2) - Ec(1) - Ec(3) - -end subroutine VWN3_lda_correlation_energy diff --git a/src/eDFT/VWN3_lda_correlation_individual_energy.f90 b/src/eDFT/VWN3_lda_correlation_individual_energy.f90 deleted file mode 100644 index 5c90110..0000000 --- a/src/eDFT/VWN3_lda_correlation_individual_energy.f90 +++ /dev/null @@ -1,181 +0,0 @@ -subroutine VWN3_lda_correlation_individual_energy(nEns,nGrid,weight,rhow,rho,doNcentered,LZc,Ec) - -! Compute VWN3 LDA correlation potential - - implicit none - - include 'parameters.h' - -! Input variables - - integer,intent(in) :: nEns - integer,intent(in) :: nGrid - double precision,intent(in) :: weight(nGrid) - double precision,intent(in) :: rhow(nGrid,nspin) - double precision,intent(in) :: rho(nGrid,nspin,nEns) - logical,intent(in) :: doNcentered - -! Local variables - - integer :: iG - integer :: iEns - double precision :: ra,rb,r,raI,rbI,rI,rs,x,z - double precision :: a_p,x0_p,xx0_p,b_p,c_p,x_p,q_p - double precision :: a_f,x0_f,xx0_f,b_f,c_f,x_f,q_f - double precision :: a_a,x0_a,xx0_a,b_a,c_a,x_a,q_a - double precision :: dfzdz,dxdrs,dxdx_p,dxdx_f,dxdx_a,decdx_p,decdx_f,decdx_a - double precision :: dzdra,dzdrb,dfzdra,dfzdrb,drsdr,decdr_p,decdr_f,decdr_a,decdra,decdrb - double precision :: ec_z,ec_p,ec_f,ec_a - double precision :: fz,d2fz - -! Output variables - - double precision,intent(out) :: LZc(nsp) - double precision,intent(out) :: Ec(nsp,nEns) - -! Parameters of the functional - - a_p = +0.0621814d0/2d0 - x0_p = -0.409286d0 - b_p = +13.0720d0 - c_p = +42.7198d0 - - a_f = +0.0621814d0/4d0 - x0_f = -0.743294d0 - b_f = +20.1231d0 - c_f = +101.578d0 - - a_a = -1d0/(6d0*pi**2) - x0_a = -0.0047584D0 - b_a = +1.13107d0 - c_a = +13.0045d0 - -! Initialization - - LZc(:) = 0d0 - Ec(:,:) = 0d0 - - do iG=1,nGrid - - ra = max(0d0,rhow(iG,1)) - rb = max(0d0,rhow(iG,2)) - - r = ra + rb - -! up-down contribution - - if(r > threshold) then - - rs = (4d0*pi*r/3d0)**(-1d0/3d0) - z = (ra - rb)/r - x = sqrt(rs) - - fz = (1d0 + z)**(4d0/3d0) + (1d0 - z)**(4d0/3d0) - 2d0 - fz = fz/(2d0*(2d0**(1d0/3d0) - 1d0)) - - d2fz = 4d0/(9d0*(2**(1d0/3d0) - 1d0)) - - x_p = x*x + b_p*x + c_p - x_f = x*x + b_f*x + c_f - x_a = x*x + b_a*x + c_a - - xx0_p = x0_p*x0_p + b_p*x0_p + c_p - xx0_f = x0_f*x0_f + b_f*x0_f + c_f - xx0_a = x0_a*x0_a + b_a*x0_a + c_a - - q_p = sqrt(4d0*c_p - b_p*b_p) - q_f = sqrt(4d0*c_f - b_f*b_f) - q_a = sqrt(4d0*c_a - b_a*b_a) - - ec_p = a_p*( log(x**2/x_p) + 2d0*b_p/q_p*atan(q_p/(2d0*x + b_p)) & - - b_p*x0_p/xx0_p*( log((x - x0_p)**2/x_p) + 2d0*(b_p + 2d0*x0_p)/q_p*atan(q_p/(2d0*x + b_p)) ) ) - - ec_f = a_f*( log(x**2/x_f) + 2d0*b_f/q_f*atan(q_f/(2d0*x + b_f)) & - - b_f*x0_f/xx0_f*( log((x - x0_f)**2/x_f) + 2d0*(b_f + 2d0*x0_f)/q_f*atan(q_f/(2d0*x + b_f)) ) ) - - ec_a = a_a*( log(x**2/x_a) + 2d0*b_a/q_a*atan(q_a/(2d0*x + b_a)) & - - b_a*x0_a/xx0_a*( log((x - x0_a)**2/x_a) + 2d0*(b_a + 2d0*x0_a)/q_a*atan(q_a/(2d0*x + b_a)) ) ) - - ec_z = ec_p + ec_a*fz/d2fz*(1d0 - z**4) + (ec_f - ec_p)*fz*z**4 - - dfzdz = (4d0/3d0)*((1d0 + z)**(1d0/3d0) - (1d0 - z)**(1d0/3d0))/(2d0*(2d0**(1d0/3d0) - 1d0)) - - drsdr = - (36d0*pi)**(-1d0/3d0)*r**(-4d0/3d0) - dxdrs = 0.5d0/sqrt(rs) - - dxdx_p = 2d0*x + b_p - dxdx_f = 2d0*x + b_f - dxdx_a = 2d0*x + b_a - - decdx_p = a_p*( 2d0/x - 4d0*b_p/( (b_p+2d0*x)**2 + q_p**2) - dxdx_p/x_p & - - b_p*x0_p/xx0_p*( 2d0/(x-x0_p) - 4d0*(b_p+2d0*x0_p)/( (b_p+2d0*x)**2 + q_p**2) - dxdx_p/x_p ) ) - - decdx_f = a_f*( 2d0/x - 4d0*b_f/( (b_f+2d0*x)**2 + q_f**2) - dxdx_f/x_f & - - b_f*x0_f/xx0_f*( 2d0/(x-x0_f) - 4d0*(b_f+2d0*x0_f)/( (b_f+2d0*x)**2 + q_f**2) - dxdx_f/x_f ) ) - - decdx_a = a_a*( 2d0/x - 4d0*b_a/( (b_a+2d0*x)**2 + q_a**2) - dxdx_a/x_a & - - b_a*x0_a/xx0_a*( 2d0/(x-x0_a) - 4d0*(b_a+2d0*x0_a)/( (b_a+2d0*x)**2 + q_a**2) - dxdx_a/x_a ) ) - - decdr_p = drsdr*dxdrs*decdx_p - decdr_f = drsdr*dxdrs*decdx_f - decdr_a = drsdr*dxdrs*decdx_a - - dzdra = + (1d0 - z)/r - dfzdra = dzdra*dfzdz - - decdra = decdr_p + decdr_a*fz/d2fz*(1d0-z**4) + ec_a*dfzdra/d2fz*(1d0-z**4) - 4d0*ec_a*fz/d2fz*dzdra*z**3 & - + (decdr_f - decdr_p)*fz*z**4 + (ec_f - ec_p)*dfzdra*z**4 + 4d0*(ec_f - ec_p)*fz*dzdra*z**3 - - dzdrb = - (1d0 + z)/r - dfzdrb = dzdrb*dfzdz - - decdrb = decdr_p + decdr_a*fz/d2fz*(1d0-z**4) + ec_a*dfzdrb/d2fz*(1d0-z**4) - 4d0*ec_a*fz/d2fz*dzdrb*z**3 & - + (decdr_f - decdr_p)*fz*z**4 + (ec_f - ec_p)*dfzdrb*z**4 + 4d0*(ec_f - ec_p)*fz*dzdrb*z**3 - - ! spin-up contribution - - if(ra > threshold) then - - LZc(1) = LZc(1) - weight(iG)*decdra*ra*ra - - do iEns=1,nEns - - raI = max(0d0,rho(iG,1,iEns)) - - if(raI > threshold) then - - Ec(1,iEns) = Ec(1,iEns) + weight(iG)*(ec_z + decdra*ra)*raI - Ec(2,iEns) = Ec(2,iEns) + weight(iG)*decdra*rb*raI - - end if - - end do - - end if - - ! spin-down contribution - - if(rb > threshold) then - - LZc(3) = LZc(3) - weight(iG)*decdrb*rb*rb - - do iEns=1,nEns - - rbI = max(0d0,rho(iG,2,iEns)) - - if(rbI > threshold) then - - Ec(3,iEns) = Ec(3,iEns) + weight(iG)*(ec_z + decdrb*rb)*rbI - Ec(2,iEns) = Ec(2,iEns) + weight(iG)*decdrb*ra*rbI - - end if - - end do - - end if - - end if - - end do - -end subroutine VWN3_lda_correlation_individual_energy diff --git a/src/eDFT/VWN3_lda_correlation_potential.f90 b/src/eDFT/VWN3_lda_correlation_potential.f90 deleted file mode 100644 index 2465cb7..0000000 --- a/src/eDFT/VWN3_lda_correlation_potential.f90 +++ /dev/null @@ -1,196 +0,0 @@ -subroutine VWN3_lda_correlation_potential(nGrid,weight,nBas,AO,rho,Fc) - -! Compute unrestricted VWN3 LDA correlation potential - - implicit none - - include 'parameters.h' - -! Input variables - - integer,intent(in) :: nGrid - double precision,intent(in) :: weight(nGrid) - integer,intent(in) :: nBas - double precision,intent(in) :: AO(nBas,nGrid) - double precision,intent(in) :: rho(nGrid,nspin) - -! Local variables - - integer :: mu,nu,iG - double precision :: ra,rb,r,rs,x,z - double precision :: a_p,x0_p,xx0_p,b_p,c_p,x_p,q_p - double precision :: a_f,x0_f,xx0_f,b_f,c_f,x_f,q_f - double precision :: a_a,x0_a,xx0_a,b_a,c_a,x_a,q_a - double precision :: dfzdz,dxdrs,dxdx_p,dxdx_f,dxdx_a,decdx_p,decdx_f,decdx_a - double precision :: dzdra,dfzdra,drsdra,decdra_p,decdra_f,decdra_a,decdra - double precision :: dzdrb,dfzdrb,drsdrb,decdrb_p,decdrb_f,decdrb_a,decdrb - - double precision :: ec_z,ec_p,ec_f,ec_a - double precision :: fz,d2fz - -! Output variables - - double precision :: Fc(nBas,nBas,nspin) - -! Parameters of the functional - - a_p = +0.0621814d0/2d0 - x0_p = -0.409286d0 - b_p = +13.0720d0 - c_p = +42.7198d0 - - a_f = +0.0621814d0/4d0 - x0_f = -0.743294d0 - b_f = +20.1231d0 - c_f = +101.578d0 - - a_a = -1d0/(6d0*pi**2) - x0_a = -0.0047584D0 - b_a = +1.13107d0 - c_a = +13.0045d0 - -! Initialization - - Fc(:,:,:) = 0d0 - - do mu=1,nBas - do nu=1,nBas - do iG=1,nGrid - - ra = max(0d0,rho(iG,1)) - rb = max(0d0,rho(iG,2)) - r = ra + rb - z = (ra - rb)/r - - fz = (1d0 + z)**(4d0/3d0) + (1d0 - z)**(4d0/3d0) - 2d0 - fz = fz/(2d0*(2d0**(1d0/3d0) - 1d0)) - - d2fz = 4d0/(9d0*(2**(1d0/3d0) - 1d0)) - - -! spin-up contribution - - if(ra > threshold) then - - rs = (4d0*pi*r/3d0)**(-1d0/3d0) - x = sqrt(rs) - - x_p = x*x + b_p*x + c_p - x_f = x*x + b_f*x + c_f - x_a = x*x + b_a*x + c_a - - xx0_p = x0_p*x0_p + b_p*x0_p + c_p - xx0_f = x0_f*x0_f + b_f*x0_f + c_f - xx0_a = x0_a*x0_a + b_a*x0_a + c_a - - q_p = sqrt(4d0*c_p - b_p*b_p) - q_f = sqrt(4d0*c_f - b_f*b_f) - q_a = sqrt(4d0*c_a - b_a*b_a) - - ec_p = a_p*( log(x**2/x_p) + 2d0*b_p/q_p*atan(q_p/(2d0*x + b_p)) & - - b_p*x0_p/xx0_p*( log((x - x0_p)**2/x_p) + 2d0*(b_p + 2d0*x0_p)/q_p*atan(q_p/(2d0*x + b_p)) ) ) - - ec_f = a_f*( log(x**2/x_f) + 2d0*b_f/q_f*atan(q_f/(2d0*x + b_f)) & - - b_f*x0_f/xx0_f*( log((x - x0_f)**2/x_f) + 2d0*(b_f + 2d0*x0_f)/q_f*atan(q_f/(2d0*x + b_f)) ) ) - - ec_a = a_a*( log(x**2/x_a) + 2d0*b_a/q_a*atan(q_a/(2d0*x + b_a)) & - - b_a*x0_a/xx0_a*( log((x - x0_a)**2/x_a) + 2d0*(b_a + 2d0*x0_a)/q_a*atan(q_a/(2d0*x + b_a)) ) ) - - ec_z = ec_p + ec_a*fz/d2fz*(1d0-z**4) + (ec_f - ec_p)*fz*z**4 - - dzdra = (1d0 - z)/r - dfzdz = (4d0/3d0)*((1d0 + z)**(1d0/3d0) - (1d0 - z)**(1d0/3d0))/(2d0*(2d0**(1d0/3d0) - 1d0)) - dfzdra = dzdra*dfzdz - - drsdra = - (36d0*pi)**(-1d0/3d0)*r**(-4d0/3d0) - dxdrs = 0.5d0/sqrt(rs) - - dxdx_p = 2d0*x + b_p - dxdx_f = 2d0*x + b_f - dxdx_a = 2d0*x + b_a - - decdx_p = a_p*( 2d0/x - 4d0*b_p/( (b_p+2d0*x)**2 + q_p**2) - dxdx_p/x_p & - - b_p*x0_p/xx0_p*( 2/(x-x0_p) - 4d0*(b_p+2d0*x0_p)/( (b_p+2d0*x)**2 + q_p**2) - dxdx_p/x_p ) ) - - decdx_f = a_f*( 2d0/x - 4d0*b_f/( (b_f+2d0*x)**2 + q_f**2) - dxdx_f/x_f & - - b_f*x0_f/xx0_f*( 2/(x-x0_f) - 4d0*(b_f+2d0*x0_f)/( (b_f+2d0*x)**2 + q_f**2) - dxdx_f/x_f ) ) - - decdx_a = a_a*( 2d0/x - 4d0*b_a/( (b_a+2d0*x)**2 + q_a**2) - dxdx_a/x_a & - - b_a*x0_a/xx0_a*( 2/(x-x0_a) - 4d0*(b_a+2d0*x0_a)/( (b_a+2d0*x)**2 + q_a**2) - dxdx_a/x_a ) ) - - decdra_p = drsdra*dxdrs*decdx_p - decdra_f = drsdra*dxdrs*decdx_f - decdra_a = drsdra*dxdrs*decdx_a - - decdra = decdra_p + decdra_a*fz/d2fz*(1d0-z**4) + ec_a*dfzdra/d2fz*(1d0-z**4) - 4d0*ec_a*fz/d2fz*dzdra*z**3 & - + (decdra_f - decdra_p)*fz*z**4 + (ec_f - ec_p)*dfzdra*z**4 + 4d0*(ec_f - ec_p)*fz*dzdra*z**3 - - Fc(mu,nu,1) = Fc(mu,nu,1) + weight(iG)*AO(mu,iG)*AO(nu,iG)*(ec_z + decdra*r) - - end if - -! spin-down contribution - - if(rb > threshold) then - - rs = (4d0*pi*r/3d0)**(-1d0/3d0) - x = sqrt(rs) - - x_p = x*x + b_p*x + c_p - x_f = x*x + b_f*x + c_f - x_a = x*x + b_a*x + c_a - - xx0_p = x0_p*x0_p + b_p*x0_p + c_p - xx0_f = x0_f*x0_f + b_f*x0_f + c_f - xx0_a = x0_a*x0_a + b_a*x0_a + c_a - - q_p = sqrt(4d0*c_p - b_p*b_p) - q_f = sqrt(4d0*c_f - b_f*b_f) - q_a = sqrt(4d0*c_a - b_a*b_a) - - ec_p = a_p*( log(x**2/x_p) + 2d0*b_p/q_p*atan(q_p/(2d0*x + b_p)) & - - b_p*x0_p/xx0_p*( log((x - x0_p)**2/x_p) + 2d0*(b_p + 2d0*x0_p)/q_p*atan(q_p/(2d0*x + b_p)) ) ) - - ec_f = a_f*( log(x**2/x_f) + 2d0*b_f/q_f*atan(q_f/(2d0*x + b_f)) & - - b_f*x0_f/xx0_f*( log((x - x0_f)**2/x_f) + 2d0*(b_f + 2d0*x0_f)/q_f*atan(q_f/(2d0*x + b_f)) ) ) - - ec_a = a_a*( log(x**2/x_a) + 2d0*b_a/q_a*atan(q_a/(2d0*x + b_a)) & - - b_a*x0_a/xx0_a*( log((x - x0_a)**2/x_a) + 2d0*(b_a + 2d0*x0_a)/q_a*atan(q_a/(2d0*x + b_a)) ) ) - - ec_z = ec_p + ec_a*fz/d2fz*(1d0-z**4) + (ec_f - ec_p)*fz*z**4 - - dzdrb = - (1d0 + z)/r - dfzdz = (4d0/3d0)*((1d0 + z)**(1d0/3d0) - (1d0 - z)**(1d0/3d0))/(2d0*(2d0**(1d0/3d0) - 1d0)) - dfzdrb = dzdrb*dfzdz - - drsdrb = - (36d0*pi)**(-1d0/3d0)*r**(-4d0/3d0) - dxdrs = 0.5d0/sqrt(rs) - - dxdx_p = 2d0*x + b_p - dxdx_f = 2d0*x + b_f - dxdx_a = 2d0*x + b_a - - decdx_p = a_p*( 2d0/x - 4d0*b_p/( (b_p+2d0*x)**2 + q_p**2) - dxdx_p/x_p & - - b_p*x0_p/xx0_p*( 2/(x-x0_p) - 4d0*(b_p+2d0*x0_p)/( (b_p+2d0*x)**2 + q_p**2) - dxdx_p/x_p ) ) - - decdx_f = a_f*( 2d0/x - 4d0*b_f/( (b_f+2d0*x)**2 + q_f**2) - dxdx_f/x_f & - - b_f*x0_f/xx0_f*( 2/(x-x0_f) - 4d0*(b_f+2d0*x0_f)/( (b_f+2d0*x)**2 + q_f**2) - dxdx_f/x_f ) ) - - decdx_a = a_a*( 2d0/x - 4d0*b_a/( (b_a+2d0*x)**2 + q_a**2) - dxdx_a/x_a & - - b_a*x0_a/xx0_a*( 2/(x-x0_a) - 4d0*(b_a+2d0*x0_a)/( (b_a+2d0*x)**2 + q_a**2) - dxdx_a/x_a ) ) - - decdrb_p = drsdrb*dxdrs*decdx_p - decdrb_f = drsdrb*dxdrs*decdx_f - decdrb_a = drsdrb*dxdrs*decdx_a - - decdrb = decdrb_p + decdrb_a*fz/d2fz*(1d0-z**4) + ec_a*dfzdrb/d2fz*(1d0-z**4) - 4d0*ec_a*fz/d2fz*dzdrb*z**3 & - + (decdrb_f - decdrb_p)*fz*z**4 + (ec_f - ec_p)*dfzdrb*z**4 + 4d0*(ec_f - ec_p)*fz*dzdrb*z**3 - Fc(mu,nu,2) = Fc(mu,nu,2) + weight(iG)*AO(mu,iG)*AO(nu,iG)*(ec_z + decdrb*r) - - end if - - end do - end do - end do - -end subroutine VWN3_lda_correlation_potential diff --git a/src/eDFT/VWN5_lda_correlation_energy.f90 b/src/eDFT/VWN5_lda_correlation_energy.f90 deleted file mode 100644 index 4a6137e..0000000 --- a/src/eDFT/VWN5_lda_correlation_energy.f90 +++ /dev/null @@ -1,137 +0,0 @@ -subroutine VWN5_lda_correlation_energy(nGrid,weight,rho,Ec) - -! Compute unrestricted VWN5 LDA correlation energy - - implicit none - - include 'parameters.h' - -! Input variables - - integer,intent(in) :: nGrid - double precision,intent(in) :: weight(nGrid) - double precision,intent(in) :: rho(nGrid,nspin) - -! Local variables - - integer :: iG - double precision :: ra,rb,r,rs,x,z - double precision :: a_p,x0_p,xx0_p,b_p,c_p,x_p,q_p - double precision :: a_f,x0_f,xx0_f,b_f,c_f,x_f,q_f - double precision :: a_a,x0_a,xx0_a,b_a,c_a,x_a,q_a - - double precision :: ec_z,ec_p,ec_f,ec_a - double precision :: fz,d2fz - -! Output variables - - double precision :: Ec(nsp) - -! Parameters of the functional - - a_p = +0.0621814D0/2D0 - x0_p = -0.10498d0 - b_p = +3.72744d0 - c_p = +12.9352d0 - - a_f = +0.0621814D0/4D0 - x0_f = -0.325d0 - b_f = +7.06042d0 - c_f = +18.0578d0 - - a_a = -1d0/(6d0*pi**2) - x0_a = -0.0047584D0 - b_a = 1.13107d0 - c_a = 13.0045d0 - -! Initialization - - Ec(:) = 0d0 - - do iG=1,nGrid - - ra = max(0d0,rho(iG,1)) - rb = max(0d0,rho(iG,2)) - r = ra + rb - z = (ra - rb)/r - -! alpha-alpha contribution - - if(ra > threshold) then - - rs = (4d0*pi*ra/3d0)**(-1d0/3d0) - x = sqrt(rs) - - x_f = x*x + b_f*x + c_f - xx0_f = x0_f*x0_f + b_f*x0_f + c_f - q_f = sqrt(4d0*c_f - b_f*b_f) - - ec_f = a_f*( log(x**2/x_f) + 2d0*b_f/q_f*atan(q_f/(2d0*x + b_f)) & - - b_f*x0_f/xx0_f*( log((x - x0_f)**2/x_f) + 2d0*(b_f + 2d0*x0_f)/q_f*atan(q_f/(2d0*x + b_f)) ) ) - - Ec(1) = Ec(1) + weight(iG)*ec_f*ra - - end if - -! alpha-beta contribution - - if(r > threshold) then - - rs = (4d0*pi*r/3d0)**(-1d0/3d0) - x = sqrt(rs) - - fz = (1d0 + z)**(4d0/3d0) + (1d0 - z)**(4d0/3d0) - 2d0 - fz = fz/(2d0*(2d0**(1d0/3d0) - 1d0)) - - d2fz = 4d0/(9d0*(2**(1d0/3d0) - 1d0)) - - x_p = x*x + b_p*x + c_p - x_f = x*x + b_f*x + c_f - x_a = x*x + b_a*x + c_a - - xx0_p = x0_p*x0_p + b_p*x0_p + c_p - xx0_f = x0_f*x0_f + b_f*x0_f + c_f - xx0_a = x0_a*x0_a + b_a*x0_a + c_a - - q_p = sqrt(4d0*c_p - b_p*b_p) - q_f = sqrt(4d0*c_f - b_f*b_f) - q_a = sqrt(4d0*c_a - b_a*b_a) - - ec_p = a_p*( log(x**2/x_p) + 2d0*b_p/q_p*atan(q_p/(2d0*x + b_p)) & - - b_p*x0_p/xx0_p*( log((x - x0_p)**2/x_p) + 2d0*(b_p + 2d0*x0_p)/q_p*atan(q_p/(2d0*x + b_p)) ) ) - - ec_f = a_f*( log(x**2/x_f) + 2d0*b_f/q_f*atan(q_f/(2d0*x + b_f)) & - - b_f*x0_f/xx0_f*( log((x - x0_f)**2/x_f) + 2d0*(b_f + 2d0*x0_f)/q_f*atan(q_f/(2d0*x + b_f)) ) ) - - ec_a = a_a*( log(x**2/x_a) + 2d0*b_a/q_a*atan(q_a/(2d0*x + b_a)) & - - b_a*x0_a/xx0_a*( log((x - x0_a)**2/x_a) + 2d0*(b_a + 2d0*x0_a)/q_a*atan(q_a/(2d0*x + b_a)) ) ) - - ec_z = ec_p + ec_a*fz/d2fz*(1d0-z**4) + (ec_f - ec_p)*fz*z**4 - - Ec(2) = Ec(2) + weight(iG)*ec_z*r - - end if - -! beta-beta contribution - - if(rb > threshold) then - - rs = (4d0*pi*rb/3d0)**(-1d0/3d0) - x = sqrt(rs) - - x_f = x*x + b_f*x + c_f - xx0_f = x0_f*x0_f + b_f*x0_f + c_f - q_f = sqrt(4d0*c_f - b_f*b_f) - - ec_f = a_f*( log(x**2/x_f) + 2d0*b_f/q_f*atan(q_f/(2d0*x + b_f)) & - - b_f*x0_f/xx0_f*( log((x - x0_f)**2/x_f) + 2d0*(b_f + 2d0*x0_f)/q_f*atan(q_f/(2d0*x + b_f)) ) ) - - Ec(3) = Ec(3) + weight(iG)*ec_f*rb - - end if - - end do - - Ec(2) = Ec(2) - Ec(1) - Ec(3) - -end subroutine VWN5_lda_correlation_energy diff --git a/src/eDFT/VWN5_lda_correlation_individual_energy.f90 b/src/eDFT/VWN5_lda_correlation_individual_energy.f90 deleted file mode 100644 index d1330c0..0000000 --- a/src/eDFT/VWN5_lda_correlation_individual_energy.f90 +++ /dev/null @@ -1,184 +0,0 @@ -subroutine VWN5_lda_correlation_individual_energy(nEns,nGrid,weight,rhow,rho,LZc,Ec) - -! Compute VWN5 LDA correlation potential - - implicit none - - include 'parameters.h' - -! Input variables - - integer,intent(in) :: nEns - integer,intent(in) :: nGrid - double precision,intent(in) :: weight(nGrid) - double precision,intent(in) :: rhow(nGrid,nspin) - double precision,intent(in) :: rho(nGrid,nspin,nEns) - -! Local variables - - integer :: iG - integer :: iEns - double precision :: ra,rb,r,raI,rbI,rI,rs,x,z - double precision :: a_p,x0_p,xx0_p,b_p,c_p,x_p,q_p - double precision :: a_f,x0_f,xx0_f,b_f,c_f,x_f,q_f - double precision :: a_a,x0_a,xx0_a,b_a,c_a,x_a,q_a - double precision :: dfzdz,dxdrs,dxdx_p,dxdx_f,dxdx_a,decdx_p,decdx_f,decdx_a - double precision :: dzdra,dzdrb,dfzdra,dfzdrb,drsdr,decdr_p,decdr_f,decdr_a,decdra,decdrb - double precision :: ec_z,ec_p,ec_f,ec_a - double precision :: fz,d2fz - -! Output variables - - double precision,intent(out) :: LZc(nsp) - double precision,intent(out) :: Ec(nsp,nEns) - -! Parameters of the functional - - a_p = +0.0621814d0/2d0 - x0_p = -0.10498d0 - b_p = +3.72744d0 - c_p = +12.9352d0 - - a_f = +0.0621814d0/4d0 - x0_f = -0.325d0 - b_f = +7.06042d0 - c_f = +18.0578d0 - - a_a = -1d0/(6d0*pi**2) - x0_a = -0.0047584d0 - b_a = +1.13107d0 - c_a = +13.0045d0 - -! Initialization - - LZc(:) = 0d0 - Ec(:,:) = 0d0 - - do iG=1,nGrid - - ra = max(0d0,rhow(iG,1)) - rb = max(0d0,rhow(iG,2)) - - r = ra + rb - -! up-down contribution - - if(r > threshold) then - - rs = (4d0*pi*r/3d0)**(-1d0/3d0) - z = (ra - rb)/r - x = sqrt(rs) - - fz = (1d0 + z)**(4d0/3d0) + (1d0 - z)**(4d0/3d0) - 2d0 - fz = fz/(2d0*(2d0**(1d0/3d0) - 1d0)) - - d2fz = 4d0/(9d0*(2**(1d0/3d0) - 1d0)) - - x_p = x*x + b_p*x + c_p - x_f = x*x + b_f*x + c_f - x_a = x*x + b_a*x + c_a - - xx0_p = x0_p*x0_p + b_p*x0_p + c_p - xx0_f = x0_f*x0_f + b_f*x0_f + c_f - xx0_a = x0_a*x0_a + b_a*x0_a + c_a - - q_p = sqrt(4d0*c_p - b_p*b_p) - q_f = sqrt(4d0*c_f - b_f*b_f) - q_a = sqrt(4d0*c_a - b_a*b_a) - - ec_p = a_p*( log(x**2/x_p) + 2d0*b_p/q_p*atan(q_p/(2d0*x + b_p)) & - - b_p*x0_p/xx0_p*( log((x - x0_p)**2/x_p) + 2d0*(b_p + 2d0*x0_p)/q_p*atan(q_p/(2d0*x + b_p)) ) ) - - ec_f = a_f*( log(x**2/x_f) + 2d0*b_f/q_f*atan(q_f/(2d0*x + b_f)) & - - b_f*x0_f/xx0_f*( log((x - x0_f)**2/x_f) + 2d0*(b_f + 2d0*x0_f)/q_f*atan(q_f/(2d0*x + b_f)) ) ) - - ec_a = a_a*( log(x**2/x_a) + 2d0*b_a/q_a*atan(q_a/(2d0*x + b_a)) & - - b_a*x0_a/xx0_a*( log((x - x0_a)**2/x_a) + 2d0*(b_a + 2d0*x0_a)/q_a*atan(q_a/(2d0*x + b_a)) ) ) - - ec_z = ec_p + ec_a*fz/d2fz*(1d0 - z**4) + (ec_f - ec_p)*fz*z**4 - - dfzdz = (4d0/3d0)*((1d0 + z)**(1d0/3d0) - (1d0 - z)**(1d0/3d0))/(2d0*(2d0**(1d0/3d0) - 1d0)) - - drsdr = - (36d0*pi)**(-1d0/3d0)*r**(-4d0/3d0) - dxdrs = 0.5d0/sqrt(rs) - - dxdx_p = 2d0*x + b_p - dxdx_f = 2d0*x + b_f - dxdx_a = 2d0*x + b_a - - decdx_p = a_p*( 2d0/x - 4d0*b_p/( (b_p+2d0*x)**2 + q_p**2) - dxdx_p/x_p & - - b_p*x0_p/xx0_p*( 2d0/(x-x0_p) - 4d0*(b_p+2d0*x0_p)/( (b_p+2d0*x)**2 + q_p**2) - dxdx_p/x_p ) ) - - decdx_f = a_f*( 2d0/x - 4d0*b_f/( (b_f+2d0*x)**2 + q_f**2) - dxdx_f/x_f & - - b_f*x0_f/xx0_f*( 2d0/(x-x0_f) - 4d0*(b_f+2d0*x0_f)/( (b_f+2d0*x)**2 + q_f**2) - dxdx_f/x_f ) ) - - decdx_a = a_a*( 2d0/x - 4d0*b_a/( (b_a+2d0*x)**2 + q_a**2) - dxdx_a/x_a & - - b_a*x0_a/xx0_a*( 2d0/(x-x0_a) - 4d0*(b_a+2d0*x0_a)/( (b_a+2d0*x)**2 + q_a**2) - dxdx_a/x_a ) ) - - decdr_p = drsdr*dxdrs*decdx_p - decdr_f = drsdr*dxdrs*decdx_f - decdr_a = drsdr*dxdrs*decdx_a - - dzdra = + (1d0 - z)/r - dfzdra = dzdra*dfzdz - - decdra = decdr_p + decdr_a*fz/d2fz*(1d0-z**4) + ec_a*dfzdra/d2fz*(1d0-z**4) - 4d0*ec_a*fz/d2fz*dzdra*z**3 & - + (decdr_f - decdr_p)*fz*z**4 + (ec_f - ec_p)*dfzdra*z**4 + 4d0*(ec_f - ec_p)*fz*dzdra*z**3 - - dzdrb = - (1d0 + z)/r - dfzdrb = dzdrb*dfzdz - - decdrb = decdr_p + decdr_a*fz/d2fz*(1d0-z**4) + ec_a*dfzdrb/d2fz*(1d0-z**4) - 4d0*ec_a*fz/d2fz*dzdrb*z**3 & - + (decdr_f - decdr_p)*fz*z**4 + (ec_f - ec_p)*dfzdrb*z**4 + 4d0*(ec_f - ec_p)*fz*dzdrb*z**3 - - ! spin-up contribution - - if(ra > threshold) then - - LZc(1) = LZc(1) - weight(iG)*decdra*ra*ra - - do iEns=1,nEns - - raI = max(0d0,rho(iG,1,iEns)) - - if(raI > threshold) then - - Ec(1,iEns) = Ec(1,iEns) + weight(iG)*(ec_z + decdra*ra)*raI - if(rb > threshold) Ec(2,iEns) = Ec(2,iEns) + weight(iG)*decdra*rb*raI - - end if - - end do - - end if - - ! up-down contribution - - if(ra > threshold .and. rb > threshold) LZc(2) = LZc(2) -weight(iG)*(decdra + decdrb)*ra*rb - - ! spin-down contribution - - if(rb > threshold) then - - LZc(3) = LZc(3) - weight(iG)*decdrb*rb*rb - - do iEns=1,nEns - - rbI = max(0d0,rho(iG,2,iEns)) - - if(rbI > threshold) then - - Ec(3,iEns) = Ec(3,iEns) + weight(iG)*(ec_z + decdrb*rb)*rbI - if(ra > threshold) Ec(2,iEns) = Ec(2,iEns) + weight(iG)*decdrb*ra*rbI - - end if - - end do - - end if - - end if - - end do - -end subroutine VWN5_lda_correlation_individual_energy diff --git a/src/eDFT/VWN5_lda_correlation_potential.f90 b/src/eDFT/VWN5_lda_correlation_potential.f90 deleted file mode 100644 index 48d6518..0000000 --- a/src/eDFT/VWN5_lda_correlation_potential.f90 +++ /dev/null @@ -1,193 +0,0 @@ -subroutine VWN5_lda_correlation_potential(nGrid,weight,nBas,AO,rho,Fc) - -! Compute unrestricted VWN5 LDA correlation potential - - implicit none - - include 'parameters.h' - -! Input variables - - integer,intent(in) :: nGrid - double precision,intent(in) :: weight(nGrid) - integer,intent(in) :: nBas - double precision,intent(in) :: AO(nBas,nGrid) - double precision,intent(in) :: rho(nGrid,nspin) - -! Local variables - - integer :: mu,nu,iG - double precision :: ra,rb,r,rs,x,z - double precision :: a_p,x0_p,xx0_p,b_p,c_p,x_p,q_p - double precision :: a_f,x0_f,xx0_f,b_f,c_f,x_f,q_f - double precision :: a_a,x0_a,xx0_a,b_a,c_a,x_a,q_a - double precision :: dfzdz,dxdrs,dxdx_p,dxdx_f,dxdx_a,decdx_p,decdx_f,decdx_a - double precision :: dzdra,dfzdra,drsdra,decdra_p,decdra_f,decdra_a,decdra - double precision :: dzdrb,dfzdrb,drsdrb,decdrb_p,decdrb_f,decdrb_a,decdrb - - double precision :: ec_z,ec_p,ec_f,ec_a - double precision :: fz,d2fz - -! Output variables - - double precision :: Fc(nBas,nBas,nspin) - -! Parameters of the functional - - a_p = +0.0621814D0/2d0 - x0_p = -0.10498d0 - b_p = +3.72744d0 - c_p = +12.9352d0 - - a_f = +0.0621814D0/4D0 - x0_f = -0.325d0 - b_f = +7.06042d0 - c_f = +18.0578d0 - - a_a = -1d0/(6d0*pi**2) - x0_a = -0.0047584D0 - b_a = +1.13107d0 - c_a = +13.0045d0 - -! Initialization - - Fc(:,:,:) = 0d0 - - do mu=1,nBas - do nu=1,nBas - do iG=1,nGrid - - ra = max(0d0,rho(iG,1)) - rb = max(0d0,rho(iG,2)) - r = ra + rb - z = (ra - rb)/r - - rs = (4d0*pi*r/3d0)**(-1d0/3d0) - x = sqrt(rs) - - fz = (1d0 + z)**(4d0/3d0) + (1d0 - z)**(4d0/3d0) - 2d0 - fz = fz/(2d0*(2d0**(1d0/3d0) - 1d0)) - - d2fz = 4d0/(9d0*(2**(1d0/3d0) - 1d0)) - -! spin-up contribution - - if(ra > threshold) then - - x_p = x*x + b_p*x + c_p - x_f = x*x + b_f*x + c_f - x_a = x*x + b_a*x + c_a - - xx0_p = x0_p*x0_p + b_p*x0_p + c_p - xx0_f = x0_f*x0_f + b_f*x0_f + c_f - xx0_a = x0_a*x0_a + b_a*x0_a + c_a - - q_p = sqrt(4d0*c_p - b_p*b_p) - q_f = sqrt(4d0*c_f - b_f*b_f) - q_a = sqrt(4d0*c_a - b_a*b_a) - - ec_p = a_p*( log(x**2/x_p) + 2d0*b_p/q_p*atan(q_p/(2d0*x + b_p)) & - - b_p*x0_p/xx0_p*( log((x - x0_p)**2/x_p) + 2d0*(b_p + 2d0*x0_p)/q_p*atan(q_p/(2d0*x + b_p)) ) ) - - ec_f = a_f*( log(x**2/x_f) + 2d0*b_f/q_f*atan(q_f/(2d0*x + b_f)) & - - b_f*x0_f/xx0_f*( log((x - x0_f)**2/x_f) + 2d0*(b_f + 2d0*x0_f)/q_f*atan(q_f/(2d0*x + b_f)) ) ) - - ec_a = a_a*( log(x**2/x_a) + 2d0*b_a/q_a*atan(q_a/(2d0*x + b_a)) & - - b_a*x0_a/xx0_a*( log((x - x0_a)**2/x_a) + 2d0*(b_a + 2d0*x0_a)/q_a*atan(q_a/(2d0*x + b_a)) ) ) - - ec_z = ec_p + ec_a*fz/d2fz*(1d0-z**4) + (ec_f - ec_p)*fz*z**4 - - dzdra = + (1d0 - z)/r - dfzdz = (4d0/3d0)*((1d0 + z)**(1d0/3d0) - (1d0 - z)**(1d0/3d0))/(2d0*(2d0**(1d0/3d0) - 1d0)) - dfzdra = dzdra*dfzdz - - drsdra = - (36d0*pi)**(-1d0/3d0)*r**(-4d0/3d0) - dxdrs = 0.5d0/sqrt(rs) - - dxdx_p = 2d0*x + b_p - dxdx_f = 2d0*x + b_f - dxdx_a = 2d0*x + b_a - - decdx_p = a_p*( 2d0/x - 4d0*b_p/( (b_p+2d0*x)**2 + q_p**2) - dxdx_p/x_p & - - b_p*x0_p/xx0_p*( 2d0/(x-x0_p) - 4d0*(b_p+2d0*x0_p)/( (b_p+2d0*x)**2 + q_p**2) - dxdx_p/x_p ) ) - - decdx_f = a_f*( 2d0/x - 4d0*b_f/( (b_f+2d0*x)**2 + q_f**2) - dxdx_f/x_f & - - b_f*x0_f/xx0_f*( 2d0/(x-x0_f) - 4d0*(b_f+2d0*x0_f)/( (b_f+2d0*x)**2 + q_f**2) - dxdx_f/x_f ) ) - - decdx_a = a_a*( 2d0/x - 4d0*b_a/( (b_a+2d0*x)**2 + q_a**2) - dxdx_a/x_a & - - b_a*x0_a/xx0_a*( 2d0/(x-x0_a) - 4d0*(b_a+2d0*x0_a)/( (b_a+2d0*x)**2 + q_a**2) - dxdx_a/x_a ) ) - - decdra_p = drsdra*dxdrs*decdx_p - decdra_f = drsdra*dxdrs*decdx_f - decdra_a = drsdra*dxdrs*decdx_a - - decdra = decdra_p + decdra_a*fz/d2fz*(1d0-z**4) + ec_a*dfzdra/d2fz*(1d0-z**4) - 4d0*ec_a*fz/d2fz*dzdra*z**3 & - + (decdra_f - decdra_p)*fz*z**4 + (ec_f - ec_p)*dfzdra*z**4 + 4d0*(ec_f - ec_p)*fz*dzdra*z**3 - - Fc(mu,nu,1) = Fc(mu,nu,1) + weight(iG)*AO(mu,iG)*AO(nu,iG)*(ec_z + decdra*r) - - end if - -! spin-down contribution - - if(rb > threshold) then - - x_p = x*x + b_p*x + c_p - x_f = x*x + b_f*x + c_f - x_a = x*x + b_a*x + c_a - - xx0_p = x0_p*x0_p + b_p*x0_p + c_p - xx0_f = x0_f*x0_f + b_f*x0_f + c_f - xx0_a = x0_a*x0_a + b_a*x0_a + c_a - - q_p = sqrt(4d0*c_p - b_p*b_p) - q_f = sqrt(4d0*c_f - b_f*b_f) - q_a = sqrt(4d0*c_a - b_a*b_a) - - ec_p = a_p*( log(x**2/x_p) + 2d0*b_p/q_p*atan(q_p/(2d0*x + b_p)) & - - b_p*x0_p/xx0_p*( log((x - x0_p)**2/x_p) + 2d0*(b_p + 2d0*x0_p)/q_p*atan(q_p/(2d0*x + b_p)) ) ) - - ec_f = a_f*( log(x**2/x_f) + 2d0*b_f/q_f*atan(q_f/(2d0*x + b_f)) & - - b_f*x0_f/xx0_f*( log((x - x0_f)**2/x_f) + 2d0*(b_f + 2d0*x0_f)/q_f*atan(q_f/(2d0*x + b_f)) ) ) - - ec_a = a_a*( log(x**2/x_a) + 2d0*b_a/q_a*atan(q_a/(2d0*x + b_a)) & - - b_a*x0_a/xx0_a*( log((x - x0_a)**2/x_a) + 2d0*(b_a + 2d0*x0_a)/q_a*atan(q_a/(2d0*x + b_a)) ) ) - - ec_z = ec_p + ec_a*fz/d2fz*(1d0-z**4) + (ec_f - ec_p)*fz*z**4 - - dzdrb = - (1d0 + z)/r - dfzdz = (4d0/3d0)*((1d0 + z)**(1d0/3d0) - (1d0 - z)**(1d0/3d0))/(2d0*(2d0**(1d0/3d0) - 1d0)) - dfzdrb = dzdrb*dfzdz - - drsdrb = - (36d0*pi)**(-1d0/3d0)*r**(-4d0/3d0) - dxdrs = 0.5d0/sqrt(rs) - - dxdx_p = 2d0*x + b_p - dxdx_f = 2d0*x + b_f - dxdx_a = 2d0*x + b_a - - decdx_p = a_p*( 2d0/x - 4d0*b_p/( (b_p+2d0*x)**2 + q_p**2) - dxdx_p/x_p & - - b_p*x0_p/xx0_p*( 2d0/(x-x0_p) - 4d0*(b_p+2d0*x0_p)/( (b_p+2d0*x)**2 + q_p**2) - dxdx_p/x_p ) ) - - decdx_f = a_f*( 2d0/x - 4d0*b_f/( (b_f+2d0*x)**2 + q_f**2) - dxdx_f/x_f & - - b_f*x0_f/xx0_f*( 2d0/(x-x0_f) - 4d0*(b_f+2d0*x0_f)/( (b_f+2d0*x)**2 + q_f**2) - dxdx_f/x_f ) ) - - decdx_a = a_a*( 2d0/x - 4d0*b_a/( (b_a+2d0*x)**2 + q_a**2) - dxdx_a/x_a & - - b_a*x0_a/xx0_a*( 2d0/(x-x0_a) - 4d0*(b_a+2d0*x0_a)/( (b_a+2d0*x)**2 + q_a**2) - dxdx_a/x_a ) ) - - decdrb_p = drsdrb*dxdrs*decdx_p - decdrb_f = drsdrb*dxdrs*decdx_f - decdrb_a = drsdrb*dxdrs*decdx_a - - decdrb = decdrb_p + decdrb_a*fz/d2fz*(1d0-z**4) + ec_a*dfzdrb/d2fz*(1d0-z**4) - 4d0*ec_a*fz/d2fz*dzdrb*z**3 & - + (decdrb_f - decdrb_p)*fz*z**4 + (ec_f - ec_p)*dfzdrb*z**4 + 4d0*(ec_f - ec_p)*fz*dzdrb*z**3 - - Fc(mu,nu,2) = Fc(mu,nu,2) + weight(iG)*AO(mu,iG)*AO(nu,iG)*(ec_z + decdrb*r) - - end if - - end do - end do - end do - -end subroutine VWN5_lda_correlation_potential diff --git a/src/eDFT/W38_lda_correlation_energy.f90 b/src/eDFT/W38_lda_correlation_energy.f90 deleted file mode 100644 index 4b97f23..0000000 --- a/src/eDFT/W38_lda_correlation_energy.f90 +++ /dev/null @@ -1,52 +0,0 @@ -subroutine W38_lda_correlation_energy(nGrid,weight,rho,Ec) - -! Compute the unrestricted version of the Wigner's LDA correlation energy - - implicit none - include 'parameters.h' - -! Input variables - - integer,intent(in) :: nGrid - double precision,intent(in) :: weight(nGrid) - double precision,intent(in) :: rho(nGrid,nspin) - -! Local variables - - integer :: iG - double precision :: ra,rb,r - double precision :: a,d,epsc - -! Output variables - - double precision :: Ec(nsp) - -! Coefficients for Wigner's LDA correlation - - a = 0.04918d0 - d = 0.349d0 - -! Compute LDA correlation energy - - Ec(:) = 0d0 - - do iG=1,nGrid - - ra = max(0d0,rho(iG,1)) - rb = max(0d0,rho(iG,2)) - - if(ra > threshold .or. rb > threshold) then - - r = ra + rb - - epsc = ra*rb/(r + d*r**(2d0/3d0)) - - Ec(2) = Ec(2) + weight(iG)*epsc - - endif - - enddo - - Ec(2) = -4d0*a*Ec(2) - -end subroutine W38_lda_correlation_energy diff --git a/src/eDFT/W38_lda_correlation_individual_energy.f90 b/src/eDFT/W38_lda_correlation_individual_energy.f90 deleted file mode 100644 index 2973185..0000000 --- a/src/eDFT/W38_lda_correlation_individual_energy.f90 +++ /dev/null @@ -1,62 +0,0 @@ -subroutine W38_lda_correlation_individual_energy(nGrid,weight,rhow,rho,Ec) - -! Compute the unrestricted version of the Wigner's LDA individual energy - - implicit none - - include 'parameters.h' - -! Input variables - - integer,intent(in) :: nGrid - double precision,intent(in) :: weight(nGrid) - double precision,intent(in) :: rhow(nGrid,nspin) - double precision,intent(in) :: rho(nGrid,nspin) - -! Local variables - - integer :: iG - double precision :: ra,rb,r - double precision :: raI,rbI,rI - double precision :: a,d,epsc - double precision :: dFcdra,dFcdrb - -! Output variables - - double precision,intent(out) :: Ec(nsp) - -! Coefficients for Wigner's LDA correlation - - a = 0.04918d0 - d = 0.349d0 - -! Compute LDA correlation individual energy - - Ec(:) = 0d0 - - do iG=1,nGrid - - ra = max(0d0,rhow(iG,1)) - rb = max(0d0,rhow(iG,2)) - - raI = max(0d0,rho(iG,1)) - rbI = max(0d0,rho(iG,2)) - - r = ra + rb - rI = raI + rbI - - if(r > threshold .or. rI > threshold) then - - epsc = ra*rb/(r + d*r**(2d0/3d0)) - dFcdra = epsc*(d/(3d0*r**(4d0/3d0)*(1d0 + d*r**(-1d0/3d0))) - 1d0/r + 1d0/ra) - dFcdrb = epsc*(d/(3d0*r**(4d0/3d0)*(1d0 + d*r**(-1d0/3d0))) - 1d0/r + 1d0/rb) - - Ec(2) = Ec(2) + weight(iG)*rI*0.5d0*(dFcdra + dFcdrb) - - endif - - enddo - - Ec(2) = -4d0*a*Ec(2) - -end subroutine W38_lda_correlation_individual_energy diff --git a/src/eDFT/W38_lda_correlation_potential.f90 b/src/eDFT/W38_lda_correlation_potential.f90 deleted file mode 100644 index 5e7a865..0000000 --- a/src/eDFT/W38_lda_correlation_potential.f90 +++ /dev/null @@ -1,76 +0,0 @@ -subroutine W38_lda_correlation_potential(nGrid,weight,nBas,AO,rho,Fc) - -! Compute the unrestricted version of the Wigner's LDA correlation potential - - implicit none -include 'parameters.h' - -! Input variables - - integer,intent(in) :: nGrid - double precision,intent(in) :: weight(nGrid) - integer,intent(in) :: nBas - double precision,intent(in) :: AO(nBas,nGrid) - double precision,intent(in) :: rho(nGrid,nspin) - -! Local variables - - integer :: mu,nu,iG - double precision :: ra,rb,r - double precision :: a,d,ec - double precision :: dFcdr - -! Output variables - - double precision,intent(out) :: Fc(nBas,nBas,nspin) - -! Coefficients for Wigner's LDA correlation - - a = 0.04918d0 - d = 0.349d0 - -! Compute LDA correlation matrix in the AO basis - - Fc(:,:,:) = 0d0 - - do mu=1,nBas - do nu=1,nBas - do iG=1,nGrid - - ra = max(0d0,rho(iG,1)) - rb = max(0d0,rho(iG,2)) - -! Spin-up part contribution - - if(ra > threshold) then - - r = ra + rb - - ec = ra*rb/(r + d*r**(2d0/3d0)) - dFcdr = ec*(d/(3d0*r**(4d0/3d0)*(1d0 + d*r**(-1d0/3d0))) - 1d0/r + 1d0/ra) - - Fc(mu,nu,1) = Fc(mu,nu,1) + weight(iG)*AO(mu,iG)*AO(nu,iG)*dFcdr - - endif - -! Spin-down part contribution - - if(rb > threshold) then - - r = ra + rb - - ec = ra*rb/(r + d*r**(2d0/3d0)) - dFcdr = ec*(d/(3d0*r**(4d0/3d0)*(1d0 + d*r**(-1d0/3d0))) - 1d0/r + 1d0/rb) - - Fc(mu,nu,2) = Fc(mu,nu,2) + weight(iG)*AO(mu,iG)*AO(nu,iG)*dFcdr - - endif - - enddo - - enddo - enddo - - Fc(:,:,:) = -4d0*a*Fc(:,:,:) - -end subroutine W38_lda_correlation_potential diff --git a/src/eDFT/allocate_grid.f90 b/src/eDFT/allocate_grid.f90 deleted file mode 100644 index 9bd50d4..0000000 --- a/src/eDFT/allocate_grid.f90 +++ /dev/null @@ -1,57 +0,0 @@ -subroutine allocate_grid(nNuc,ZNuc,max_ang_mom,min_exponent,max_exponent,radial_precision,nAng,nGrid) - -! Allocate quadrature grid with numgrid (Radovan Bast) - - use numgrid - use, intrinsic :: iso_c_binding, only: c_ptr - - implicit none - include 'parameters.h' - -! Input variables - - integer,intent(in) :: nNuc - double precision,intent(in) :: ZNuc(nNuc) - - integer,intent(in) :: max_ang_mom(nNuc) - double precision,intent(in) :: min_exponent(nNuc,maxL+1) - double precision,intent(in) :: max_exponent(nNuc) - - double precision :: radial_precision - integer,intent(in) :: nAng - -! Local variables - - integer :: iNuc - - integer :: min_num_angular_points - integer :: max_num_angular_points - - type(c_ptr) :: context - -! Output variables - - integer,intent(out) :: nGrid - -! Set useful variables - - min_num_angular_points = nAng - max_num_angular_points = nAng - -! Get total number of grid points - - nGrid = 0 - - do iNuc=1,nNuc - - context = numgrid_new_atom_grid(radial_precision,min_num_angular_points,max_num_angular_points, & - int(ZNuc(iNuc)),max_exponent(iNuc),max_ang_mom(iNuc), & - min_exponent(iNuc,1:max_ang_mom(iNuc)+1)) - - nGrid = nGrid + numgrid_get_num_grid_points(context) - - call numgrid_free_atom_grid(context) - - end do - -end subroutine allocate_grid diff --git a/src/eDFT/auxiliary_energy.f90 b/src/eDFT/auxiliary_energy.f90 deleted file mode 100644 index a5060f6..0000000 --- a/src/eDFT/auxiliary_energy.f90 +++ /dev/null @@ -1,55 +0,0 @@ -subroutine auxiliary_energy(nBas,nEns,eps,occnum,Eaux) - -! Compute the auxiliary KS energies - - implicit none - - include 'parameters.h' - -! Input variables - - integer,intent(in) :: nBas - integer,intent(in) :: nEns - double precision,intent(in) :: eps(nBas,nspin) - double precision,intent(in) :: occnum(nBas,nspin,nEns) - -! Local variables - - integer :: iEns,iBas - integer :: ispin - integer :: p - double precision,allocatable :: nEl(:) - - -! Output variables - - double precision,intent(out) :: Eaux(nspin,nEns) - -! Memory allocation - - allocate(nEl(nEns)) - -! Compute the number of electrons - - nEl(:) = 0d0 - do iEns=1,nEns - do iBas=1,nBas - nEl(iEns) = nEl(iEns) + occnum(iBas,1,iEns) + occnum(iBas,2,iEns) - end do - end do - -! Compute auxiliary energies for each state of the ensemble based on occupation numbers - - Eaux(:,:) = 0d0 - do iEns=1,nEns - do ispin=1,nspin - do p=1,nBas - - Eaux(ispin,iEns) = Eaux(ispin,iEns) + occnum(p,ispin,iEns)*eps(p,ispin) - - end do - end do - - end do - -end subroutine auxiliary_energy diff --git a/src/eDFT/build_grid.f90 b/src/eDFT/build_grid.f90 deleted file mode 100644 index c255231..0000000 --- a/src/eDFT/build_grid.f90 +++ /dev/null @@ -1,107 +0,0 @@ -subroutine build_grid(nNuc,ZNuc,rNuc,max_ang_mom,min_exponent,max_exponent, & - radial_precision,nRad,nAng,nGrid,weight,root) - -! Compute quadrature grid with numgrid (Radovan Bast) - - use numgrid - use, intrinsic :: iso_c_binding, only: c_ptr - - implicit none - include 'parameters.h' - -! Input variables - - integer,intent(in) :: nNuc - double precision,intent(in) :: ZNuc(nNuc) - double precision,intent(in) :: rNuc(nNuc,ncart) - - integer,intent(in) :: max_ang_mom(nNuc) - double precision,intent(in) :: min_exponent(nNuc,maxL+1) - double precision,intent(in) :: max_exponent(nNuc) - - double precision,intent(in) :: radial_precision - integer,intent(in) :: nAng - integer,intent(in) :: nGrid - -! Local variables - - logical :: dump_grid = .false. - integer :: iNuc - integer :: iG - - integer :: min_num_angular_points - integer :: max_num_angular_points - integer :: num_points - integer :: num_radial_points - - integer :: center_index - type(c_ptr) :: context - -! Output variables - - integer,intent(out) :: nRad - double precision,intent(out) :: root(ncart,nGrid) - double precision,intent(out) :: weight(nGrid) - -! Set useful variables - - min_num_angular_points = nAng - max_num_angular_points = nAng - -!------------------------------------------------------------------------ -! Main loop over atoms -!------------------------------------------------------------------------ - - iG = 0 - nRad = 0 - - do iNuc=1,nNuc - - context = numgrid_new_atom_grid(radial_precision,min_num_angular_points,max_num_angular_points, & - int(ZNuc(iNuc)),max_exponent(iNuc),max_ang_mom(iNuc), & - min_exponent(iNuc,1:max_ang_mom(iNuc)+1)) - - center_index = iNuc - 1 - num_points = numgrid_get_num_grid_points(context) - num_radial_points = numgrid_get_num_radial_grid_points(context) - - - call numgrid_get_grid(context,nNuc,center_index,rNuc(:,1),rNuc(:,2),rNuc(:,3),int(ZNuc(:)), & - root(1,iG+1:iG+num_points),root(2,iG+1:iG+num_points),root(3,iG+1:iG+num_points), & - weight(iG+1:iG+num_points)) - - iG = iG + num_points - nRad = nRad + num_radial_points - - call numgrid_free_atom_grid(context) - - end do - -!------------------------------------------------------------------------ -! End main loop over atoms -!------------------------------------------------------------------------ - -! Print grid - - write(*,*) - write(*,'(A30,E10.1)') 'Radial precision = ',radial_precision - write(*,'(A30,I10)') 'Number of radial points = ',nRad - write(*,'(A30,I10)') 'Number of angular points = ',nAng - write(*,'(A30,I10)') 'Total number of points = ',nGrid - write(*,*) - - if(dump_grid) then - - write(*,*) ' ***********************' - write(*,*) ' *** QUADRATURE GRID ***' - write(*,*) ' ***********************' - - write(*,'(A10,3X,3A15)') 'Grid point','X','Y','Z' - do iG=1,nGrid - write(*,'(I10,3X,4F15.10)') iG,weight(iG),root(:,iG) - end do - write(*,*) - - end if - -end subroutine build_grid diff --git a/src/eDFT/correlation_derivative_discontinuity.f90 b/src/eDFT/correlation_derivative_discontinuity.f90 deleted file mode 100644 index 9bcd1bf..0000000 --- a/src/eDFT/correlation_derivative_discontinuity.f90 +++ /dev/null @@ -1,59 +0,0 @@ -subroutine correlation_derivative_discontinuity(rung,DFA,nEns,wEns,nGrid,weight,rhow,drhow,Ec) - -! Compute the correlation part of the derivative discontinuity - - implicit none - include 'parameters.h' - -! Input variables - - integer,intent(in) :: rung - integer,intent(in) :: DFA - integer,intent(in) :: nEns - double precision,intent(in) :: wEns(nEns) - integer,intent(in) :: nGrid - double precision,intent(in) :: weight(nGrid) - double precision,intent(in) :: rhow(nGrid,nspin) - double precision,intent(in) :: drhow(ncart,nGrid,nspin) - -! Local variables - -! Output variables - - double precision,intent(out) :: Ec(nsp,nEns) - - select case (rung) - -! Hartree calculation - - case(0) - - Ec(:,:) = 0d0 - -! LDA functionals - - case(1) - - call lda_correlation_derivative_discontinuity(DFA,nEns,wEns,nGrid,weight,rhow,Ec) - -! GGA functionals - - case(2) - - call gga_correlation_derivative_discontinuity(DFA,nEns,wEns,nGrid,weight,rhow,Ec) - -! MGGA functionals - - case(3) - - call mgga_correlation_derivative_discontinuity(DFA,nEns,wEns,nGrid,weight,rhow,Ec) - -! Hybrid functionals - - case(4) - - call hybrid_correlation_derivative_discontinuity(DFA,nEns,wEns,nGrid,weight,rhow,Ec) - - end select - -end subroutine correlation_derivative_discontinuity diff --git a/src/eDFT/correlation_energy.f90 b/src/eDFT/correlation_energy.f90 deleted file mode 100644 index 4763db3..0000000 --- a/src/eDFT/correlation_energy.f90 +++ /dev/null @@ -1,59 +0,0 @@ -subroutine correlation_energy(rung,DFA,nEns,wEns,nGrid,weight,rho,drho,Ec) - -! Compute the unrestricted version of the correlation energy - - implicit none - include 'parameters.h' - -! Input variables - - integer,intent(in) :: rung - integer,intent(in) :: DFA - integer,intent(in) :: nEns - double precision,intent(in) :: wEns(nEns) - integer,intent(in) :: nGrid - double precision,intent(in) :: weight(nGrid) - double precision,intent(in) :: rho(nGrid,nspin) - double precision,intent(in) :: drho(ncart,nGrid,nspin) - -! Local variables - -! Output variables - - double precision,intent(out) :: Ec(nsp) - - select case (rung) - -! Hartree calculation - - case(0) - - Ec(:) = 0d0 - -! LDA functionals - - case(1) - - call lda_correlation_energy(DFA,nEns,wEns,nGrid,weight,rho,Ec) - -! GGA functionals - - case(2) - - call gga_correlation_energy(DFA,nEns,wEns,nGrid,weight,rho,drho,Ec) - -! MGGA functionals - - case(3) - - call mgga_correlation_energy(DFA,nEns,wEns,nGrid,weight,rho,drho,Ec) - -! Hybrid functionals - - case(4) - - call hybrid_correlation_energy(DFA,nEns,wEns,nGrid,weight,rho,drho,Ec) - - end select - -end subroutine correlation_energy diff --git a/src/eDFT/correlation_individual_energy.f90 b/src/eDFT/correlation_individual_energy.f90 deleted file mode 100644 index 074870e..0000000 --- a/src/eDFT/correlation_individual_energy.f90 +++ /dev/null @@ -1,62 +0,0 @@ -subroutine correlation_individual_energy(rung,DFA,LDA_centered,nEns,wEns,nGrid,weight, & - rhow,drhow,rho,drho,LZc,Ec) - -! Compute the correlation energy of individual states - - implicit none - include 'parameters.h' - -! Input variables - - integer,intent(in) :: rung - integer,intent(in) :: DFA - logical,intent(in) :: LDA_centered - integer,intent(in) :: nEns - double precision,intent(in) :: wEns(nEns) - integer,intent(in) :: nGrid - double precision,intent(in) :: weight(nGrid) - double precision,intent(in) :: rhow(nGrid,nspin) - double precision,intent(in) :: drhow(ncart,nGrid,nspin) - double precision,intent(in) :: rho(nGrid,nspin,nEns) - double precision,intent(in) :: drho(ncart,nGrid,nspin,nEns) - -! Output variables - - double precision,intent(out) :: LZc(nsp) - double precision,intent(out) :: Ec(nsp,nEns) - - select case (rung) - -! Hartree calculation - - case(0) - - LZc(:) = 0d0 - -! LDA functionals - - case(1) - - call lda_correlation_individual_energy(DFA,LDA_centered,nEns,wEns,nGrid,weight,rhow,rho,LZc,Ec) - -! GGA functionals - - case(2) - - call print_warning('!!! Individual energies NYI for GGAs !!!') - -! MGGA functionals - - case(3) - - call print_warning('!!! Individual energies NYI for MGGAs !!!') - -! Hybrid functionals - - case(4) - - call hybrid_correlation_individual_energy(DFA,nEns,wEns,nGrid,weight,rhow,drhow,rho,drho,LZc,Ec) - - end select - -end subroutine correlation_individual_energy diff --git a/src/eDFT/correlation_potential.f90 b/src/eDFT/correlation_potential.f90 deleted file mode 100644 index 5e1256b..0000000 --- a/src/eDFT/correlation_potential.f90 +++ /dev/null @@ -1,68 +0,0 @@ -subroutine correlation_potential(rung,DFA,nEns,wEns,nGrid,weight,nBas,AO,dAO,rho,drho,Fc) - -! Compute the correlation potential - - implicit none - include 'parameters.h' - -! Input variables - - integer,intent(in) :: rung - integer,intent(in) :: DFA - integer,intent(in) :: nEns - double precision,intent(in) :: wEns(nEns) - integer,intent(in) :: nGrid - double precision,intent(in) :: weight(nGrid) - integer,intent(in) :: nBas - double precision,intent(in) :: AO(nBas,nGrid) - double precision,intent(in) :: dAO(ncart,nBas,nGrid) - double precision,intent(in) :: rho(nGrid,nspin) - double precision,intent(in) :: drho(ncart,nGrid,nspin) - -! Local variables - - double precision,allocatable :: FcLDA(:,:,:) - double precision,allocatable :: FcGGA(:,:,:) - double precision :: aC - -! Output variables - - double precision,intent(out) :: Fc(nBas,nBas,nspin) - -! Memory allocation - - select case (rung) - -! Hartree calculation - - case(0) - - Fc(:,:,:) = 0d0 - -! LDA functionals - - case(1) - - call lda_correlation_potential(DFA,nEns,wEns,nGrid,weight,nBas,AO,rho,Fc) - -! GGA functionals - - case(2) - - call gga_correlation_potential(DFA,nEns,wEns,nGrid,weight,nBas,AO,dAO,rho,drho,Fc) - -! MGGA functionals - - case(3) - - call mgga_correlation_potential(DFA,nEns,wEns,nGrid,weight,nBas,AO,dAO,rho,drho,Fc) - -! Hybrid functionals - - case(4) - - call hybrid_correlation_potential(DFA,nEns,wEns,nGrid,weight,nBas,AO,dAO,rho,drho,Fc) - - end select - -end subroutine correlation_potential diff --git a/src/eDFT/density.f90 b/src/eDFT/density.f90 deleted file mode 100644 index d0584c0..0000000 --- a/src/eDFT/density.f90 +++ /dev/null @@ -1,38 +0,0 @@ -subroutine density(nGrid,nBas,P,AO,rho) - -! Calculate one-electron density - - implicit none - include 'parameters.h' - -! Input variables - - double precision,parameter :: thresh = 1d-15 - - integer,intent(in) :: nGrid - integer,intent(in) :: nBas - double precision,intent(in) :: P(nBas,nBas) - double precision,intent(in) :: AO(nBas,nGrid) - -! Local variables - - integer :: iG,mu,nu - -! Output variables - - double precision,intent(out) :: rho(nGrid) - - rho(:) = 0d0 - do iG=1,nGrid - do mu=1,nBas - do nu=1,nBas - rho(iG) = rho(iG) + AO(mu,iG)*P(mu,nu)*AO(nu,iG) - enddo - enddo - enddo - - do iG=1,nGrid - rho(iG) = max(0d0,rho(iG)) - enddo - -end subroutine density diff --git a/src/eDFT/density_matrix.f90 b/src/eDFT/density_matrix.f90 deleted file mode 100644 index eba8714..0000000 --- a/src/eDFT/density_matrix.f90 +++ /dev/null @@ -1,48 +0,0 @@ -subroutine density_matrix(nBas,nEns,c,P,occnum) - -! Calculate density matrices - - implicit none - - include 'parameters.h' - -! Input variables - - integer,intent(in) :: nBas - integer,intent(in) :: nEns - double precision,intent(in) :: c(nBas,nBas,nspin) - double precision,intent(in) :: occnum(nBas,nspin,nEns) - - -! Local variables - - integer :: ispin - integer :: iEns - integer :: q - integer :: mu,nu - -! Output variables - - double precision,intent(out) :: P(nBas,nBas,nspin,nEns) - -! Compute density matrix for each state of the ensemble based on occupation numbers - - P(:,:,:,:) = 0d0 - do iEns=1,nEns - do ispin=1,nspin - do mu=1,nBas - do nu=1,nBas - do q=1,nBas - - P(mu,nu,ispin,iEns) = P(mu,nu,ispin,iEns) & - + occnum(q,ispin,iEns)*c(mu,q,ispin)*c(nu,q,ispin) - - end do - end do - end do - end do - end do - - - -end subroutine density_matrix diff --git a/src/eDFT/eDFT.f90 b/src/eDFT/eDFT.f90 deleted file mode 100644 index ffc0632..0000000 --- a/src/eDFT/eDFT.f90 +++ /dev/null @@ -1,201 +0,0 @@ -subroutine eDFT(maxSCF,thresh,max_diis,guess_type,mix,level_shift,nNuc,ZNuc,rNuc,ENuc,nBas,nEl,nC,nO,nV,nR, & - nShell,TotAngMomShell,CenterShell,KShell,DShell,ExpShell, & - max_ang_mom,min_exponent,max_exponent,S,T,V,Hc,X,ERI,dipole_int,Ew,eKS,cKS,PKS,Vxc) - -! exchange-correlation density-functional theory calculations - -! use xc_f90_lib_m - - implicit none - include 'parameters.h' - -! Input variables - - integer,intent(in) :: maxSCF - integer,intent(in) :: max_diis - integer,intent(in) :: guess_type - logical,intent(in) :: mix - logical,intent(in) :: level_shift - double precision,intent(in) :: thresh - - integer,intent(in) :: nNuc - integer,intent(in) :: nBas - integer,intent(in) :: nEl(nspin) - integer,intent(in) :: nC(nspin) - integer,intent(in) :: nO(nspin) - integer,intent(in) :: nV(nspin) - integer,intent(in) :: nR(nspin) - double precision,intent(in) :: ENuc - - double precision,intent(in) :: ZNuc(nNuc) - double precision,intent(in) :: rNuc(nNuc,ncart) - - integer,intent(in) :: nShell - double precision,intent(in) :: CenterShell(maxShell,ncart) - integer,intent(in) :: TotAngMomShell(maxShell) - integer,intent(in) :: KShell(maxShell) - double precision,intent(in) :: DShell(maxShell,maxK) - double precision,intent(in) :: ExpShell(maxShell,maxK) - integer,intent(in) :: max_ang_mom(nNuc) - double precision,intent(in) :: min_exponent(nNuc,maxL+1) - double precision,intent(in) :: max_exponent(nNuc) - - - double precision,intent(in) :: S(nBas,nBas) - double precision,intent(in) :: T(nBas,nBas) - double precision,intent(in) :: V(nBas,nBas) - double precision,intent(in) :: Hc(nBas,nBas) - double precision,intent(in) :: X(nBas,nBas) - double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas) - double precision,intent(in) :: dipole_int(nBas,nBas,ncart) - -! Local variables - - character(len=8) :: method - integer :: x_rung,c_rung - integer :: x_DFA,c_DFA - logical :: LDA_centered = .true. - - integer :: SGn - double precision :: radial_precision - integer :: nRad - integer :: nAng - integer :: nGrid - double precision,allocatable :: root(:,:) - double precision,allocatable :: weight(:) - - integer :: nCC - double precision,allocatable :: aCC(:,:) - - double precision,allocatable :: AO(:,:) - double precision,allocatable :: dAO(:,:,:) - - double precision :: start_KS,end_KS,t_KS - double precision :: start_int,end_int,t_int - - integer :: nEns - logical :: doNcentered - double precision,allocatable :: wEns(:) - - double precision,allocatable :: occnum(:,:,:) - integer :: Cx_choice - - integer :: i,vmajor,vminor,vmicro - integer :: iBas,iEns,ispin - integer :: icart,iGrid - -! Output variables - - double precision,intent(out) :: Ew - double precision,intent(out) :: eKS(nBas,nspin) - double precision,intent(out) :: cKS(nBas,nBas,nspin) - double precision,intent(out) :: PKS(nBas,nBas,nspin) - double precision,intent(out) :: Vxc(nBas,nspin) - - -! Hello World - - write(*,*) - write(*,*) '******************************************' - write(*,*) '* eDFT: density-functional for ensembles *' - write(*,*) '******************************************' - write(*,*) - -!------------------------------------------------------------------------ -! DFT options -!------------------------------------------------------------------------ - -! Allocate ensemble weights and MO coefficients - - allocate(wEns(maxEns),aCC(maxCC,maxEns-1),occnum(nBas,nspin,maxEns)) - call read_options_dft(nBas,method,x_rung,x_DFA,c_rung,c_DFA,SGn,nEns,wEns,nCC,aCC, & - doNcentered,occnum,Cx_choice) - -!------------------------------------------------------------------------ -! Construct quadrature grid -!------------------------------------------------------------------------ - if(SGn == -1) then - - write(*,*) '*** Quadrature grid on atomic sites ! ***' - write(*,*) - nGrid = nNuc - allocate(root(ncart,nGrid),weight(nGrid)) - - do icart=1,ncart - do iGrid=1,nGrid - root(icart,iGrid) = rNuc(iGrid,icart) - end do - end do - weight(:) = 1d0 - - else - - call read_grid(SGn,radial_precision,nRad,nAng,nGrid) - - call allocate_grid(nNuc,ZNuc,max_ang_mom,min_exponent,max_exponent,radial_precision,nAng,nGrid) - - allocate(root(ncart,nGrid),weight(nGrid)) - - call build_grid(nNuc,ZNuc,rNuc,max_ang_mom,min_exponent,max_exponent, & - radial_precision,nRad,nAng,nGrid,weight,root) - - end if - -!------------------------------------------------------------------------ -! Calculate AO values at grid points -!------------------------------------------------------------------------ - - allocate(AO(nBas,nGrid),dAO(ncart,nBas,nGrid)) - call AO_values_grid(nBas,nShell,CenterShell,TotAngMomShell,KShell,DShell,ExpShell,nGrid,root,AO,dAO) - -!------------------------------------------------------------------------ -! Compute UKS energy -!------------------------------------------------------------------------ - - if(method == 'UKS') then - - ! Reset occupation numbers for conventional UKS calculation - - occnum(:,:,:) = 0d0 - do ispin=1,nspin - do iBas=1,nO(ispin) - do iEns=1,nEns - occnum(iBas,ispin,iEns) = 1d0 - end do - end do - end do - - call cpu_time(start_KS) - call UKS(x_rung,x_DFA,c_rung,c_DFA,nEns,wEns,nCC,aCC(1:nCC,1:nEns-1),nGrid,weight, & - maxSCF,thresh,max_diis,guess_type,mix,level_shift,nNuc,ZNuc,rNuc,ENuc, & - nBas,AO,dAO,S,T,V,Hc,ERI,dipole_int,X,occnum,Cx_choice,doNcentered,Ew,eKS,cKS,PKS,Vxc) - call cpu_time(end_KS) - - t_KS = end_KS - start_KS - write(*,'(A65,1X,F9.3,A8)') 'Total CPU time for UKS = ',t_KS,' seconds' - write(*,*) - - end if - -!------------------------------------------------------------------------ -! Compute UKS energy for ensembles -!------------------------------------------------------------------------ - - if(method == 'eDFT-UKS') then - - call cpu_time(start_KS) - call UKS(x_rung,x_DFA,c_rung,c_DFA,nEns,wEns,nCC,aCC(1:nCC,1:nEns-1),nGrid,weight, & - maxSCF,thresh,max_diis,guess_type,mix,level_shift,nNuc,ZNuc,rNuc,ENuc, & - nBas,AO,dAO,S,T,V,Hc,ERI,dipole_int,X,occnum,Cx_choice,doNcentered,Ew,eKS,cKS,PKS,Vxc) - call cpu_time(end_KS) - - t_KS = end_KS - start_KS - write(*,'(A65,1X,F9.3,A8)') 'Total CPU time for UKS = ',t_KS,' seconds' - write(*,*) - - end if - -!------------------------------------------------------------------------ -! End of eDFT -!------------------------------------------------------------------------ -end subroutine eDFT diff --git a/src/eDFT/elda_correlation_energy.f90 b/src/eDFT/elda_correlation_energy.f90 deleted file mode 100644 index 54d5576..0000000 --- a/src/eDFT/elda_correlation_energy.f90 +++ /dev/null @@ -1,69 +0,0 @@ -subroutine elda_correlation_energy(aLF,nGrid,weight,rho,Ec) - -! Compute LDA correlation energy of 2-glomium for various states - - implicit none - include 'parameters.h' - -! Input variables - - double precision,intent(in) :: aLF(3) - integer,intent(in) :: nGrid - double precision,intent(in) :: weight(nGrid) - double precision,intent(in) :: rho(nGrid,nspin) - -! Local variables - - integer :: iG - double precision :: ra,rb,r,ec_p - -! Output variables - - double precision,intent(out) :: Ec(nsp) - - -! Compute eLDA correlation energy - - Ec(:) = 0d0 - - do iG=1,nGrid - - ra = max(0d0,rho(iG,1)) - rb = max(0d0,rho(iG,2)) - r = ra + rb - -! Spin-up contribution - - if(ra > threshold) then - - ec_p = aLF(1)/(1d0 + aLF(2)*ra**(-1d0/6d0) + aLF(3)*ra**(-1d0/3d0)) - - Ec(1) = Ec(1) + weight(iG)*ec_p*ra - - end if - -! Opposite-spin contribution - - if(r > threshold) then - - ec_p = aLF(1)/(1d0 + aLF(2)*r**(-1d0/6d0) + aLF(3)*r**(-1d0/3d0)) - - Ec(2) = Ec(2) + weight(iG)*ec_p*r - - end if - -! Spin-down contribution - - if(rb > threshold) then - - ec_p = aLF(1)/(1d0 + aLF(2)*rb**(-1d0/6d0) + aLF(3)*rb**(-1d0/3d0)) - - Ec(3) = Ec(3) + weight(iG)*ec_p*rb - - end if - - end do - - Ec(2) = Ec(2) - Ec(1) - Ec(3) - -end subroutine elda_correlation_energy diff --git a/src/eDFT/elda_correlation_individual_energy.f90 b/src/eDFT/elda_correlation_individual_energy.f90 deleted file mode 100644 index 79000fe..0000000 --- a/src/eDFT/elda_correlation_individual_energy.f90 +++ /dev/null @@ -1,57 +0,0 @@ -subroutine elda_correlation_individual_energy(aLF,nGrid,weight,rhow,rho,Ec) - -! Compute LDA correlation individual energy of 2-glomium for various states - - implicit none - include 'parameters.h' - -! Input variables - - double precision,intent(in) :: aLF(3) - integer,intent(in) :: nGrid - double precision,intent(in) :: weight(nGrid) - double precision,intent(in) :: rhow(nGrid,nspin) - double precision,intent(in) :: rho(nGrid,nspin) - -! Local variables - - integer :: iG - double precision :: ra, rb, r - double precision :: raI,rbI,rI - double precision :: ec_p,dFcdr - -! Output variables - - double precision,intent(out) :: Ec(nsp) - -! Compute eLDA correlation potential - - Ec(:) = 0d0 - - do iG=1,nGrid - - ra = max(0d0,rhow(iG,1)) - rb = max(0d0,rhow(iG,2)) - - raI = max(0d0,rho(iG,1)) - rbI = max(0d0,rho(iG,2)) - - r = ra + rb - rI = raI + rbI - - if(r > threshold .or. rI > threshold) then - - ec_p = aLF(1)/(1d0 + aLF(2)*r**(-1d0/6d0) + aLF(3)*r**(-1d0/3d0)) - - dFcdr = aLF(2)*r**(-1d0/6d0) + 2d0*aLF(3)*r**(-1d0/3d0) - dFcdr = dFcdr/(1d0 + aLF(2)*r**(-1d0/6d0) + aLF(3)*r**(-1d0/3d0)) - dFcdr = ec_p*dFcdr/(6d0*r) - dFcdr = ec_p + dFcdr*r - - Ec(2) = Ec(2) + weight(iG)*rI*dFcdr - - end if - - end do - -end subroutine elda_correlation_individual_energy diff --git a/src/eDFT/elda_correlation_potential.f90 b/src/eDFT/elda_correlation_potential.f90 deleted file mode 100644 index c4b5fff..0000000 --- a/src/eDFT/elda_correlation_potential.f90 +++ /dev/null @@ -1,70 +0,0 @@ -subroutine elda_correlation_potential(aLF,nGrid,weight,nBas,AO,rho,Fc) - -! Compute LDA correlation energy of 2-glomium for various states - - implicit none - include 'parameters.h' - -! Input variables - - double precision,intent(in) :: aLF(3) - integer,intent(in) :: nGrid - double precision,intent(in) :: weight(nGrid) - integer,intent(in) :: nBas - double precision,intent(in) :: AO(nBas,nGrid) - double precision,intent(in) :: rho(nGrid,nspin) - -! Local variables - - integer :: mu,nu,iG - double precision :: ra,rb,r,ec_p - double precision :: dFcdra,dFcdrb - -! Output variables - - double precision,intent(out) :: Fc(nBas,nBas,nspin) - -! Compute eLDA correlation potential - - Fc(:,:,:) = 0d0 - - do mu=1,nBas - do nu=1,nBas - do iG=1,nGrid - - ra = max(0d0,rho(iG,1)) - rb = max(0d0,rho(iG,2)) - - if(ra > threshold) then - - r = ra + rb - - ec_p = aLF(1)/(1d0 + aLF(2)*r**(-1d0/6d0) + aLF(3)*r**(-1d0/3d0)) - dFcdra = aLF(2)*r**(-1d0/6d0) + 2d0*aLF(3)*r**(-1d0/3d0) - dFcdra = dFcdra/(1d0 + aLF(2)*r**(-1d0/6d0) + aLF(3)*r**(-1d0/3d0)) - dFcdra = ec_p*dFcdra/(6d0*r) - dFcdra = ec_p + dFcdra*r - - Fc(mu,nu,1) = Fc(mu,nu,1) + weight(iG)*AO(mu,iG)*AO(nu,iG)*dFcdra - - endif - - if(rb > threshold) then - - r = ra + rb - - ec_p = aLF(1)/(1d0 + aLF(2)*r**(-1d0/6d0) + aLF(3)*r**(-1d0/3d0)) - dFcdrb = aLF(2)*r**(-1d0/6d0) + 2d0*aLF(3)*r**(-1d0/3d0) - dFcdrb = dFcdrb/(1d0 + aLF(2)*r**(-1d0/6d0) + aLF(3)*r**(-1d0/3d0)) - dFcdrb = ec_p*dFcdrb/(6d0*r) - dFcdrb = ec_p + dFcdrb*r - - Fc(mu,nu,2) = Fc(mu,nu,2) + weight(iG)*AO(mu,iG)*AO(nu,iG)*dFcdrb - - endif - - end do - end do - end do - -end subroutine elda_correlation_potential diff --git a/src/eDFT/electron_number.f90 b/src/eDFT/electron_number.f90 deleted file mode 100644 index 310e161..0000000 --- a/src/eDFT/electron_number.f90 +++ /dev/null @@ -1,20 +0,0 @@ -function electron_number(nGrid,w,rho) result(nEl) - -! Compute the number of electrons via integration of the one-electron density - - implicit none - include 'parameters.h' - -! Input variables - - integer,intent(in) :: nGrid - double precision,intent(in) :: w(nGrid) - double precision,intent(in) :: rho(nGrid) - -! Output variables - - double precision :: nEl - - nEl = dot_product(w,rho) - -end function electron_number diff --git a/src/eDFT/exchange_derivative_discontinuity.f90 b/src/eDFT/exchange_derivative_discontinuity.f90 deleted file mode 100644 index bc8485e..0000000 --- a/src/eDFT/exchange_derivative_discontinuity.f90 +++ /dev/null @@ -1,67 +0,0 @@ -subroutine exchange_derivative_discontinuity(rung,DFA,nEns,wEns,nCC,aCC,nGrid,weight,rhow,drhow,& - Cx_choice,doNcentered,kappa,ExDD) - -! Compute the exchange part of the derivative discontinuity - - implicit none - include 'parameters.h' - -! Input variables - - integer,intent(in) :: rung - integer,intent(in) :: DFA - integer,intent(in) :: nEns - double precision,intent(in) :: wEns(nEns) - integer,intent(in) :: nCC - double precision,intent(in) :: aCC(nCC,nEns-1) - integer,intent(in) :: nGrid - double precision,intent(in) :: weight(nGrid) - double precision,intent(in) :: rhow(nGrid) - double precision,intent(in) :: drhow(ncart,nGrid) - integer,intent(in) :: Cx_choice - logical,intent(in) :: doNcentered - double precision,intent(in) :: kappa(nEns) - -!Local variables - - -!Output variables - - double precision,intent(out) :: ExDD(nEns) - - select case (rung) - -! Hartree calculation - - case(0) - - ExDD(:) = 0d0 - -! LDA functionals - - case(1) - - call lda_exchange_derivative_discontinuity(DFA,nEns,wEns(:),nCC,aCC,nGrid,weight(:),& - rhow(:),Cx_choice,doNcentered,kappa,ExDD(:)) -! GGA functionals - - case(2) - - call gga_exchange_derivative_discontinuity(DFA,nEns,wEns(:),nGrid,weight(:),rhow(:),drhow(:,:),ExDD(:)) - -! MGGA functionals - - case(3) - - call mgga_exchange_derivative_discontinuity(DFA,nEns,wEns(:),nGrid,weight(:),rhow(:),drhow(:,:),ExDD(:)) - -! Hybrid functionals - - case(4) - - call hybrid_exchange_derivative_discontinuity(DFA,nEns,wEns(:),nCC,aCC,nGrid,weight(:),& - rhow(:),Cx_choice,doNcentered,ExDD(:)) - - end select - -end subroutine exchange_derivative_discontinuity diff --git a/src/eDFT/exchange_energy.f90 b/src/eDFT/exchange_energy.f90 deleted file mode 100644 index a787910..0000000 --- a/src/eDFT/exchange_energy.f90 +++ /dev/null @@ -1,69 +0,0 @@ -subroutine exchange_energy(rung,DFA,LDA_centered,nEns,wEns,nCC,aCC,nGrid,weight,nBas,P,FxHF, & - rho,drho,Cx_choice,doNcentered,Ex) - -! Compute the exchange energy - - implicit none - include 'parameters.h' - -! Input variables - - integer,intent(in) :: rung - integer,intent(in) :: DFA - logical,intent(in) :: LDA_centered - integer,intent(in) :: nEns - double precision,intent(in) :: wEns(nEns) - integer,intent(in) :: nCC - double precision,intent(in) :: aCC(nCC,nEns-1) - integer,intent(in) :: nGrid - double precision,intent(in) :: weight(nGrid) - integer,intent(in) :: nBas - double precision,intent(in) :: P(nBas,nBas) - double precision,intent(in) :: FxHF(nBas,nBas) - double precision,intent(in) :: rho(nGrid) - double precision,intent(in) :: drho(ncart,nGrid) - integer,intent(in) :: Cx_choice - logical,intent(in) :: doNcentered - -! Local variables - -! Output variables - - double precision,intent(out) :: Ex - - select case (rung) - -! Hartree calculation - - case(0) - - Ex = 0d0 - -! LDA functionals - - case(1) - - call lda_exchange_energy(DFA,LDA_centered,nEns,wEns,nCC,aCC,nGrid,weight,rho,Cx_choice,doNcentered,Ex) - -! GGA functionals - - case(2) - - call gga_exchange_energy(DFA,nEns,wEns,nCC,aCC,nGrid,weight,rho,drho,Cx_choice,Ex) - -! MGGA functionals - - case(3) - - call mgga_exchange_energy(DFA,nEns,wEns,nGrid,weight,rho,drho,Ex) - -! Hybrid functionals - - case(4) - - call hybrid_exchange_energy(DFA,LDA_centered,nEns,wEns,nCC,aCC,nGrid,weight,nBas,P,FxHF, & - rho,drho,Cx_choice,doNcentered,Ex) - - end select - -end subroutine exchange_energy diff --git a/src/eDFT/exchange_individual_energy.f90 b/src/eDFT/exchange_individual_energy.f90 deleted file mode 100644 index 63a025f..0000000 --- a/src/eDFT/exchange_individual_energy.f90 +++ /dev/null @@ -1,71 +0,0 @@ -subroutine exchange_individual_energy(rung,DFA,LDA_centered,nEns,wEns,nCC,aCC,nGrid,weight,nBas, & - ERI,Pw,rhow,drhow,P,rho,drho,Cx_choice,doNcentered,LZx,Ex) - -! Compute the exchange individual energy - - implicit none - include 'parameters.h' - -! Input variables - - integer,intent(in) :: rung - integer,intent(in) :: DFA - logical,intent(in) :: LDA_centered - integer,intent(in) :: nEns - double precision,intent(in) :: wEns(nEns) - integer,intent(in) :: nCC - double precision,intent(in) :: aCC(nCC,nEns-1) - integer,intent(in) :: nGrid - double precision,intent(in) :: weight(nGrid) - integer,intent(in) :: nBas - double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas) - double precision,intent(in) :: Pw(nBas,nBas,nspin) - double precision,intent(in) :: rhow(nGrid,nspin) - double precision,intent(in) :: drhow(ncart,nGrid,nspin) - double precision,intent(in) :: P(nBas,nBas,nspin,nEns) - double precision,intent(in) :: rho(nGrid,nspin,nEns) - double precision,intent(in) :: drho(ncart,nGrid,nspin,nEns) - integer,intent(in) :: Cx_choice - logical,intent(in) :: doNcentered - -! Output variables - - double precision,intent(out) :: LZx(nspin) - double precision,intent(out) :: Ex(nspin,nEns) - - select case (rung) - -! Hartree calculation - - case(0) - - Ex = 0d0 - -! LDA functionals - - case(1) - - call lda_exchange_individual_energy(DFA,LDA_centered,nEns,wEns,nCC,aCC,nGrid,weight,& - rhow,rho,Cx_choice,doNcentered,LZx,Ex) - -! GGA functionals - - case(2) - - call gga_exchange_individual_energy(DFA,nEns,wEns,nGrid,weight,rhow,drhow,rho,drho,LZx,Ex) - -! MGGA functionals - - case(3) - - call mgga_exchange_individual_energy(DFA,nEns,wEns,nGrid,weight,rhow,drhow,rho,drho,LZx,Ex) - -! Hybrid functionals - - case(4) - - call hybrid_exchange_individual_energy(DFA,nEns,wEns,nGrid,weight,nBas,ERI,Pw,rhow,drhow,P,rho,drho,LZx,Ex) - - end select - -end subroutine exchange_individual_energy diff --git a/src/eDFT/exchange_potential.f90 b/src/eDFT/exchange_potential.f90 deleted file mode 100644 index 3322ab0..0000000 --- a/src/eDFT/exchange_potential.f90 +++ /dev/null @@ -1,80 +0,0 @@ -subroutine exchange_potential(rung,DFA,LDA_centered,nEns,wEns,nCC,aCC,nGrid,weight,nBas,P, & - ERI,AO,dAO,rho,drho,Cx_choice,doNcentered,Fx,FxHF) - -! Compute the exchange potential - - implicit none - include 'parameters.h' - -! Input variables - - integer,intent(in) :: rung - integer,intent(in) :: DFA - logical,intent(in) :: LDA_centered - integer,intent(in) :: nEns - double precision,intent(in) :: wEns(nEns) - integer,intent(in) :: nCC - double precision,intent(in) :: aCC(nCC,nEns-1) - integer,intent(in) :: nGrid - double precision,intent(in) :: weight(nGrid) - integer,intent(in) :: nBas - double precision,intent(in) :: P(nBas,nBas) - double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas) - double precision,intent(in) :: AO(nBas,nGrid) - double precision,intent(in) :: dAO(ncart,nBas,nGrid) - double precision,intent(in) :: rho(nGrid) - double precision,intent(in) :: drho(ncart,nGrid) - integer,intent(in) :: Cx_choice - logical,intent(in) :: doNcentered - -! Local variables - - double precision,allocatable :: FxLDA(:,:) - double precision,allocatable :: FxGGA(:,:) - double precision :: cX,aX - -! Output variables - - double precision,intent(out) :: Fx(nBas,nBas) - double precision,intent(out) :: FxHF(nBas,nBas) - -! Memory allocation - - select case (rung) - -! Hartree calculation - - case(0) - - Fx(:,:) = 0d0 - -! LDA functionals - - case(1) - - call lda_exchange_potential(DFA,LDA_centered,nEns,wEns,nCC,aCC,nGrid,weight,nBas,AO,rho,& - Cx_choice,doNcentered,Fx) - -! GGA functionals - - case(2) - - call gga_exchange_potential(DFA,nEns,wEns,nCC,aCC,nGrid,weight,nBas,AO,dAO,rho,drho,& - Cx_choice,Fx) - -! MGGA functionals - - case(3) - - call mgga_exchange_potential(DFA,nEns,wEns,nGrid,weight,nBas,AO,dAO,rho,drho,Fx) - -! Hybrid functionals - - case(4) - - call hybrid_exchange_potential(DFA,LDA_centered,nEns,wEns,nCC,aCC,nGrid,weight,nBas,P, & - ERI,AO,dAO,rho,drho,Cx_choice,doNcentered,Fx,FxHF) - - end select - -end subroutine exchange_potential diff --git a/src/eDFT/fock_exchange_energy.f90 b/src/eDFT/fock_exchange_energy.f90 deleted file mode 100644 index 17e7d49..0000000 --- a/src/eDFT/fock_exchange_energy.f90 +++ /dev/null @@ -1,25 +0,0 @@ -subroutine fock_exchange_energy(nBas,P,Fx,Ex) - -! Compute the (exact) Fock exchange energy - - implicit none - -! Input variables - - integer,intent(in) :: nBas - double precision,intent(in) :: P(nBas,nBas) - double precision,intent(in) :: Fx(nBas,nBas) - -! Local variables - - double precision,external :: trace_matrix - -! Output variables - - double precision,intent(out) :: Ex - -! Compute HF exchange energy - - Ex = 0.5d0*trace_matrix(nBas,matmul(P,Fx)) - -end subroutine fock_exchange_energy diff --git a/src/eDFT/fock_exchange_individual_energy.f90 b/src/eDFT/fock_exchange_individual_energy.f90 deleted file mode 100644 index 560576f..0000000 --- a/src/eDFT/fock_exchange_individual_energy.f90 +++ /dev/null @@ -1,46 +0,0 @@ -subroutine fock_exchange_individual_energy(nBas,nEns,Pw,P,ERI,LZx,Ex) - -! Compute the HF individual energy in the unrestricted formalism - - implicit none - include 'parameters.h' - -! Input variables - - integer,intent(in) :: nBas - integer,intent(in) :: nEns - double precision,intent(in) :: Pw(nBas,nBas,nspin) - double precision,intent(in) :: P(nBas,nBas,nspin,nEns) - double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas) - -! Local variables - - double precision,allocatable :: Fx(:,:,:) - double precision,external :: trace_matrix - - integer :: iEns - integer :: ispin - -! Output variables - - double precision,intent(out) :: LZx(nspin) - double precision,intent(out) :: Ex(nspin,nEns) - -! Compute HF exchange matrix - - allocate(Fx(nBas,nBas,nspin)) - - do ispin=1,nspin - - call fock_exchange_potential(nBas,Pw(:,:,ispin),ERI,Fx(:,:,ispin)) - - LZx(ispin) = - 0.5d0*trace_matrix(nBas,matmul(Pw(:,:,ispin),Fx(:,:,ispin))) - - do iEns=1,nEns - Ex(ispin,iEns) = - 0.5d0*trace_matrix(nBas,matmul(P(:,:,ispin,iEns),Fx(:,:,ispin))) - end do - - end do - - -end subroutine fock_exchange_individual_energy diff --git a/src/eDFT/fock_exchange_potential.f90 b/src/eDFT/fock_exchange_potential.f90 deleted file mode 100644 index f1b23f9..0000000 --- a/src/eDFT/fock_exchange_potential.f90 +++ /dev/null @@ -1,34 +0,0 @@ -subroutine fock_exchange_potential(nBas,P,ERI,Fx) - -! Compute the Fock exchange potential - - implicit none - -! Input variables - - integer,intent(in) :: nBas - double precision,intent(in) :: P(nBas,nBas) - double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas) - -! Local variables - - integer :: mu,nu,la,si - -! Output variables - - double precision,intent(out) :: Fx(nBas,nBas) - -! Compute HF exchange matrix - - Fx(:,:) = 0d0 - do si=1,nBas - do la=1,nBas - do nu=1,nBas - do mu=1,nBas - Fx(mu,nu) = Fx(mu,nu) - P(la,si)*ERI(mu,la,si,nu) - enddo - enddo - enddo - enddo - -end subroutine fock_exchange_potential diff --git a/src/eDFT/generate_shell.f90 b/src/eDFT/generate_shell.f90 deleted file mode 100644 index c6e0ab5..0000000 --- a/src/eDFT/generate_shell.f90 +++ /dev/null @@ -1,32 +0,0 @@ -subroutine generate_shell(atot,nShellFunction,ShellFunction) - -! Generate shells for a given total angular momemtum - - implicit none - -! Input variables - - integer,intent(in) :: atot,nShellFunction - -! Local variables - - integer :: ax,ay,az,ia - -! Output variables - - integer,intent(out) :: ShellFunction(nShellFunction,3) - - ia = 0 - do ax=atot,0,-1 - do az=0,atot - ay = atot - ax - az - if(ay >= 0) then - ia = ia + 1 - ShellFunction(ia,1) = ax - ShellFunction(ia,2) = ay - ShellFunction(ia,3) = az - endif - enddo - enddo - -end subroutine generate_shell diff --git a/src/eDFT/gga_correlation_derivative_discontinuity.f90 b/src/eDFT/gga_correlation_derivative_discontinuity.f90 deleted file mode 100644 index fbf8895..0000000 --- a/src/eDFT/gga_correlation_derivative_discontinuity.f90 +++ /dev/null @@ -1,44 +0,0 @@ -subroutine gga_correlation_derivative_discontinuity(DFA,nEns,wEns,nGrid,weight,rhow,Ec) - -! Compute the correlation GGA part of the derivative discontinuity - - implicit none - include 'parameters.h' - -! Input variables - - integer,intent(in) :: DFA - integer,intent(in) :: nEns - double precision,intent(in) :: wEns(nEns) - integer,intent(in) :: nGrid - double precision,intent(in) :: weight(nGrid) - double precision,intent(in) :: rhow(nGrid,nspin) - -! Local variables - - double precision :: aC - -! Output variables - - double precision,intent(out) :: Ec(nsp,nEns) - -! Select correlation functional - - select case (DFA) - - case (1) - - Ec(:,:) = 0d0 - - case (2) - - Ec(:,:) = 0d0 - - case default - - call print_warning('!!! GGA correlation functional not available !!!') - stop - - end select - -end subroutine gga_correlation_derivative_discontinuity diff --git a/src/eDFT/gga_correlation_energy.f90 b/src/eDFT/gga_correlation_energy.f90 deleted file mode 100644 index ef53764..0000000 --- a/src/eDFT/gga_correlation_energy.f90 +++ /dev/null @@ -1,44 +0,0 @@ -subroutine gga_correlation_energy(DFA,nEns,wEns,nGrid,weight,rho,drho,Ec) - -! Compute unrestricted GGA correlation energy - - implicit none - include 'parameters.h' - -! Input variables - - integer,intent(in) :: DFA - integer,intent(in) :: nEns - double precision,intent(in) :: wEns(nEns) - integer,intent(in) :: nGrid - double precision,intent(in) :: weight(nGrid) - double precision,intent(in) :: rho(nGrid,nspin) - double precision,intent(in) :: drho(ncart,nGrid,nspin) - -! Local variables - - integer :: iG - double precision :: ra,rb,ga,gb - -! Output variables - - double precision :: Ec(nsp) - - select case (DFA) - - case (1) - - call LYP_gga_correlation_energy(nGrid,weight,rho,drho,Ec) - - case (2) - - call PBE_gga_correlation_energy(nGrid,weight,rho,drho,Ec) - - case default - - call print_warning('!!! GGA correlation energy not available !!!') - stop - - end select - -end subroutine gga_correlation_energy diff --git a/src/eDFT/gga_correlation_potential.f90 b/src/eDFT/gga_correlation_potential.f90 deleted file mode 100644 index d7042dc..0000000 --- a/src/eDFT/gga_correlation_potential.f90 +++ /dev/null @@ -1,46 +0,0 @@ -subroutine gga_correlation_potential(DFA,nEns,wEns,nGrid,weight,nBas,AO,dAO,rho,drho,Fc) - -! Compute unrestricted GGA correlation potential - - implicit none - include 'parameters.h' - -! Input variables - - integer,intent(in) :: DFA - integer,intent(in) :: nEns - double precision,intent(in) :: wEns(nEns) - integer,intent(in) :: nGrid - double precision,intent(in) :: weight(nGrid) - integer,intent(in) :: nBas - double precision,intent(in) :: AO(nBas,nGrid) - double precision,intent(in) :: dAO(3,nBas,nGrid) - double precision,intent(in) :: rho(nGrid,nspin) - double precision,intent(in) :: drho(3,nGrid,nspin) - -! Local variables - -! Output variables - - double precision,intent(out) :: Fc(nBas,nBas,nspin) - -! Select GGA exchange functional - - select case (DFA) - - case (1) - - call LYP_gga_correlation_potential(nGrid,weight,nBas,AO,dAO,rho,drho,Fc) - - case (2) - - call PBE_gga_correlation_potential(nGrid,weight,nBas,AO,dAO,rho,drho,Fc) - - case default - - call print_warning('!!! GGA correlation potential not available !!!') - stop - - end select - -end subroutine gga_correlation_potential diff --git a/src/eDFT/gga_exchange_derivative_discontinuity.f90 b/src/eDFT/gga_exchange_derivative_discontinuity.f90 deleted file mode 100644 index 4373930..0000000 --- a/src/eDFT/gga_exchange_derivative_discontinuity.f90 +++ /dev/null @@ -1,48 +0,0 @@ -subroutine gga_exchange_derivative_discontinuity(DFA,nEns,wEns,nGrid,weight,rhow,drhow,ExDD) - -! Compute the exchange GGA part of the derivative discontinuity - - implicit none - include 'parameters.h' - -! Input variables - - integer,intent(in) :: DFA - integer,intent(in) :: nEns - double precision,intent(in) :: wEns(nEns) - integer,intent(in) :: nGrid - double precision,intent(in) :: weight(nGrid) - double precision,intent(in) :: rhow(nGrid) - double precision,intent(in) :: drhow(ncart,nGrid) - -! Local variables - - -! Output variables - - double precision,intent(out) :: ExDD(nEns) - -! Select exchange functional - - select case (DFA) - - case (1) - - ExDD(:) = 0d0 - - case (2) - - ExDD(:) = 0d0 - - case (3) - - ExDD(:) = 0d0 - - case default - - call print_warning('!!! GGA exchange derivative discontinuity not available !!!') - stop - - end select - -end subroutine gga_exchange_derivative_discontinuity diff --git a/src/eDFT/gga_exchange_energy.f90 b/src/eDFT/gga_exchange_energy.f90 deleted file mode 100644 index fba9cd0..0000000 --- a/src/eDFT/gga_exchange_energy.f90 +++ /dev/null @@ -1,53 +0,0 @@ -subroutine gga_exchange_energy(DFA,nEns,wEns,nCC,aCC,nGrid,weight,rho,drho,Cx_choice,Ex) - -! Select GGA exchange functional for energy calculation - - implicit none - - include 'parameters.h' - -! Input variables - - integer,intent(in) :: DFA - integer,intent(in) :: nEns - double precision,intent(in) :: wEns(nEns) - integer,intent(in) :: nCC - double precision,intent(in) :: aCC(nCC,nEns-1) - integer,intent(in) :: nGrid - double precision,intent(in) :: weight(nGrid) - double precision,intent(in) :: rho(nGrid) - integer,intent(in) :: Cx_choice - double precision,intent(in) :: drho(ncart,nGrid) - - -! Output variables - - double precision :: Ex - - select case (DFA) - - case (1) - - call G96_gga_exchange_energy(nGrid,weight,rho,drho,Ex) - - case (2) - - call B88_gga_exchange_energy(nGrid,weight,rho,drho,Ex) - - case (3) - - call PBE_gga_exchange_energy(nGrid,weight,rho,drho,Ex) - - case (4) - - call CC_B88_gga_exchange_energy(nEns,wEns,nCC,aCC,nGrid,weight,rho,drho,& - Cx_choice,Ex) - - case default - - call print_warning('!!! GGA exchange energy not available !!!') - stop - - end select - -end subroutine gga_exchange_energy diff --git a/src/eDFT/gga_exchange_individual_energy.f90 b/src/eDFT/gga_exchange_individual_energy.f90 deleted file mode 100644 index 4b22aeb..0000000 --- a/src/eDFT/gga_exchange_individual_energy.f90 +++ /dev/null @@ -1,36 +0,0 @@ -subroutine gga_exchange_individual_energy(DFA,nEns,wEns,nGrid,weight,rhow,drhow,rho,drho,LZx,Ex) - -! Compute GGA exchange energy for individual states - - implicit none - include 'parameters.h' - -! Input variables - - integer,intent(in) :: DFA - integer,intent(in) :: nEns - double precision,intent(in) :: wEns(nEns) - integer,intent(in) :: nGrid - double precision,intent(in) :: weight(nGrid) - double precision,intent(in) :: rhow(nGrid,nspin) - double precision,intent(in) :: drhow(ncart,nGrid,nspin) - double precision,intent(in) :: rho(nGrid,nspin,nEns) - double precision,intent(in) :: drho(ncart,nGrid,nspin,nEns) - -! Output variables - - double precision :: LZx(nspin) - double precision :: Ex(nspin,nEns) - -! Select correlation functional - - select case (DFA) - - case default - - call print_warning('!!! GGA exchange individual energy not available !!!') - stop - - end select - -end subroutine gga_exchange_individual_energy diff --git a/src/eDFT/gga_exchange_potential.f90 b/src/eDFT/gga_exchange_potential.f90 deleted file mode 100644 index 81f05a3..0000000 --- a/src/eDFT/gga_exchange_potential.f90 +++ /dev/null @@ -1,57 +0,0 @@ -subroutine gga_exchange_potential(DFA,nEns,wEns,nCC,aCC,nGrid,weight,nBas,AO,dAO,& - rho,drho,Cx_choice,Fx) - -! Select GGA exchange functional for potential calculation - - implicit none - include 'parameters.h' - -! Input variables - - integer,intent(in) :: DFA - integer,intent(in) :: nEns - double precision,intent(in) :: wEns(nEns) - integer,intent(in) :: nCC - double precision,intent(in) :: aCC(nCC,nEns-1) - integer,intent(in) :: nGrid - double precision,intent(in) :: weight(nGrid) - integer,intent(in) :: nBas - double precision,intent(in) :: AO(nBas,nGrid) - double precision,intent(in) :: dAO(3,nBas,nGrid) - double precision,intent(in) :: rho(nGrid) - double precision,intent(in) :: drho(3,nGrid) - integer,intent(in) :: Cx_choice - -! Output variables - - double precision,intent(out) :: Fx(nBas,nBas) - -! Select GGA exchange functional - - select case (DFA) - - case (1) - - call G96_gga_exchange_potential(nGrid,weight,nBas,AO,dAO,rho,drho,Fx) - - case (2) - - call B88_gga_exchange_potential(nGrid,weight,nBas,AO,dAO,rho,drho,Fx) - - case (3) - - call PBE_gga_exchange_potential(nGrid,weight,nBas,AO,dAO,rho,drho,Fx) - - case (4) - - call CC_B88_gga_exchange_potential(nEns,wEns,nCC,aCC,nGrid,weight,nBas,AO,dAO,rho,drho,& - Cx_choice,Fx) - - case default - - call print_warning('!!! GGA exchange potential not available !!!') - stop - - end select - -end subroutine gga_exchange_potential diff --git a/src/eDFT/gradient_density.f90 b/src/eDFT/gradient_density.f90 deleted file mode 100644 index 0e8c8f2..0000000 --- a/src/eDFT/gradient_density.f90 +++ /dev/null @@ -1,45 +0,0 @@ -subroutine gradient_density(nGrid,nBas,P,AO,dAO,drho) - -! Calculate gradient of the one-electron density - - implicit none - include 'parameters.h' - -! Input variables - - double precision,parameter :: thresh = 1d-15 - - integer,intent(in) :: nGrid - integer,intent(in) :: nBas - double precision,intent(in) :: P(nBas,nBas) - double precision,intent(in) :: AO(nBas,nGrid) - double precision,intent(in) :: dAO(ncart,nBas,nGrid) - -! Local variables - - integer :: ixyz,iG,mu,nu - double precision,external :: trace_matrix - -! Output variables - - double precision,intent(out) :: drho(ncart,nGrid) - - drho(:,:) = 0d0 - do iG=1,nGrid - do mu=1,nBas - do nu=1,nBas - do ixyz=1,ncart - drho(ixyz,iG) = drho(ixyz,iG) & - + P(mu,nu)*(dAO(ixyz,mu,iG)*AO(nu,iG) + AO(mu,iG)*dAO(ixyz,nu,iG)) - enddo - enddo - enddo - enddo - -! do iG=1,nGrid -! do ixyz=1,ncart -! if(abs(drho(ixyz,iG)) < thresh) drho(ixyz,iG) = thresh -! enddo -! enddo - -end subroutine gradient_density diff --git a/src/eDFT/hartree_energy.f90 b/src/eDFT/hartree_energy.f90 deleted file mode 100644 index d3f04a3..0000000 --- a/src/eDFT/hartree_energy.f90 +++ /dev/null @@ -1,29 +0,0 @@ -subroutine hartree_energy(nBas,P,J,EH) - -! Compute the unrestricted version of the Hartree energy - - implicit none - include 'parameters.h' - -! Input variables - - integer,intent(in) :: nBas - double precision,intent(in) :: P(nBas,nBas,nspin) - double precision,intent(in) :: J(nBas,nBas,nspin) - -! Local variables - - double precision,external :: trace_matrix - -! Output variables - - double precision,intent(out) :: EH(nsp) - -! Compute the components of the Hartree energy - - EH(1) = 0.5d0*trace_matrix(nBas,matmul(P(:,:,1),J(:,:,1))) - EH(2) = 0.5d0*trace_matrix(nBas,matmul(P(:,:,1),J(:,:,2))) & - + 0.5d0*trace_matrix(nBas,matmul(P(:,:,2),J(:,:,1))) - EH(3) = 0.5d0*trace_matrix(nBas,matmul(P(:,:,2),J(:,:,2))) - -end subroutine hartree_energy diff --git a/src/eDFT/hartree_individual_energy.f90 b/src/eDFT/hartree_individual_energy.f90 deleted file mode 100644 index 5c0b649..0000000 --- a/src/eDFT/hartree_individual_energy.f90 +++ /dev/null @@ -1,55 +0,0 @@ -subroutine hartree_individual_energy(nBas,nEns,Pw,P,ERI,LZH,EH) - -! Compute the hartree contribution to the individual energies - - implicit none - include 'parameters.h' - -! Input variables - - integer,intent(in) :: nBas - integer,intent(in) :: nEns - double precision,intent(in) :: Pw(nBas,nBas,nspin) - double precision,intent(in) :: P(nBas,nBas,nspin,nEns) - double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas) - - -! Local variables - - double precision,allocatable :: J(:,:,:) - double precision,external :: trace_matrix - - integer :: iEns - integer :: ispin - -! Output variables - - double precision,intent(out) :: LZH(nsp) - double precision,intent(out) :: EH(nsp,nEns) - -! Compute HF exchange matrix - - allocate(J(nBas,nBas,nspin)) - - LZH(:) = 0.d0 - EH(:,:) = 0.d0 - - do ispin=1,nspin - call hartree_potential(nBas,Pw(:,:,ispin),ERI,J(:,:,ispin)) - end do - - LZH(1) = - 0.5d0*trace_matrix(nBas,matmul(Pw(:,:,1),J(:,:,1))) - LZH(2) = - 0.5d0*trace_matrix(nBas,matmul(Pw(:,:,1),J(:,:,2))) & - - 0.5d0*trace_matrix(nBas,matmul(Pw(:,:,2),J(:,:,1))) - LZH(3) = - 0.5d0*trace_matrix(nBas,matmul(Pw(:,:,2),J(:,:,2))) - - do iEns=1,nEns - - EH(1,iEns) = trace_matrix(nBas,matmul(P(:,:,1,iEns),J(:,:,1))) - EH(2,iEns) = trace_matrix(nBas,matmul(P(:,:,1,iEns),J(:,:,2))) & - + trace_matrix(nBas,matmul(P(:,:,2,iEns),J(:,:,1))) - EH(3,iEns) = trace_matrix(nBas,matmul(P(:,:,2,iEns),J(:,:,2))) - - end do - -end subroutine hartree_individual_energy diff --git a/src/eDFT/hartree_potential.f90 b/src/eDFT/hartree_potential.f90 deleted file mode 100644 index 0aacdd2..0000000 --- a/src/eDFT/hartree_potential.f90 +++ /dev/null @@ -1,33 +0,0 @@ -subroutine hartree_potential(nBas,P,ERI,J) - -! Compute the unrestricted version of the Hartree potential - - implicit none - -! Input variables - - integer,intent(in) :: nBas - double precision,intent(in) :: P(nBas,nBas) - double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas) - -! Local variables - - integer :: mu,nu,la,si - -! Output variables - - double precision,intent(out) :: J(nBas,nBas) - - J(:,:) = 0d0 - do si=1,nBas - do la=1,nBas - do nu=1,nBas - do mu=1,nBas - J(mu,nu) = J(mu,nu) + P(la,si)*ERI(mu,la,nu,si) - enddo - enddo - enddo - enddo - - -end subroutine hartree_potential diff --git a/src/eDFT/hybrid_correlation_derivative_discontinuity.f90 b/src/eDFT/hybrid_correlation_derivative_discontinuity.f90 deleted file mode 100644 index 40a3bb3..0000000 --- a/src/eDFT/hybrid_correlation_derivative_discontinuity.f90 +++ /dev/null @@ -1,46 +0,0 @@ -subroutine hybrid_correlation_derivative_discontinuity(DFA,nEns,wEns,nGrid,weight,rhow,Ec) - -! Compute the correlation hybrid part of the derivative discontinuity - - implicit none - include 'parameters.h' - -! Input variables - - integer,intent(in) :: DFA - integer,intent(in) :: nEns - double precision,intent(in) :: wEns(nEns) - integer,intent(in) :: nGrid - double precision,intent(in) :: weight(nGrid) - double precision,intent(in) :: rhow(nGrid,nspin) - -! Local variables - -! Output variables - - double precision,intent(out) :: Ec(nsp,nEns) - -! Select correlation functional - - select case (DFA) - - case (1) - - Ec(:,:) = 0d0 - - case (2) - - Ec(:,:) = 0d0 - - case (3) - - Ec(:,:) = 0d0 - - case default - - call print_warning('!!! Hybrid correlation functional not available !!!') - stop - - end select - -end subroutine hybrid_correlation_derivative_discontinuity diff --git a/src/eDFT/hybrid_correlation_energy.f90 b/src/eDFT/hybrid_correlation_energy.f90 deleted file mode 100644 index 4b272ca..0000000 --- a/src/eDFT/hybrid_correlation_energy.f90 +++ /dev/null @@ -1,58 +0,0 @@ -subroutine hybrid_correlation_energy(DFA,nEns,wEns,nGrid,weight,rho,drho,Ec) - -! Compute the unrestricted version of the correlation energy for hybrid functionals - - implicit none - include 'parameters.h' - -! Input variables - - integer,intent(in) :: DFA - integer,intent(in) :: nEns - double precision,intent(in) :: wEns(nEns) - integer,intent(in) :: nGrid - double precision,intent(in) :: weight(nGrid) - double precision,intent(in) :: rho(nGrid,nspin) - double precision,intent(in) :: drho(ncart,nGrid,nspin) - -! Local variables - - double precision :: EcLDA(nsp) - double precision :: EcGGA(nsp) - double precision :: aC - -! Output variables - - double precision,intent(out) :: Ec(nsp) - - select case (DFA) - - case(1) - - Ec(:) = 0d0 - - case(2) - - aC = 0.81d0 - - call lda_correlation_energy(3,nEns,wEns,nGrid,weight,rho,EcLDA) - call gga_correlation_energy(1,nEns,wEns,nGrid,weight,rho,drho,EcGGA) - - Ec(:) = EcLDA(:) + aC*(EcGGA(:) - EcLDA(:)) - - case(3) - - call gga_correlation_energy(1,nEns,wEns,nGrid,weight,rho,drho,Ec) - - case(4) - - call gga_correlation_energy(2,nEns,wEns,nGrid,weight,rho,drho,Ec) - - case default - - call print_warning('!!! Hybrid correlation energy not available !!!') - stop - - end select - -end subroutine hybrid_correlation_energy diff --git a/src/eDFT/hybrid_correlation_individual_energy.f90 b/src/eDFT/hybrid_correlation_individual_energy.f90 deleted file mode 100644 index 6a2214d..0000000 --- a/src/eDFT/hybrid_correlation_individual_energy.f90 +++ /dev/null @@ -1,42 +0,0 @@ -subroutine hybrid_correlation_individual_energy(DFA,nEns,wEns,nGrid,weight, & - rhow,drhow,rho,drho,LZc,Ec) - -! Compute the hybrid correlation energy for individual states - - implicit none - include 'parameters.h' - -! Input variables - - integer,intent(in) :: DFA - integer,intent(in) :: nEns - double precision,intent(in) :: wEns(nEns) - integer,intent(in) :: nGrid - double precision,intent(in) :: weight(nGrid) - double precision,intent(in) :: rhow(nGrid) - double precision,intent(in) :: drhow(ncart,nGrid) - double precision,intent(in) :: rho(nGrid,nEns) - double precision,intent(in) :: drho(ncart,nGrid,nEns) - -! Output variables - - double precision :: LZc(nsp) - double precision :: Ec(nsp,nEns) - -! Select correlation functional - - select case (DFA) - - case (1) - - LZc(:) = 0d0 - Ec(:,:) = 0d0 - - case default - - call print_warning('!!! Hybrid correlation individual energy not available !!!') - stop - - end select - -end subroutine hybrid_correlation_individual_energy diff --git a/src/eDFT/hybrid_correlation_potential.f90 b/src/eDFT/hybrid_correlation_potential.f90 deleted file mode 100644 index 9104a80..0000000 --- a/src/eDFT/hybrid_correlation_potential.f90 +++ /dev/null @@ -1,69 +0,0 @@ -subroutine hybrid_correlation_potential(DFA,nEns,wEns,nGrid,weight,nBas,AO,dAO,rho,drho,Fc) - -! Compute the correlation potential for hybrid functionals - - implicit none - include 'parameters.h' - -! Input variables - - integer,intent(in) :: DFA - integer,intent(in) :: nEns - double precision,intent(in) :: wEns(nEns) - integer,intent(in) :: nGrid - double precision,intent(in) :: weight(nGrid) - integer,intent(in) :: nBas - double precision,intent(in) :: AO(nBas,nGrid) - double precision,intent(in) :: dAO(ncart,nBas,nGrid) - double precision,intent(in) :: rho(nGrid,nspin) - double precision,intent(in) :: drho(ncart,nGrid,nspin) - -! Local variables - - double precision,allocatable :: FcLDA(:,:,:) - double precision,allocatable :: FcGGA(:,:,:) - double precision :: aC - -! Output variables - - double precision,intent(out) :: Fc(nBas,nBas,nspin) - -! Memory allocation - - select case (DFA) - - case(1) - - Fc(:,:,:) = 0d0 - - case(2) - - allocate(FcLDA(nBas,nBas,nspin),FcGGA(nBas,nBas,nspin)) - - aC = 0.81d0 - - call lda_correlation_potential(3,nEns,wEns,nGrid,weight,nBas,AO,rho,FcLDA) - call gga_correlation_potential(1,nEns,wEns,nGrid,weight,nBas,AO,dAO,rho,drho,FcGGA) - - Fc(:,:,:) = FcLDA(:,:,:) + aC*(FcGGA(:,:,:) - FcLDA(:,:,:)) - - case(3) - - allocate(FcGGA(nBas,nBas,nspin)) - - call gga_correlation_potential(1,nEns,wEns,nGrid,weight,nBas,AO,dAO,rho,drho,Fc) - - case(4) - - allocate(FcGGA(nBas,nBas,nspin)) - - call gga_correlation_potential(2,nEns,wEns,nGrid,weight,nBas,AO,dAO,rho,drho,Fc) - - case default - - call print_warning('!!! Hybrid correlation potential not available !!!') - stop - - end select - -end subroutine hybrid_correlation_potential diff --git a/src/eDFT/hybrid_exchange_derivative_discontinuity.f90 b/src/eDFT/hybrid_exchange_derivative_discontinuity.f90 deleted file mode 100644 index 243d85c..0000000 --- a/src/eDFT/hybrid_exchange_derivative_discontinuity.f90 +++ /dev/null @@ -1,53 +0,0 @@ -subroutine hybrid_exchange_derivative_discontinuity(DFA,nEns,wEns,nCC,aCC,nGrid,weight,rhow,& - Cx_choice,doNcentered,ExDD) - -! Compute the exchange part of the derivative discontinuity for hybrid functionals - - implicit none - include 'parameters.h' - -! Input variables - - integer,intent(in) :: DFA - integer,intent(in) :: nEns - double precision,intent(in) :: wEns(nEns) - integer,intent(in) :: nCC - double precision,intent(in) :: aCC(nCC,nEns-1) - - integer,intent(in) :: nGrid - double precision,intent(in) :: weight(nGrid) - double precision,intent(in) :: rhow(nGrid) - integer,intent(in) :: Cx_choice - logical,intent(in) :: doNcentered - -! Local variables - - -! Output variables - - double precision,intent(out) :: ExDD(nEns) - -! Select exchange functional - - select case (DFA) - - case (1) - - ExDD(:) = 0d0 - - case (2) - - ExDD(:) = 0d0 - - case (3) - - ExDD(:) = 0d0 - - case default - - call print_warning('!!! Hybrid exchange derivative discontinuity not available !!!') - stop - - end select - -end subroutine hybrid_exchange_derivative_discontinuity diff --git a/src/eDFT/hybrid_exchange_energy.f90 b/src/eDFT/hybrid_exchange_energy.f90 deleted file mode 100644 index a584f4c..0000000 --- a/src/eDFT/hybrid_exchange_energy.f90 +++ /dev/null @@ -1,77 +0,0 @@ -subroutine hybrid_exchange_energy(DFA,LDA_centered,nEns,wEns,nCC,aCC,nGrid,weight,nBas,P,FxHF, & - rho,drho,Cx_choice,doNcentered,Ex) - -! Compute the exchange energy for hybrid functionals - - implicit none - include 'parameters.h' - -! Input variables - - integer,intent(in) :: DFA - logical,intent(in) :: LDA_centered - integer,intent(in) :: nEns - double precision,intent(in) :: wEns(nEns) - integer,intent(in) :: nCC - double precision,intent(in) :: aCC(nCC,nEns-1) - integer,intent(in) :: nGrid - double precision,intent(in) :: weight(nGrid) - integer,intent(in) :: nBas - double precision,intent(in) :: P(nBas,nBas) - double precision,intent(in) :: FxHF(nBas,nBas) - double precision,intent(in) :: rho(nGrid) - double precision,intent(in) :: drho(ncart,nGrid) - integer,intent(in) :: Cx_choice - logical,intent(in) :: doNcentered - -! Local variables - - double precision :: ExLDA,ExGGA,ExHF - double precision :: a0,aX - -! Output variables - - double precision,intent(out) :: Ex - - select case (DFA) - - case (1) - - call fock_exchange_energy(nBas,P,FxHF,Ex) - - case (2) - - a0 = 0.20d0 - aX = 0.72d0 - - call lda_exchange_energy(1,LDA_centered,nEns,wEns,nCC,aCC,nGrid,weight,& - rho,Cx_choice,doNcentered,ExLDA) - call gga_exchange_energy(2,nEns,wEns,nGrid,weight,rho,drho,ExGGA) - call fock_exchange_energy(nBas,P,FxHF,ExHF) - - Ex = ExLDA & - + a0*(ExHF - ExLDA) & - + aX*(ExGGA - ExLDA) - - case (3) - - call gga_exchange_energy(2,nEns,wEns,nGrid,weight,rho,drho,ExGGA) - call fock_exchange_energy(nBas,P,FxHF,ExHF) - - Ex = 0.5d0*ExHF + 0.5d0*ExGGA - - case (4) - - call gga_exchange_energy(3,nEns,wEns,nGrid,weight,rho,drho,ExGGA) - call fock_exchange_energy(nBas,P,FxHF,ExHF) - - Ex = 0.25d0*ExHF + 0.75d0*ExGGA - - case default - - call print_warning('!!! Hybrid exchange energy not available !!!') - stop - - end select - -end subroutine hybrid_exchange_energy diff --git a/src/eDFT/hybrid_exchange_individual_energy.f90 b/src/eDFT/hybrid_exchange_individual_energy.f90 deleted file mode 100644 index f3b4199..0000000 --- a/src/eDFT/hybrid_exchange_individual_energy.f90 +++ /dev/null @@ -1,46 +0,0 @@ -subroutine hybrid_exchange_individual_energy(DFA,nEns,wEns,nGrid,weight,nBas,ERI,Pw,rhow,drhow, & - P,rho,drho,LZx,Ex) - -! Compute the hybrid exchange energy for individual states - - implicit none - include 'parameters.h' - -! Input variables - - integer,intent(in) :: DFA - integer,intent(in) :: nEns - double precision,intent(in) :: wEns(nEns) - integer,intent(in) :: nGrid - double precision,intent(in) :: weight(nGrid) - double precision,intent(in) :: rhow(nGrid,nspin) - double precision,intent(in) :: drhow(ncart,nGrid,nspin) - double precision,intent(in) :: rho(nGrid,nspin,nEns) - double precision,intent(in) :: drho(ncart,nGrid,nspin,nEns) - - integer,intent(in) :: nBas - double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas) - double precision,intent(in) :: Pw(nBas,nBas) - double precision,intent(in) :: P(nBas,nBas,nEns) - -! Output variables - - double precision :: LZx(nspin) - double precision :: Ex(nspin,nEns) - -! Select correlation functional - - select case (DFA) - - case (1) - - call fock_exchange_individual_energy(nBas,nEns,Pw,P,ERI,LZx,Ex) - - case default - - call print_warning('!!! Hybrid exchange individual energy not available !!!') - stop - - end select - -end subroutine hybrid_exchange_individual_energy diff --git a/src/eDFT/hybrid_exchange_potential.f90 b/src/eDFT/hybrid_exchange_potential.f90 deleted file mode 100644 index 5dfb81c..0000000 --- a/src/eDFT/hybrid_exchange_potential.f90 +++ /dev/null @@ -1,91 +0,0 @@ -subroutine hybrid_exchange_potential(DFA,LDA_centered,nEns,wEns,nCC,aCC,nGrid,weight,nBas,P, & - ERI,AO,dAO,rho,drho,Cx_choice,doNcentered,Fx,FxHF) - -! Compute the exchange potential for hybrid functionals - - implicit none - include 'parameters.h' - -! Input variables - - integer,intent(in) :: DFA - logical,intent(in) :: LDA_centered - integer,intent(in) :: nEns - double precision,intent(in) :: wEns(nEns) - integer,intent(in) :: nCC - double precision,intent(in) :: aCC(nCC,nEns-1) - integer,intent(in) :: nGrid - double precision,intent(in) :: weight(nGrid) - integer,intent(in) :: nBas - double precision,intent(in) :: P(nBas,nBas) - double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas) - double precision,intent(in) :: AO(nBas,nGrid) - double precision,intent(in) :: dAO(ncart,nBas,nGrid) - double precision,intent(in) :: rho(nGrid) - double precision,intent(in) :: drho(ncart,nGrid) - integer,intent(in) :: Cx_choice - logical,intent(in) :: doNcentered - -! Local variables - - double precision,allocatable :: FxLDA(:,:) - double precision,allocatable :: FxGGA(:,:) - double precision :: a0 - double precision :: aX - -! Output variables - - double precision,intent(out) :: Fx(nBas,nBas) - double precision,intent(out) :: FxHF(nBas,nBas) - -! Memory allocation - - select case (DFA) - - case(1) - - call fock_exchange_potential(nBas,P,ERI,FxHF) - Fx(:,:) = FxHF(:,:) - - case(2) - - allocate(FxLDA(nBas,nBas),FxGGA(nBas,nBas)) - - a0 = 0.20d0 - aX = 0.72d0 - - call lda_exchange_potential(1,LDA_centered,nEns,wEns,nCC,aCC,nGrid,weight, & - nBas,AO,rho,Cx_choice,doNcentered,FxLDA) - call gga_exchange_potential(2,nEns,wEns,nGrid,weight,nBas,AO,dAO,rho,drho,FxGGA) - call fock_exchange_potential(nBas,P,ERI,FxHF) - - Fx(:,:) = FxLDA(:,:) & - + a0*(FxHF(:,:) - FxLDA(:,:)) & - + aX*(FxGGA(:,:) - FxLDA(:,:)) - - case(3) - - allocate(FxGGA(nBas,nBas)) - - call gga_exchange_potential(2,nEns,wEns,nGrid,weight,nBas,AO,dAO,rho,drho,FxGGA) - call fock_exchange_potential(nBas,P,ERI,FxHF) - - Fx(:,:) = 0.5d0*FxHF(:,:) + 0.5d0*FxGGA(:,:) - - case(4) - - allocate(FxGGA(nBas,nBas)) - - call gga_exchange_potential(3,nEns,wEns,nGrid,weight,nBas,AO,dAO,rho,drho,FxGGA) - call fock_exchange_potential(nBas,P,ERI,FxHF) - - Fx(:,:) = 0.25d0*FxHF(:,:) + 0.75d0*FxGGA(:,:) - - case default - - call print_warning('!!! Hybrid exchange potential not available !!!') - stop - - end select - -end subroutine hybrid_exchange_potential diff --git a/src/eDFT/individual_energy.f90 b/src/eDFT/individual_energy.f90 deleted file mode 100644 index b546bab..0000000 --- a/src/eDFT/individual_energy.f90 +++ /dev/null @@ -1,241 +0,0 @@ -subroutine individual_energy(x_rung,x_DFA,c_rung,c_DFA,LDA_centered,nEns,wEns,nCC,aCC,nGrid,weight,nBas,AO,dAO, & - T,V,ERI,ENuc,eKS,Pw,rhow,drhow,J,Fx,FxHF,Fc,P,rho,drho,occnum,Cx_choice,doNcentered,Ew) - -! Compute unrestricted individual energies as well as excitation energies - - implicit none - include 'parameters.h' - -! Input variables - - integer,intent(in) :: x_rung,c_rung - integer,intent(in) :: x_DFA,c_DFA - logical,intent(in) :: LDA_centered - integer,intent(in) :: nEns - double precision,intent(in) :: wEns(nEns) - integer,intent(in) :: nCC - double precision,intent(in) :: aCC(nCC,nEns-1) - integer,intent(in) :: nGrid - double precision,intent(in) :: weight(nGrid) - integer,intent(in) :: nBas - double precision,intent(in) :: AO(nBas,nGrid) - double precision,intent(in) :: dAO(ncart,nBas,nGrid) - - double precision,intent(in) :: T(nBas,nBas) - double precision,intent(in) :: V(nBas,nBas) - double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas) - double precision,intent(in) :: ENuc - - double precision,intent(in) :: eKS(nBas,nspin) - double precision,intent(in) :: Pw(nBas,nBas,nspin) - double precision,intent(in) :: rhow(nGrid,nspin) - double precision,intent(in) :: drhow(ncart,nGrid,nspin) - - double precision,intent(in) :: P(nBas,nBas,nspin,nEns) - double precision,intent(in) :: rho(nGrid,nspin,nEns) - double precision,intent(in) :: drho(ncart,nGrid,nspin,nEns) - - double precision,intent(inout):: J(nBas,nBas,nspin) - double precision,intent(inout):: Fx(nBas,nBas,nspin) - double precision,intent(inout):: FxHF(nBas,nBas,nspin) - double precision,intent(inout):: Fc(nBas,nBas,nspin) - double precision,intent(in) :: Ew - double precision,intent(in) :: occnum(nBas,nspin,nEns) - integer,intent(in) :: Cx_choice - logical,intent(in) :: doNcentered - - -! Local variables - - double precision :: ET(nspin,nEns) - double precision :: EV(nspin,nEns) - double precision :: EH(nsp,nEns) - double precision :: Ex(nspin,nEns) - double precision :: Ec(nsp,nEns) - double precision :: LZH(nsp) - double precision :: LZx(nspin) - double precision :: LZc(nsp) - double precision :: Eaux(nspin,nEns) - - double precision :: ExDD(nspin,nEns) - double precision :: EcDD(nsp,nEns) - - double precision :: OmH(nEns) - double precision :: Omx(nEns) - double precision :: Omc(nEns) - double precision :: Omaux(nEns) - double precision :: OmxDD(nEns) - double precision :: OmcDD(nEns) - - double precision,external :: trace_matrix - - integer :: ispin,iEns,iBas - double precision,allocatable :: nEl(:) - double precision,allocatable :: kappa(:) - - double precision :: E(nEns) - double precision :: Om(nEns) - - double precision,external :: electron_number - -! Compute scaling factor for N-centered ensembles - - allocate(nEl(nEns),kappa(nEns)) - - nEl(:) = 0d0 - do iEns=1,nEns - do iBas=1,nBas - do ispin=1,nspin - nEl(iEns) = nEl(iEns) + occnum(iBas,ispin,iEns) - end do - end do - kappa(iEns) = nEl(iEns)/nEl(1) - end do - -!------------------------------------------------------------------------ -! Kinetic energy -!------------------------------------------------------------------------ - - do ispin=1,nspin - do iEns=1,nEns - ET(ispin,iEns) = trace_matrix(nBas,matmul(P(:,:,ispin,iEns),T(:,:))) - end do - end do - -!------------------------------------------------------------------------ -! Potential energy -!------------------------------------------------------------------------ - - do iEns=1,nEns - do ispin=1,nspin - EV(ispin,iEns) = trace_matrix(nBas,matmul(P(:,:,ispin,iEns),V(:,:))) - end do - end do - -!------------------------------------------------------------------------ -! Individual Hartree energy -!------------------------------------------------------------------------ - - LZH(:) = 0d0 - EH(:,:) = 0d0 - call hartree_individual_energy(nBas,nEns,Pw,P,ERI,LZH,EH) - -!------------------------------------------------------------------------ -! Individual exchange energy -!------------------------------------------------------------------------ - - LZx(:) = 0d0 - Ex(:,:) = 0d0 - call exchange_individual_energy(x_rung,x_DFA,LDA_centered,nEns,wEns,nCC,aCC,nGrid,weight,nBas,ERI, & - Pw,rhow,drhow,P,rho,drho,Cx_choice,doNcentered,LZx,Ex) - -!------------------------------------------------------------------------ -! Individual correlation energy -!------------------------------------------------------------------------ - - LZc(:) = 0d0 - Ec(:,:) = 0d0 - call correlation_individual_energy(c_rung,c_DFA,LDA_centered,nEns,wEns,nGrid,weight, & - rhow,drhow,rho,drho,LZc,Ec) - -!------------------------------------------------------------------------ -! Compute auxiliary energies -!------------------------------------------------------------------------ - - call auxiliary_energy(nBas,nEns,eKS,occnum,Eaux) - -!------------------------------------------------------------------------ -! Compute derivative discontinuities -!------------------------------------------------------------------------ - - do ispin=1,nspin - call exchange_derivative_discontinuity(x_rung,x_DFA,nEns,wEns,nCC,aCC,nGrid,weight, & - rhow(:,ispin),drhow(:,:,ispin),Cx_choice,& - doNcentered,kappa,ExDD(ispin,:)) - end do - - call correlation_derivative_discontinuity(c_rung,c_DFA,nEns,wEns,nGrid,weight,rhow,drhow,EcDD) - -! Scaling derivative discontinuity for N-centered ensembles - -! if(doNcentered) then - -! do iEns=1,nEns -! ExDD(:,iEns) = (1d0 - kappa(iEns))*ExDD(:,iEns) -! EcDD(:,iEns) = (1d0 - kappa(iEns))*EcDD(:,iEns) -! end do - -! end if - -!------------------------------------------------------------------------ -! Total energy -!------------------------------------------------------------------------ - - if(doNcentered) then - - do iEns=1,nEns - E(iEns) = sum(Eaux(:,iEns)) & - + kappa(iEns)*(sum(LZH(:)) + sum(LZx(:)) + sum(LZc(:))) & - + sum(ExDD(:,iEns)) + sum(EcDD(:,iEns)) - end do - - else - - do iEns=1,nEns - E(iEns) = sum(Eaux(:,iEns)) & - + sum(LZH(:)) + sum(LZx(:)) + sum(LZc(:)) & - + sum(ExDD(:,iEns)) + sum(EcDD(:,iEns)) - end do - - end if - -print*,'LZshift=',sum(LZH(:)) + sum(LZx(:)) + sum(LZc(:)) - -! do iEns=1,nEns -! E(iEns) = sum(ET(:,iEns)) + sum(EV(:,iEns)) & -! + sum(EH(:,iEns)) + sum(Ex(:,iEns)) + sum(Ec(:,iEns)) & -! + sum(LZH(:)) + sum(LZx(:)) + sum(LZc(:)) & -! + sum(ExDD(:,iEns)) + sum(EcDD(:,iEns)) -! end do - -!------------------------------------------------------------------------ -! Excitation energies -!------------------------------------------------------------------------ - - do iEns=1,nEns - - Om(iEns) = E(iEns) - E(1) - - OmH(iEns) = sum(EH(:,iEns)) - sum(EH(:,1)) - Omx(iEns) = sum(Ex(:,iEns)) - sum(Ex(:,1)) - Omc(iEns) = sum(Ec(:,iEns)) - sum(Ec(:,1)) - - Omaux(iEns) = sum(Eaux(:,iEns)) - sum(Eaux(:,1)) - - OmxDD(iEns) = sum(ExDD(:,iEns)) - sum(ExDD(:,1)) - OmcDD(iEns) = sum(EcDD(:,iEns)) - sum(EcDD(:,1)) - - end do - - if(doNcentered) then - - do iEns=1,nEns - OmH(iEns) = OmH(iEns) + (kappa(iEns) - kappa(1))*sum(LZH(:)) - Omx(iEns) = Omx(iEns) + (kappa(iEns) - kappa(1))*sum(LZx(:)) - Omc(iEns) = Omc(iEns) + (kappa(iEns) - kappa(1))*sum(LZc(:)) - - Omaux(iEns) = Omaux(iEns) & - + (kappa(iEns) - kappa(1))*(sum(LZH(:)) + sum(LZx(:)) + sum(LZc(:))) - - end do - - end if - -!------------------------------------------------------------------------ -! Dump results -!------------------------------------------------------------------------ - - call print_individual_energy(nEns,ENuc,Ew,ET,EV,EH,Ex,Ec,Eaux,LZH,LZx,LZc,ExDD,EcDD,E, & - Om,OmH,Omx,Omc,Omaux,OmxDD,OmcDD) - -end subroutine individual_energy diff --git a/src/eDFT/lda_correlation_derivative_discontinuity.f90 b/src/eDFT/lda_correlation_derivative_discontinuity.f90 deleted file mode 100644 index 3229bf4..0000000 --- a/src/eDFT/lda_correlation_derivative_discontinuity.f90 +++ /dev/null @@ -1,52 +0,0 @@ -subroutine lda_correlation_derivative_discontinuity(DFA,nEns,wEns,nGrid,weight,rhow,Ec) - -! Compute the correlation LDA part of the derivative discontinuity - - implicit none - include 'parameters.h' - -! Input variables - - integer,intent(in) :: DFA - integer,intent(in) :: nEns - double precision,intent(in) :: wEns(nEns) - integer,intent(in) :: nGrid - double precision,intent(in) :: weight(nGrid) - double precision,intent(in) :: rhow(nGrid,nspin) - -! Local variables - - double precision :: aC - -! Output variables - - double precision,intent(out) :: Ec(nsp,nEns) - -! Select correlation functional - - select case (DFA) - - case (1) - - Ec(:,:) = 0d0 - - case (2) - - Ec(:,:) = 0d0 - - case (3) - - Ec(:,:) = 0d0 - - case (4) - - Ec(:,:) = 0d0 - - case default - - call print_warning('!!! LDA correlation functional not available !!!') - stop - - end select - -end subroutine lda_correlation_derivative_discontinuity diff --git a/src/eDFT/lda_correlation_energy.f90 b/src/eDFT/lda_correlation_energy.f90 deleted file mode 100644 index d6bb7ee..0000000 --- a/src/eDFT/lda_correlation_energy.f90 +++ /dev/null @@ -1,52 +0,0 @@ -subroutine lda_correlation_energy(DFA,nEns,wEns,nGrid,weight,rho,Ec) - -! Select the unrestrited version of the LDA correlation functional - - implicit none - include 'parameters.h' - -! Input variables - - integer,intent(in) :: DFA - integer,intent(in) :: nEns - double precision,intent(in) :: wEns(nEns) - integer,intent(in) :: nGrid - double precision,intent(in) :: weight(nGrid) - double precision,intent(in) :: rho(nGrid,nspin) - -! Output variables - - double precision,intent(out) :: Ec(nsp) - -! Select correlation functional - - select case (DFA) - - case (1) - - call W38_lda_correlation_energy(nGrid,weight,rho,Ec) - - case (2) - - call PW92_lda_correlation_energy(nGrid,weight,rho,Ec) - - case (3) - - call VWN3_lda_correlation_energy(nGrid,weight,rho,Ec) - - case (4) - - call VWN5_lda_correlation_energy(nGrid,weight,rho,Ec) - - case (5) - - call C16_lda_correlation_energy(nGrid,weight,rho,Ec) - - case default - - call print_warning('!!! LDA correlation functional not available !!!') - stop - - end select - -end subroutine lda_correlation_energy diff --git a/src/eDFT/lda_correlation_individual_energy.f90 b/src/eDFT/lda_correlation_individual_energy.f90 deleted file mode 100644 index 98b3b4f..0000000 --- a/src/eDFT/lda_correlation_individual_energy.f90 +++ /dev/null @@ -1,51 +0,0 @@ -subroutine lda_correlation_individual_energy(DFA,LDA_centered,nEns,wEns,nGrid,weight,rhow,rho,LZc,Ec) - -! Compute LDA correlation energy for individual states - - implicit none - include 'parameters.h' - -! Input variables - - logical,intent(in) :: LDA_centered - integer,intent(in) :: DFA - integer,intent(in) :: nEns - double precision,intent(in) :: wEns(nEns) - integer,intent(in) :: nGrid - double precision,intent(in) :: weight(nGrid) - double precision,intent(in) :: rhow(nGrid,nspin) - double precision,intent(in) :: rho(nGrid,nspin,nEns) - -! Output variables - - double precision :: LZc(nsp) - double precision :: Ec(nsp,nEns) - -! Select correlation functional - - select case (DFA) - - case (1) - -! call W38_lda_correlation_individual_energy(nGrid,weight,rhow,rho,LZc,Ec) - - case (2) - -! call PW92_lda_correlation_individual_energy(nGrid,weight,rhow,rho,LZc,Ec) - - case (3) - -! call VWN3_lda_correlation_individual_energy(nEns,nGrid,weight,rhow,rho,LZc,Ec) - - case (4) - - call VWN5_lda_correlation_individual_energy(nEns,nGrid,weight,rhow,rho,LZc,Ec) - - case default - - call print_warning('!!! LDA correlation functional not available !!!') - stop - - end select - -end subroutine lda_correlation_individual_energy diff --git a/src/eDFT/lda_correlation_potential.f90 b/src/eDFT/lda_correlation_potential.f90 deleted file mode 100644 index e50b033..0000000 --- a/src/eDFT/lda_correlation_potential.f90 +++ /dev/null @@ -1,56 +0,0 @@ -subroutine lda_correlation_potential(DFA,nEns,wEns,nGrid,weight,nBas,AO,rho,Fc) - -! Select LDA correlation potential - - implicit none -include 'parameters.h' - -! Input variables - - integer,intent(in) :: DFA - integer,intent(in) :: nEns - double precision,intent(in) :: wEns(nEns) - integer,intent(in) :: nGrid - double precision,intent(in) :: weight(nGrid) - integer,intent(in) :: nBas - double precision,intent(in) :: AO(nBas,nGrid) - double precision,intent(in) :: rho(nGrid,nspin) - -! Output variables - - double precision,intent(out) :: Fc(nBas,nBas,nspin) - -! Select correlation functional - - select case (DFA) - -! Hartree-Fock - - case (1) - - call W38_lda_correlation_potential(nGrid,weight(:),nBas,AO(:,:),rho(:,:),Fc(:,:,:)) - - case (2) - - call PW92_lda_correlation_potential(nGrid,weight(:),nBas,AO(:,:),rho(:,:),Fc(:,:,:)) - - case (3) - - call VWN3_lda_correlation_potential(nGrid,weight(:),nBas,AO(:,:),rho(:,:),Fc(:,:,:)) - - case (4) - - call VWN5_lda_correlation_potential(nGrid,weight(:),nBas,AO(:,:),rho(:,:),Fc(:,:,:)) - - case (5) - - call C16_lda_correlation_potential(nGrid,weight(:),nBas,AO(:,:),rho(:,:),Fc(:,:,:)) - - case default - - call print_warning('!!! LDA correlation functional not available !!!') - stop - - end select - -end subroutine lda_correlation_potential diff --git a/src/eDFT/lda_exchange_derivative_discontinuity.f90 b/src/eDFT/lda_exchange_derivative_discontinuity.f90 deleted file mode 100644 index 5065d69..0000000 --- a/src/eDFT/lda_exchange_derivative_discontinuity.f90 +++ /dev/null @@ -1,51 +0,0 @@ -subroutine lda_exchange_derivative_discontinuity(DFA,nEns,wEns,nCC,aCC,nGrid,weight,rhow,& - Cx_choice,doNcentered,kappa,ExDD) - -! Compute the exchange LDA part of the derivative discontinuity - - implicit none - include 'parameters.h' - -! Input variables - - integer,intent(in) :: DFA - integer,intent(in) :: nEns - double precision,intent(in) :: wEns(nEns) - integer,intent(in) :: nCC - double precision,intent(in) :: aCC(nCC,nEns-1) - - integer,intent(in) :: nGrid - double precision,intent(in) :: weight(nGrid) - double precision,intent(in) :: rhow(nGrid) - integer,intent(in) :: Cx_choice - logical,intent(in) :: doNcentered - double precision,intent(in) :: kappa(nEns) - -! Local variables - - -! Output variables - - double precision,intent(out) :: ExDD(nEns) - -! Select exchange functional - - select case (DFA) - - case (1) - - ExDD(:) = 0d0 - - case (2) - - call CC_lda_exchange_derivative_discontinuity(nEns,wEns,nCC,aCC,nGrid,weight,rhow,& - Cx_choice,doNcentered,kappa,ExDD) - - case default - - call print_warning('!!! LDA exchange derivative discontinuity not available !!!') - stop - - end select - -end subroutine lda_exchange_derivative_discontinuity diff --git a/src/eDFT/lda_exchange_energy.f90 b/src/eDFT/lda_exchange_energy.f90 deleted file mode 100644 index e92b0cc..0000000 --- a/src/eDFT/lda_exchange_energy.f90 +++ /dev/null @@ -1,46 +0,0 @@ -subroutine lda_exchange_energy(DFA,LDA_centered,nEns,wEns,nCC,aCC,nGrid,weight,rho,Cx_choice,doNcentered,Ex) - -! Select LDA exchange functional - - implicit none - include 'parameters.h' - -! Input variables - - integer,intent(in) :: DFA - logical,intent(in) :: LDA_centered - integer,intent(in) :: nEns - double precision,intent(in) :: wEns(nEns) - integer,intent(in) :: nCC - double precision,intent(in) :: aCC(nCC,nEns-1) - integer,intent(in) :: nGrid - double precision,intent(in) :: weight(nGrid) - double precision,intent(in) :: rho(nGrid) - integer,intent(in) :: Cx_choice - logical,intent(in) :: doNcentered - -! Output variables - - double precision,intent(out) :: Ex - -! Select correlation functional - - select case (DFA) - - case (1) - - call S51_lda_exchange_energy(nGrid,weight,rho,Ex) - - case (2) - - call CC_lda_exchange_energy(nEns,wEns,nCC,aCC,nGrid,weight,rho,Cx_choice,doNcentered,Ex) - - case default - - call print_warning('!!! LDA exchange energy not available !!!') - - stop - - end select - -end subroutine lda_exchange_energy diff --git a/src/eDFT/lda_exchange_individual_energy.f90 b/src/eDFT/lda_exchange_individual_energy.f90 deleted file mode 100644 index 43cdf86..0000000 --- a/src/eDFT/lda_exchange_individual_energy.f90 +++ /dev/null @@ -1,49 +0,0 @@ -subroutine lda_exchange_individual_energy(DFA,LDA_centered,nEns,wEns,nCC,aCC,nGrid,weight,rhow,& - rho,Cx_choice,doNcentered,LZx,Ex) - -! Compute LDA exchange energy for individual states - - implicit none - include 'parameters.h' - -! Input variables - - logical,intent(in) :: LDA_centered - integer,intent(in) :: DFA - integer,intent(in) :: nEns - double precision,intent(in) :: wEns(nEns) - integer,intent(in) :: nCC - double precision,intent(in) :: aCC(nCC,nEns-1) - integer,intent(in) :: nGrid - double precision,intent(in) :: weight(nGrid) - double precision,intent(in) :: rhow(nGrid,nspin) - double precision,intent(in) :: rho(nGrid,nspin,nEns) - integer,intent(in) :: Cx_choice - logical,intent(in) :: doNcentered - -! Output variables - - double precision :: LZx(nspin) - double precision :: Ex(nspin,nEns) - -! Select correlation functional - - select case (DFA) - - case (1) - - call S51_lda_exchange_individual_energy(nEns,nGrid,weight,rhow,rho,LZx,Ex) - - case (2) - - call CC_lda_exchange_individual_energy(nEns,wEns,nCC,aCC,nGrid,weight,rhow,rho, & - Cx_choice,doNcentered,LZx,Ex) - - case default - - call print_warning('!!! LDA exchange individual energy not available !!!') - stop - - end select - -end subroutine lda_exchange_individual_energy diff --git a/src/eDFT/lda_exchange_potential.f90 b/src/eDFT/lda_exchange_potential.f90 deleted file mode 100644 index 0abc0d1..0000000 --- a/src/eDFT/lda_exchange_potential.f90 +++ /dev/null @@ -1,49 +0,0 @@ -subroutine lda_exchange_potential(DFA,LDA_centered,nEns,wEns,nCC,aCC,nGrid,weight,nBas,AO,rho, & - Cx_choice,doNcentered,Fx) - -! Select LDA correlation potential - - implicit none - - include 'parameters.h' - -! Input variables - - logical,intent(in) :: LDA_centered - integer,intent(in) :: DFA - integer,intent(in) :: nEns - double precision,intent(in) :: wEns(nEns) - integer,intent(in) :: nCC - double precision,intent(in) :: aCC(nCC,nEns-1) - integer,intent(in) :: nGrid - double precision,intent(in) :: weight(nGrid) - integer,intent(in) :: nBas - double precision,intent(in) :: AO(nBas,nGrid) - double precision,intent(in) :: rho(nGrid) - integer,intent(in) :: Cx_choice - logical,intent(in) :: doNcentered - -! Output variables - - double precision,intent(out) :: Fx(nBas,nBas) - -! Select exchange functional - - select case (DFA) - - case (1) - - call S51_lda_exchange_potential(nGrid,weight,nBas,AO,rho,Fx) - - case (2) - - call CC_lda_exchange_potential(nEns,wEns,nCC,aCC,nGrid,weight,nBas,AO,rho,Cx_choice,doNcentered,Fx) - - case default - - call print_warning('!!! LDA exchange potential not available !!!') - stop - - end select - -end subroutine lda_exchange_potential diff --git a/src/eDFT/mgga_correlation_derivative_discontinuity.f90 b/src/eDFT/mgga_correlation_derivative_discontinuity.f90 deleted file mode 100644 index 9050407..0000000 --- a/src/eDFT/mgga_correlation_derivative_discontinuity.f90 +++ /dev/null @@ -1,34 +0,0 @@ -subroutine mgga_correlation_derivative_discontinuity(DFA,nEns,wEns,nGrid,weight,rhow,Ec) - -! Compute the correlation MGGA part of the derivative discontinuity - - implicit none - include 'parameters.h' - -! Input variables - - integer,intent(in) :: DFA - integer,intent(in) :: nEns - double precision,intent(in) :: wEns(nEns) - integer,intent(in) :: nGrid - double precision,intent(in) :: weight(nGrid) - double precision,intent(in) :: rhow(nGrid,nspin) - -! Local variables - -! Output variables - - double precision,intent(out) :: Ec(nsp,nEns) - -! Select correlation functional - - select case (DFA) - - case default - - call print_warning('!!! MGGA correlation functional not available !!!') - stop - - end select - -end subroutine mgga_correlation_derivative_discontinuity diff --git a/src/eDFT/mgga_correlation_energy.f90 b/src/eDFT/mgga_correlation_energy.f90 deleted file mode 100644 index d6b1f7a..0000000 --- a/src/eDFT/mgga_correlation_energy.f90 +++ /dev/null @@ -1,36 +0,0 @@ -subroutine mgga_correlation_energy(DFA,nEns,wEns,nGrid,weight,rho,drho,Ec) - -! Compute unrestricted MGGA correlation energy - - implicit none - include 'parameters.h' - -! Input variables - - integer,intent(in) :: DFA - integer,intent(in) :: nEns - double precision,intent(in) :: wEns(nEns) - integer,intent(in) :: nGrid - double precision,intent(in) :: weight(nGrid) - double precision,intent(in) :: rho(nGrid,nspin) - double precision,intent(in) :: drho(ncart,nGrid,nspin) - -! Local variables - - integer :: iG - double precision :: ra,rb,ga,gb - -! Output variables - - double precision :: Ec(nsp) - - select case (DFA) - - case default - - call print_warning('!!! MGGA correlation energy not available !!!') - stop - - end select - -end subroutine mgga_correlation_energy diff --git a/src/eDFT/mgga_correlation_potential.f90 b/src/eDFT/mgga_correlation_potential.f90 deleted file mode 100644 index 642fd8f..0000000 --- a/src/eDFT/mgga_correlation_potential.f90 +++ /dev/null @@ -1,38 +0,0 @@ -subroutine mgga_correlation_potential(DFA,nEns,wEns,nGrid,weight,nBas,AO,dAO,rho,drho,Fc) - -! Compute unrestricted MGGA correlation potential - - implicit none - include 'parameters.h' - -! Input variables - - integer,intent(in) :: DFA - integer,intent(in) :: nEns - double precision,intent(in) :: wEns(nEns) - integer,intent(in) :: nGrid - double precision,intent(in) :: weight(nGrid) - integer,intent(in) :: nBas - double precision,intent(in) :: AO(nBas,nGrid) - double precision,intent(in) :: dAO(3,nBas,nGrid) - double precision,intent(in) :: rho(nGrid,nspin) - double precision,intent(in) :: drho(3,nGrid,nspin) - -! Local variables - -! Output variables - - double precision,intent(out) :: Fc(nBas,nBas,nspin) - -! Select MGGA exchange functional - - select case (DFA) - - case default - - call print_warning('!!! MGGA correlation potential not available !!!') - stop - - end select - -end subroutine mgga_correlation_potential diff --git a/src/eDFT/mgga_exchange_derivative_discontinuity.f90 b/src/eDFT/mgga_exchange_derivative_discontinuity.f90 deleted file mode 100644 index 5131d20..0000000 --- a/src/eDFT/mgga_exchange_derivative_discontinuity.f90 +++ /dev/null @@ -1,36 +0,0 @@ -subroutine mgga_exchange_derivative_discontinuity(DFA,nEns,wEns,nGrid,weight,rhow,drhow,ExDD) - -! Compute the exchange MGGA part of the derivative discontinuity - - implicit none - include 'parameters.h' - -! Input variables - - integer,intent(in) :: DFA - integer,intent(in) :: nEns - double precision,intent(in) :: wEns(nEns) - integer,intent(in) :: nGrid - double precision,intent(in) :: weight(nGrid) - double precision,intent(in) :: rhow(nGrid) - double precision,intent(in) :: drhow(ncart,nGrid) - -! Local variables - - -! Output variables - - double precision,intent(out) :: ExDD(nEns) - -! Select exchange functional - - select case (DFA) - - case default - - call print_warning('!!! MGGA exchange derivative discontinuity not available !!!') - stop - - end select - -end subroutine mgga_exchange_derivative_discontinuity diff --git a/src/eDFT/mgga_exchange_energy.f90 b/src/eDFT/mgga_exchange_energy.f90 deleted file mode 100644 index c8f83af..0000000 --- a/src/eDFT/mgga_exchange_energy.f90 +++ /dev/null @@ -1,32 +0,0 @@ -subroutine mgga_exchange_energy(DFA,nEns,wEns,nGrid,weight,rho,drho,Ex) - -! Select MGGA exchange functional for energy calculation - - implicit none - - include 'parameters.h' - -! Input variables - - integer,intent(in) :: DFA - integer,intent(in) :: nEns - double precision,intent(in) :: wEns(nEns) - integer,intent(in) :: nGrid - double precision,intent(in) :: weight(nGrid) - double precision,intent(in) :: rho(nGrid) - double precision,intent(in) :: drho(ncart,nGrid) - -! Output variables - - double precision :: Ex - - select case (DFA) - - case default - - call print_warning('!!! MGGA exchange energy not available !!!') - stop - - end select - -end subroutine mgga_exchange_energy diff --git a/src/eDFT/mgga_exchange_individual_energy.f90 b/src/eDFT/mgga_exchange_individual_energy.f90 deleted file mode 100644 index 08c837c..0000000 --- a/src/eDFT/mgga_exchange_individual_energy.f90 +++ /dev/null @@ -1,36 +0,0 @@ -subroutine mgga_exchange_individual_energy(DFA,nEns,wEns,nGrid,weight,rhow,drhow,rho,drho,LZx,Ex) - -! Compute MGGA exchange energy for individual states - - implicit none - include 'parameters.h' - -! Input variables - - integer,intent(in) :: DFA - integer,intent(in) :: nEns - double precision,intent(in) :: wEns(nEns) - integer,intent(in) :: nGrid - double precision,intent(in) :: weight(nGrid) - double precision,intent(in) :: rhow(nGrid,nspin) - double precision,intent(in) :: drhow(ncart,nGrid,nspin) - double precision,intent(in) :: rho(nGrid,nspin,nEns) - double precision,intent(in) :: drho(ncart,nGrid,nspin,nEns) - -! Output variables - - double precision :: LZx(nspin) - double precision :: Ex(nspin,nEns) - -! Select correlation functional - - select case (DFA) - - case default - - call print_warning('!!! MGGA exchange individual energy not available !!!') - stop - - end select - -end subroutine mgga_exchange_individual_energy diff --git a/src/eDFT/mgga_exchange_potential.f90 b/src/eDFT/mgga_exchange_potential.f90 deleted file mode 100644 index 15a6e12..0000000 --- a/src/eDFT/mgga_exchange_potential.f90 +++ /dev/null @@ -1,36 +0,0 @@ -subroutine mgga_exchange_potential(DFA,nEns,wEns,nGrid,weight,nBas,AO,dAO,rho,drho,Fx) - -! Select MGGA exchange functional for potential calculation - - implicit none - include 'parameters.h' - -! Input variables - - integer,intent(in) :: DFA - integer,intent(in) :: nEns - double precision,intent(in) :: wEns(nEns) - integer,intent(in) :: nGrid - double precision,intent(in) :: weight(nGrid) - integer,intent(in) :: nBas - double precision,intent(in) :: AO(nBas,nGrid) - double precision,intent(in) :: dAO(3,nBas,nGrid) - double precision,intent(in) :: rho(nGrid) - double precision,intent(in) :: drho(3,nGrid) - -! Output variables - - double precision,intent(out) :: Fx(nBas,nBas) - -! Select MGGA exchange functional - - select case (DFA) - - case default - - call print_warning('!!! MGGA exchange potential not available !!!') - stop - - end select - -end subroutine mgga_exchange_potential diff --git a/src/eDFT/obj/.gitignore b/src/eDFT/obj/.gitignore deleted file mode 100644 index 5761abc..0000000 --- a/src/eDFT/obj/.gitignore +++ /dev/null @@ -1 +0,0 @@ -*.o diff --git a/src/eDFT/one_electron_density.f90 b/src/eDFT/one_electron_density.f90 deleted file mode 100644 index ee6a654..0000000 --- a/src/eDFT/one_electron_density.f90 +++ /dev/null @@ -1,47 +0,0 @@ -subroutine one_electron_density(nGrid,nBas,P,AO,dAO,rho,drho) - -! Calculate one-electron density - - implicit none - include 'parameters.h' - -! Input variables - - integer,intent(in) :: nGrid - integer,intent(in) :: nBas - double precision,intent(in) :: P(nBas,nBas) - double precision,intent(in) :: AO(nBas,nGrid) - double precision,intent(in) :: dAO(3,nBas,nGrid) - -! Local variables - - integer :: ixyz,iG,mu,nu - double precision,external :: trace_matrix - -! Output variables - - double precision,intent(out) :: rho(nGrid) - double precision,intent(out) :: drho(3,nGrid) - - rho(:) = 0d0 - do iG=1,nGrid - do mu=1,nBas - do nu=1,nBas - rho(iG) = rho(iG) + AO(mu,iG)*P(mu,nu)*AO(nu,iG) - enddo - enddo - enddo - - drho(:,:) = 0d0 - do ixyz=1,3 - do iG=1,nGrid - do mu=1,nBas - do nu=1,nBas - drho(ixyz,iG) = drho(ixyz,iG) & - + P(mu,nu)*(dAO(ixyz,mu,iG)*AO(nu,iG) + AO(mu,iG)*dAO(ixyz,nu,iG)) - enddo - enddo - enddo - enddo - -end subroutine one_electron_density diff --git a/src/eDFT/print_UKS.f90 b/src/eDFT/print_UKS.f90 deleted file mode 100644 index 0d41965..0000000 --- a/src/eDFT/print_UKS.f90 +++ /dev/null @@ -1,167 +0,0 @@ -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 - - implicit none - include 'parameters.h' - -! Input variables - - 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 :: 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) - -! 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 - -! HOMO and LUMO - - iHOMOa = ceiling(nO(1)) - iLUMOa = iHOMOa + 1 - - iHOMOb = ceiling(nO(2)) - iLUMOb = iHOMOb + 1 - - 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,2) - - HOMO = max(HOMOa,HOMOb) - LUMO = min(LUMOa,LUMOb) - - Gapa = LUMOa - HOMOa - Gapb = LUMOb - HOMOb - Gap = LUMO - HOMO - -! Spin comtamination - -! 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)) -! S = -0.5d0 + 0.5d0*sqrt(1d0 + 4d0*S2) - -! Dump results - - write(*,*) - write(*,'(A60)') '-------------------------------------------------' - write(*,'(A40)') ' Summary ' - write(*,'(A60)') '-------------------------------------------------' - write(*,'(A40,1X,F16.10,A3)') ' One-electron energy: ',sum(ET(:)) + sum(EV(:)),' au' - write(*,'(A40,1X,F16.10,A3)') ' One-electron a energy: ',ET(1) + EV(1),' au' - write(*,'(A40,1X,F16.10,A3)') ' One-electron b energy: ',ET(2) + EV(2),' au' - write(*,'(A40,1X,F16.10,A3)') ' Kinetic energy: ',sum(ET(:)),' au' - write(*,'(A40,1X,F16.10,A3)') ' Kinetic a energy: ',ET(1),' au' - write(*,'(A40,1X,F16.10,A3)') ' Kinetic b energy: ',ET(2),' au' - write(*,'(A40,1X,F16.10,A3)') ' Potential energy: ',sum(EV(:)),' au' - write(*,'(A40,1X,F16.10,A3)') ' Potential a energy: ',EV(1),' au' - write(*,'(A40,1X,F16.10,A3)') ' Potential b energy: ',EV(2),' au' - write(*,'(A60)') '-------------------------------------------------' - write(*,'(A40,1X,F16.10,A3)') ' Two-electron a energy: ',sum(EH(:)) + sum(Ex(:)) + sum(Ec(:)),' au' - write(*,'(A40,1X,F16.10,A3)') ' Two-electron aa energy: ',EH(1) + Ex(1) + Ec(1),' au' - write(*,'(A40,1X,F16.10,A3)') ' Two-electron ab energy: ',EH(2) + Ec(2),' au' - write(*,'(A40,1X,F16.10,A3)') ' Two-electron bb energy: ',EH(3) + Ex(2) + Ec(3),' au' - write(*,'(A40,1X,F16.10,A3)') ' Hartree energy: ',sum(EH(:)),' au' - write(*,'(A40,1X,F16.10,A3)') ' Hartree aa energy: ',EH(1),' au' - write(*,'(A40,1X,F16.10,A3)') ' Hartree ab energy: ',EH(2),' au' - write(*,'(A40,1X,F16.10,A3)') ' Hartree bb energy: ',EH(3),' au' - write(*,'(A40,1X,F16.10,A3)') ' Exchange energy: ',sum(Ex(:)),' au' - write(*,'(A40,1X,F16.10,A3)') ' Exchange a energy: ',Ex(1),' au' - write(*,'(A40,1X,F16.10,A3)') ' Exchange b energy: ',Ex(2),' au' - write(*,'(A40,1X,F16.10,A3)') ' Correlation energy: ',sum(Ec(:)),' au' - write(*,'(A40,1X,F16.10,A3)') ' Correlation aa energy: ',Ec(1),' au' - write(*,'(A40,1X,F16.10,A3)') ' Correlation ab energy: ',Ec(2),' au' - write(*,'(A40,1X,F16.10,A3)') ' Correlation bb energy: ',Ec(3),' au' - write(*,'(A60)') '-------------------------------------------------' - write(*,'(A40,1X,F16.10,A3)') ' Electronic energy: ',Ew,' au' - 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:',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:',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,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 - write(*,'(A60)') '-------------------------------------------------' - write(*,*) - -! Print results - - write(*,'(A50)') '-----------------------------------------' - write(*,'(A50)') 'Kohn-Sham spin-up orbital coefficients ' - write(*,'(A50)') '-----------------------------------------' - call matout(nBas,nBas,c(:,:,1)) - write(*,'(A50)') '-----------------------------------------' - write(*,'(A50)') 'Kohn-Sham spin-down orbital coefficients ' - write(*,'(A50)') '-----------------------------------------' - call matout(nBas,nBas,c(:,:,2)) - write(*,*) - write(*,'(A50)') '---------------------------------------' - write(*,'(A50)') ' Kohn-Sham spin-up orbital energies ' - write(*,'(A50)') '---------------------------------------' - call matout(nBas,1,eps(:,1)) - write(*,*) - write(*,'(A50)') '---------------------------------------' - write(*,'(A50)') ' Kohn-Sham spin-down orbital energies ' - write(*,'(A50)') '---------------------------------------' - call matout(nBas,1,eps(:,2)) - write(*,*) - -end subroutine print_UKS diff --git a/src/eDFT/print_individual_energy.f90 b/src/eDFT/print_individual_energy.f90 deleted file mode 100644 index 88ff78b..0000000 --- a/src/eDFT/print_individual_energy.f90 +++ /dev/null @@ -1,246 +0,0 @@ -subroutine print_individual_energy(nEns,ENuc,Ew,ET,EV,EH,Ex,Ec,Eaux,LZH,LZx,LZc,ExDD,EcDD,E, & - Om,OmH,Omx,Omc,Omaux,OmxDD,OmcDD) - -! Print individual energies for eDFT calculation - - implicit none - include 'parameters.h' - -! Input variables - - integer,intent(in) :: nEns - double precision,intent(in) :: ENuc - double precision,intent(in) :: Ew - double precision,intent(in) :: ET(nspin,nEns) - double precision,intent(in) :: EV(nspin,nEns) - double precision,intent(in) :: EH(nsp,nEns) - double precision,intent(in) :: Ex(nspin,nEns) - double precision,intent(in) :: Ec(nsp,nEns) - double precision,intent(in) :: Eaux(nspin,nEns) - double precision :: LZH(nsp) - double precision :: LZx(nspin) - double precision :: LZc(nsp) - double precision,intent(in) :: ExDD(nspin,nEns) - double precision,intent(in) :: EcDD(nsp,nEns) - double precision,intent(in) :: E(nEns) - - double precision,intent(in) :: OmH(nEns) - double precision,intent(in) :: Omx(nEns) - double precision,intent(in) :: Omc(nEns) - double precision,intent(in) :: Omaux(nEns) - double precision,intent(in) :: OmxDD(nEns) - double precision,intent(in) :: OmcDD(nEns) - double precision,intent(in) :: Om(nEns) - -! Local variables - - integer :: iEns - -!------------------------------------------------------------------------ -! Ensemble energies -!------------------------------------------------------------------------ - - write(*,'(A60)') '-------------------------------------------------' - write(*,'(A60)') ' ENSEMBLE ENERGIES' - write(*,'(A60)') '-------------------------------------------------' - write(*,'(A44,F16.10,A3)') ' Ensemble energy: ',Ew + ENuc,' au' - write(*,'(A60)') '-------------------------------------------------' - write(*,*) - -!------------------------------------------------------------------------ -! Individual energies -!------------------------------------------------------------------------ - -! write(*,'(A60)') '-------------------------------------------------' -! write(*,'(A60)') ' INDIVIDUAL TOTAL ENERGIES' -! write(*,'(A60)') '-------------------------------------------------' -! do iEns=1,nEns -! write(*,'(A40,I2,A2,F16.10,A3)') ' Individual energy state ',iEns,': ',E(iEns) + ENuc,' au' -! end do -! write(*,'(A60)') '-------------------------------------------------' -! write(*,*) - -!------------------------------------------------------------------------ -! Kinetic energy -!------------------------------------------------------------------------ - - write(*,'(A60)') '-------------------------------------------------' - write(*,'(A60)') ' INDIVIDUAL KINETIC ENERGIES' - write(*,'(A60)') '-------------------------------------------------' - do iEns=1,nEns - write(*,'(A40,I2,A2,F16.10,A3)') ' Kinetic energy state ',iEns,': ',sum(ET(:,iEns)),' au' - end do - write(*,'(A60)') '-------------------------------------------------' - write(*,*) - -!------------------------------------------------------------------------ -! Potential energy -!------------------------------------------------------------------------ - - write(*,'(A60)') '-------------------------------------------------' - write(*,'(A60)') ' INDIVIDUAL POTENTIAL ENERGIES' - write(*,'(A60)') '-------------------------------------------------' - do iEns=1,nEns - write(*,'(A40,I2,A2,F16.10,A3)') ' Potential energy state ',iEns,': ',sum(EV(:,iEns)),' au' - end do - write(*,'(A60)') '-------------------------------------------------' - write(*,*) - -!------------------------------------------------------------------------ -! Hartree energy -!------------------------------------------------------------------------ - - write(*,'(A60)') '-------------------------------------------------' - write(*,'(A60)') ' INDIVIDUAL HARTREE ENERGIES' - write(*,'(A60)') '-------------------------------------------------' - do iEns=1,nEns - write(*,'(A40,I2,A2,F16.10,A3)') ' Hartree energy state ',iEns,': ',sum(EH(:,iEns)),' au' - end do - write(*,'(A60)') '-------------------------------------------------' - write(*,*) - -!------------------------------------------------------------------------ -! Exchange energy -!------------------------------------------------------------------------ - - write(*,'(A60)') '-------------------------------------------------' - write(*,'(A60)') ' INDIVIDUAL EXCHANGE ENERGIES' - write(*,'(A60)') '-------------------------------------------------' - do iEns=1,nEns - write(*,'(A40,I2,A2,F16.10,A3)') ' Exchange energy state ',iEns,': ',sum(Ex(:,iEns)),' au' - end do - write(*,'(A60)') '-------------------------------------------------' - write(*,*) - -!------------------------------------------------------------------------ -! Correlation energy -!------------------------------------------------------------------------ - - write(*,'(A60)') '-------------------------------------------------' - write(*,'(A60)') ' INDIVIDUAL CORRELATION ENERGIES' - write(*,'(A60)') '-------------------------------------------------' - do iEns=1,nEns - write(*,'(A40,I2,A2,F16.10,A3)') ' Correlation energy state ',iEns,': ',sum(Ec(:,iEns)),' au' - end do - write(*,'(A60)') '-------------------------------------------------' - write(*,*) - -!------------------------------------------------------------------------ -! Auxiliary energies -!------------------------------------------------------------------------ - - write(*,'(A60)') '-------------------------------------------------' - write(*,'(A60)') ' AUXILIARY KS ENERGIES' - write(*,'(A60)') '-------------------------------------------------' - do iEns=1,nEns - write(*,'(A40,I2,A2,F16.10,A3)') 'Auxiliary KS energy state ',iEns,': ',sum(Eaux(:,iEns)),' au' - end do - write(*,'(A60)') '-------------------------------------------------' - write(*,*) - -!------------------------------------------------------------------------ -! Print Levy-Zahariev shifts -!------------------------------------------------------------------------ - - write(*,'(A60)') '-------------------------------------------------' - write(*,'(A60)') ' LEVY-ZAHARIEV SHIFTS CONTRIBUTIONS' - write(*,'(A60)') '-------------------------------------------------' - write(*,*) - write(*,'(A40,F16.10,A3)') ' H Levy-Zahariev shift: ',sum(LZH(:)),' au' - write(*,'(A40,F16.10,A3)') ' x Levy-Zahariev shift: ',sum(LZx(:)),' au' - write(*,'(A40,F16.10,A3)') ' c Levy-Zahariev shift: ',sum(LZc(:)),' au' - write(*,'(A40,F16.10,A3)') ' Hxc Levy-Zahariev shift: ',sum(LZH(:))+sum(LZx(:))+sum(LZc(:)),' au' - write(*,*) - write(*,'(A40,F16.10,A3)') ' H Levy-Zahariev shift: ',sum(LZH(:))*HaToeV,' eV' - write(*,'(A40,F16.10,A3)') ' x Levy-Zahariev shift: ',sum(LZx(:))*HaToeV,' eV' - write(*,'(A40,F16.10,A3)') ' c Levy-Zahariev shift: ',sum(LZc(:))*HaToeV,' eV' - write(*,'(A40,F16.10,A3)') ' Hxc Levy-Zahariev shift: ',(sum(LZH(:))+sum(LZx(:))+sum(LZc(:)))*HaToeV,' eV' - write(*,'(A60)') '-------------------------------------------------' - write(*,*) - -!------------------------------------------------------------------------ -! Compute derivative discontinuities -!------------------------------------------------------------------------ - - write(*,'(A60)') '-------------------------------------------------' - write(*,'(A60)') ' ENSEMBLE DERIVATIVE CONTRIBUTIONS' - write(*,'(A60)') '-------------------------------------------------' - do iEns=1,nEns - write(*,*) - write(*,'(A40,I2,A2,F16.10,A3)') ' x ensemble derivative state ',iEns,': ',sum(ExDD(:,iEns)), ' au' - write(*,'(A40,I2,A2,F16.10,A3)') ' c ensemble derivative state ',iEns,': ',sum(EcDD(:,iEns)), ' au' - write(*,'(A40,I2,A2,F16.10,A3)') ' xc ensemble derivative state ',iEns,': ',sum(ExDD(:,iEns))+sum(EcDD(:,iEns)),' au' - end do - write(*,'(A60)') '-------------------------------------------------' - write(*,*) - -!------------------------------------------------------------------------ -! Total Energy and IP and EA -!------------------------------------------------------------------------ - - write(*,'(A60)') '-------------------------------------------------' - write(*,'(A60)') ' ENERGY DIFFERENCES FROM AUXILIARY ENERGIES ' - write(*,'(A60)') '-------------------------------------------------' - - do iEns=2,nEns - write(*,'(A40,I2,A1,F16.10,A3)') ' Energy difference 1 -> ',iEns,':',Omaux(iEns)+OmxDD(iEns)+OmcDD(iEns),' au' - write(*,*) - write(*,'(A44, F16.10,A3)') ' auxiliary energy contribution : ',Omaux(iEns), ' au' - write(*,'(A44, F16.10,A3)') ' x ensemble derivative : ',OmxDD(iEns), ' au' - write(*,'(A44, F16.10,A3)') ' c ensemble derivative : ',OmcDD(iEns), ' au' - write(*,'(A44, F16.10,A3)') ' xc ensemble derivative : ',OmxDD(iEns)+OmcDD(iEns), ' au' - write(*,*) - - write(*,'(A60)') '-------------------------------------------------' - - write(*,'(A40,I2,A1,F16.10,A3)') ' Energy difference 1 -> ',iEns,':',(Omaux(iEns)+OmxDD(iEns)+OmcDD(iEns))*HaToeV,' eV' - write(*,*) - write(*,'(A44, F16.10,A3)') ' auxiliary energy contribution : ',Omaux(iEns)*HaToeV, ' eV' - write(*,'(A44, F16.10,A3)') ' x ensemble derivative : ',OmxDD(iEns)*HaToeV, ' eV' - write(*,'(A44, F16.10,A3)') ' c ensemble derivative : ',OmcDD(iEns)*HaToeV, ' eV' - write(*,'(A44, F16.10,A3)') ' xc ensemble derivative : ',(OmxDD(iEns)+OmcDD(iEns))*HaToeV,' eV' - write(*,*) - end do - - write(*,'(A60)') '-------------------------------------------------' - write(*,*) - - write(*,'(A60)') '-------------------------------------------------' - write(*,'(A60)') ' ENERGY DIFFERENCES FROM INDIVIDUAL ENERGIES ' - write(*,'(A60)') '-------------------------------------------------' - do iEns=1,nEns - write(*,'(A40,I2,A2,F16.10,A3)') ' Individual energy state ',iEns,': ',E(iEns) + ENuc,' au' - end do - write(*,'(A60)') '-------------------------------------------------' - - do iEns=2,nEns - write(*,'(A40,I2,A1,F16.10,A3)') ' Energy difference 1 -> ',iEns,':',Om(iEns), ' au' - write(*,*) - write(*,'(A44, F16.10,A3)') ' H energy contribution : ',OmH(iEns), ' au' - write(*,'(A44, F16.10,A3)') ' x energy contribution : ',Omx(iEns), ' au' - write(*,'(A44, F16.10,A3)') ' c energy contribution : ',Omc(iEns), ' au' - write(*,'(A44, F16.10,A3)') ' Hxc energy contribution : ',OmH(iEns)+Omx(iEns)+Omc(iEns), ' au' - write(*,*) - write(*,'(A44, F16.10,A3)') ' x ensemble derivative : ',OmxDD(iEns), ' au' - write(*,'(A44, F16.10,A3)') ' c ensemble derivative : ',OmcDD(iEns), ' au' - write(*,'(A44, F16.10,A3)') ' xc ensemble derivative : ',OmxDD(iEns)+OmcDD(iEns),' au' - write(*,*) - - write(*,'(A60)') '-------------------------------------------------' - - write(*,'(A40,I2,A1,F16.10,A3)') ' Energy difference 1 -> ',iEns,':',Om(iEns)*HaToeV, ' eV' - write(*,*) - write(*,'(A44, F16.10,A3)') ' H energy contribution : ',OmH(iEns)*HaToeV, ' eV' - write(*,'(A44, F16.10,A3)') ' x energy contribution : ',Omx(iEns)*HaToeV, ' eV' - write(*,'(A44, F16.10,A3)') ' c energy contribution : ',Omc(iEns)*HaToeV, ' eV' - write(*,'(A44, F16.10,A3)') ' Hxc energy contribution : ',(OmH(iEns)+Omx(iEns)+Omc(iEns))*HaToeV, ' eV' - write(*,*) - write(*,'(A44, F16.10,A3)') ' x ensemble derivative : ',OmxDD(iEns)*HaToeV, ' eV' - write(*,'(A44, F16.10,A3)') ' c ensemble derivative : ',OmcDD(iEns)*HaToeV, ' eV' - write(*,'(A44, F16.10,A3)') ' xc ensemble derivative : ',(OmxDD(iEns)+OmcDD(iEns))*HaToeV,' eV' - write(*,*) - end do - write(*,'(A60)') '-------------------------------------------------' - write(*,*) - -end subroutine print_individual_energy diff --git a/src/eDFT/read_grid.f90 b/src/eDFT/read_grid.f90 deleted file mode 100644 index 615d837..0000000 --- a/src/eDFT/read_grid.f90 +++ /dev/null @@ -1,49 +0,0 @@ -subroutine read_grid(SGn,radial_precision,nRad,nAng) - -! Read grid type - - implicit none - -! Input variables - - integer,intent(in) :: SGn - -! Output variables - - double precision,intent(out) :: radial_precision - integer,intent(out) :: nRad - integer,intent(out) :: nAng - - write(*,*)'----------------------------------------------------------' - write(*,'(A22,I1)')' Quadrature grid: SG-',SGn - write(*,*)'----------------------------------------------------------' - - select case (SGn) - - case(0) - radial_precision = 1d-5 - nRad = 23 - nAng = 170 - - case(1) - radial_precision = 1d-7 - nRad = 50 - nAng = 194 - - case(2) - radial_precision = 1d-9 - nRad = 75 - nAng = 302 - - case(3) - radial_precision = 1d-11 - nRad = 99 - nAng = 590 - - case default - call print_warning('!!! Quadrature grid not available !!!') - stop - - end select - -end subroutine read_grid diff --git a/src/eDFT/read_options_dft.f90 b/src/eDFT/read_options_dft.f90 deleted file mode 100644 index ea972a5..0000000 --- a/src/eDFT/read_options_dft.f90 +++ /dev/null @@ -1,431 +0,0 @@ -subroutine read_options_dft(nBas,method,x_rung,x_DFA,c_rung,c_DFA,SGn,nEns,wEns,nCC,aCC, & - doNcentered,occnum,Cx_choice) - -! Read DFT options - - implicit none - - include 'parameters.h' - -! Input variables - integer,intent(in) :: nBas - -! Local variables - - integer :: iBas - integer :: iEns - integer :: iCC - character(len=1) :: answer - double precision,allocatable :: nEl(:) - character(len=12) :: x_func - character(len=12) :: c_func - -! Output variables - - character(len=8),intent(out) :: method - integer,intent(out) :: x_rung,c_rung - integer,intent(out) :: x_DFA,c_DFA - integer,intent(out) :: SGn - integer,intent(out) :: nEns - logical,intent(out) :: doNcentered - double precision,intent(out) :: wEns(maxEns) - integer,intent(out) :: nCC - double precision,intent(out) :: aCC(maxCC,maxEns-1) - double precision,intent(out) :: occnum(nBas,nspin,maxEns) - - integer,intent(out) :: Cx_choice - -! Open file with method specification - - open(unit=1,file='input/dft') - -! Default values - - method = 'eDFT-UKS' - x_rung = 1 - c_rung = 1 - x_DFA = 1 - c_DFA = 1 - SGn = 0 - wEns(:) = 0d0 - -! Restricted or unrestricted calculation - - read(1,*) - read(1,*) method - -!---------------------------------------! -! EXCHANGE: read rung of Jacob's ladder ! -!---------------------------------------! - - read(1,*) - read(1,*) - read(1,*) - read(1,*) - read(1,*) - read(1,*) - read(1,*) x_rung,x_func - - select case (x_rung) ! exchange functionals - - case (0) ! Hartree - - select case (x_func) - - case ('H') - - x_DFA = 1 - - case default - - call print_warning('!!! Hartree exchange functional not available !!!') - stop - - end select - - case (1) ! LDA - - select case (x_func) - - case ('S51') - - x_DFA = 1 - - case ('CC-S51') - - x_DFA = 2 - - case default - - call print_warning('!!! LDA exchange functional not available !!!') - stop - - end select - - case (2) ! GGA - - select case (x_func) - - case ('G96') - - x_DFA = 1 - - case ('B88') - - x_DFA = 2 - - case ('PBE') - - x_DFA = 3 - - case ('CC-B88') - - x_DFA = 4 - - case default - - call print_warning('!!! GGA exchange functional not available !!!') - stop - - end select - - case (3) ! MGGA - - select case (x_func) - - case default - - call print_warning('!!! MGGA exchange functional not available !!!') - stop - - end select - - case (4) ! Hybrid - - select case (x_func) - - case ('HF') - - x_DFA = 1 - - case ('B3LYP') - - x_DFA = 2 - - case ('BHHLYP') - - x_DFA = 3 - - case ('PBE') - - x_DFA = 4 - - case default - - call print_warning('!!! Hybrid exchange functional not available !!!') - stop - - end select - - case default - - call print_warning('!!! Exchange rung not available !!!') - stop - - end select - -! Select rung for exchange - - write(*,*) - write(*,*) '*******************************************************************' - write(*,*) '* Exchange rung *' - write(*,*) '*******************************************************************' - - call select_rung(x_rung,x_func) - -!------------------------------------------! -! CORRELATION: read rung of Jacob's ladder ! -!------------------------------------------! - - read(1,*) - read(1,*) - read(1,*) - read(1,*) - read(1,*) - read(1,*) - read(1,*) c_rung,c_func - - select case (c_rung) ! correlation functionals - - case (0) ! Hartree - - select case (c_func) - - case ('H') - - c_DFA = 1 - - case default - - call print_warning('!!! Hartree correlation functional not available !!!') - stop - - end select - - case (1) ! LDA - - select case (c_func) - - case ('W38') - - c_DFA = 1 - - case ('PW92') - - c_DFA = 2 - - case ('VWN3') - - c_DFA = 3 - - case ('VWN5') - - c_DFA = 4 - - case ('eVWN5') - - c_DFA = 5 - - case default - - call print_warning('!!! LDA correlation functional not available !!!') - stop - - end select - - case (2) ! GGA - - select case (c_func) - - case ('LYP') - - c_DFA = 1 - - case ('PBE') - - c_DFA = 2 - - case default - - call print_warning('!!! GGA correlation functional not available !!!') - stop - - end select - - case (3) ! MGGA - - select case (c_func) - - case default - - call print_warning('!!! MGGA correlation functional not available !!!') - stop - - end select - - case (4) ! Hybrid - - select case (c_func) - - case ('HF') - - c_DFA = 1 - - case ('B3LYP') - - c_DFA = 2 - - case ('BHHLYP') - - c_DFA = 3 - - case ('PBE') - - c_DFA = 4 - - case default - - call print_warning('!!! Hybrid correlation functional not available !!!') - stop - - end select - - case default - - call print_warning('!!! Correlation rung not available !!!') - stop - - end select - -! Select rung for correlation - - write(*,*) - write(*,*) '*******************************************************************' - write(*,*) '* Correlation rung *' - write(*,*) '*******************************************************************' - - call select_rung(c_rung,c_func) - -! Read SG-n grid - - read(1,*) - read(1,*) SGn - -! Read number of states in ensemble - - read(1,*) - read(1,*) nEns - - if(nEns.gt.maxEns) then - write(*,*) ' Number of states in ensemble too big!! ' - stop - endif - - write(*,*)'----------------------------------------------------------' - write(*,'(A33,I3)')' Number of states in ensemble = ',nEns - write(*,*)'----------------------------------------------------------' - write(*,*) - -! Read occupation numbers for orbitals nO and nO+1 - - occnum(:,:,:) = 0d0 - - do iEns=1,maxEns - read(1,*) - read(1,*) (occnum(iBas,1,iEns),iBas=1,nBas) - read(1,*) (occnum(iBas,2,iEns),iBas=1,nBas) - end do - - do iEns=1,nEns - write(*,*) - write(*,*) '===============' - write(*,*) 'State n.',iEns - write(*,*) '===============' - write(*,*) - write(*,*) 'Spin-up occupation numbers' - write(*,*) (int(occnum(iBas,1,iEns)),iBas=1,nBas) - write(*,*) 'Spin-down occupation numbers' - write(*,*) (int(occnum(iBas,2,iEns)),iBas=1,nBas) - write(*,*) - end do - -! Read ensemble weights for real physical (fractional number of electrons) ensemble (w1,w2) - - allocate(nEl(maxEns)) - nEl(:) = 0d0 - do iEns=1,maxEns - do iBas=1,nBas - nEl(iEns) = nEl(iEns) + occnum(iBas,1,iEns) + occnum(iBas,2,iEns) - end do - end do - - doNcentered = .false. - - read(1,*) - read(1,*) (wEns(iEns),iEns=2,nEns) - read(1,*) - read(1,*) answer - - if(answer == 'T') doNcentered = .true. - - wEns(1) = 1d0 - do iEns=2,nEns - wEns(1) = wEns(1) - wEns(iEns) - end do - - if (doNcentered) then - - do iEns=2,nEns - if(nEl(iEns) > 0d0) then - wEns(iEns) = (nEl(1)/nEl(iEns))*wEns(iEns) - else - wEns(iENs) = 0d0 - end if - end do - - end if - - write(*,*)'----------------------------------------------------------' - write(*,*)' Ensemble weights ' - write(*,*)'----------------------------------------------------------' - call matout(nEns,1,wEns) - write(*,*) - -! Read parameters for weight-dependent functional - read(1,*) - read(1,*) nCC - do iEns=2,maxEns - read(1,*) (aCC(iCC,iEns-1),iCC=1,nCC) - end do - -! Read choice of exchange coefficient - read(1,*) - read(1,*) Cx_choice - - write(*,*)'----------------------------------------------------------' - write(*,*)' Parameters for weight-dependent exchange functional ' - do iEns=2,maxEns - write(*,*)'----------------------------------------------------------' - write(*,'(A10,I2,A2)') ' State ',iEns,':' - write(*,*)'----------------------------------------------------------' - write(*,*) - call matout(nCC,1,acc(:,iEns-1)) - write(*,*) - end do - write(*,*) - -! Close file with options - - close(unit=1) - -end subroutine read_options_dft diff --git a/src/eDFT/select_rung.f90 b/src/eDFT/select_rung.f90 deleted file mode 100644 index 9236764..0000000 --- a/src/eDFT/select_rung.f90 +++ /dev/null @@ -1,49 +0,0 @@ -subroutine select_rung(rung,DFA) - -! Select rung of Jacob's ladder - - implicit none - include 'parameters.h' - -! Input variables - - integer,intent(in) :: rung - character(len=12),intent(in) :: DFA - - select case (rung) - -! Hartree calculation - case(0) - write(*,*) "* 0th rung of Jacob's ladder: Hartree calculation *" - -! LDA functionals - case(1) - write(*,*) "* 1st rung of Jacob's ladder: local-density approximation (LDA) *" - -! GGA functionals - case(2) - write(*,*) "* 2nd rung of Jacob's ladder: generalized gradient approximation (GGA) *" - -! meta-GGA functionals - case(3) - write(*,*) "* 3rd rung of Jacob's ladder: meta-GGA functional (MGGA) *" - -! Hybrid functionals - case(4) - write(*,*) "* 4th rung of Jacob's ladder: hybrid functional *" - -! Default - case default - write(*,*) "!!! rung not available !!!" - stop - - end select - - ! Print selected functional - - write(*,*) '* You have selected the following functional: ',DFA,' *' - write(*,*) '*******************************************************************' - write(*,*) - - -end subroutine select_rung diff --git a/src/eDFT/xc_potential.f90 b/src/eDFT/xc_potential.f90 deleted file mode 100644 index 2037ab2..0000000 --- a/src/eDFT/xc_potential.f90 +++ /dev/null @@ -1,40 +0,0 @@ -subroutine xc_potential(nBas,c,Fx,Fc,Vxc) - -! Compute the exchange-correlation potential in the MO basis - - implicit none - include 'parameters.h' - -! Input variables - - integer,intent(in) :: nBas - double precision,intent(in) :: c(nBas,nBas,nspin) - double precision,intent(in) :: Fx(nBas,nBas,nspin) - double precision,intent(in) :: Fc(nBas,nBas,nspin) - -! Local variables - - integer :: mu,nu - integer :: p - integer :: ispin - -! Output variables - - double precision,intent(out) :: Vxc(nBas,nspin) - -! Compute Vxc - - Vxc(:,:) = 0d0 - do p=1,nBas - do ispin=1,nspin - do mu=1,nBas - do nu=1,nBas - Vxc(p,ispin) = Vxc(p,ispin) & - + c(mu,p,ispin)*(Fx(mu,nu,ispin) + Fc(mu,nu,ispin))*c(nu,p,ispin) - - end do - end do - end do - end do - -end subroutine xc_potential diff --git a/src/eDFT/xc_potential_grid.f90 b/src/eDFT/xc_potential_grid.f90 deleted file mode 100644 index 3a29628..0000000 --- a/src/eDFT/xc_potential_grid.f90 +++ /dev/null @@ -1,54 +0,0 @@ -subroutine xc_potential_grid(nBas,nGrid,AO,rho,Fx,Vxgrid) - - -! Compute the exchange-correlation potential on the grid - - implicit none - include 'parameters.h' - -! Input variables - - integer,intent(in) :: nBas, nGrid - double precision,intent(in) :: rho(nGrid,nspin) - double precision,intent(in) :: Fx(nBas,nBas,nspin) - double precision,intent(in) :: AO(nBas,nGrid) - -! Local variables - - integer :: mu,nu - integer :: ispin,iG - double precision :: r - double precision :: Fxgrid(nGrid,nspin) - -! Output variables - - double precision,intent(out) :: Vxgrid(nGrid) - -! Compute Vx - - Vxgrid(:) = 0d0 - Fxgrid(:,:) = 0d0 - - do iG=1,nGrid - do ispin=1,nspin - do mu=1,nBas - do nu=1,nBas - r = max(0d0,rho(iG,ispin)) - if(r > threshold) then - Fxgrid(iG,ispin) = Fxgrid(iG,ispin) + AO(mu,iG)*AO(nu,iG)*4d0/3d0*CxLSDA*r**(1d0/3d0) - endif - enddo - enddo - enddo - enddo - - Vxgrid(:)=Fxgrid(:,1)+Fxgrid(:,2) - open(411, file = 'Vxgrid.dat', status = 'new') - do iG=1,nGrid - write(411,*) iG, Vxgrid(iG) - end do - close(411) - - -end subroutine xc_potential_grid -