1* 2* $Id$ 3* 4 5 6* ************************************ 7* * * 8* * v_bwexc_all * 9* * * 10* ************************************ 11 subroutine v_bwexc_all(gga,n2ft3d,ispin,dn,xcp,xce) 12 implicit none 13 integer gga 14 integer n2ft3d 15 integer ispin 16 real*8 dn(n2ft3d,2) 17 real*8 xcp(n2ft3d,2),xce(n2ft3d) 18 19 20#include "bafdecls.fh" 21#include "errquit.fh" 22#include "nwpwxc.fh" 23#include "util.fh" 24 25 integer tmp1(2) 26 logical use_lda, use_gga, use_mgga 27 28* **** lda's **** 29 use_lda = (.not.nwpwxc_is_on().and.gga.eq.0).or. 30 + (nwpwxc_is_on().and.nwpwxc_is_lda()) 31 use_gga = (.not.nwpwxc_is_on().and.(gga.ge.10) 32 > .and.(gga.lt.100)) 33 + .or.(nwpwxc_is_on().and.nwpwxc_is_gga()) 34 use_mgga = nwpwxc_is_mgga().or.(gga.ge.300) 35 36 if (use_lda) then 37 if (.not.BA_push_get(mt_dbl,(ispin*n2ft3d),'tmp1', 38 > tmp1(2),tmp1(1))) 39 > call errquit('v_bwexc_all: out of stack memory',0,MA_ERR) 40 41 call vxc(n2ft3d,ispin,dn,xcp,xce,dbl_mb(tmp1(1))) 42 43 if (.not.BA_pop_stack(tmp1(2))) 44 > call errquit('v_bwexc_all: error popping stack',0,MA_ERR) 45 46 47 48* **** gga's **** 49 else if (use_gga) then 50 call v_bwexc(gga,n2ft3d,ispin,dn,1.0d0,1.0d0,xcp,xce) 51 52* **** meta-gga's **** 53 else if (use_mgga) then 54 call v_mexc(gga,n2ft3d,ispin,dn,1.0d0,1.0d0,xcp,xce) 55 56* **** hybrid gga's **** 57 else if (gga.eq.110) then 58 call v_bwexc(10,n2ft3d,ispin,dn,0.75d0,1.0d0,xcp,xce) 59 else if (gga.eq.111) then 60 call v_bwexc(11,n2ft3d,ispin,dn,0.75d0,1.0d0,xcp,xce) 61 else if (gga.eq.112) then 62 call v_bwexc(12,n2ft3d,ispin,dn,0.75d0,1.0d0,xcp,xce) 63 else if (gga.eq.114) then 64 call v_bwexc(14,n2ft3d,ispin,dn,1.00d0,1.0d0,xcp,xce) 65 else if (gga.eq.115) then 66 call v_bwexc(15,n2ft3d,ispin,dn,0.80d0,1.0d0,xcp,xce) 67 end if 68 69 return 70 end 71 72 73 74* ************************************ 75* * * 76* * v_bwexc_all_tmp1 * 77* * * 78* ************************************ 79 subroutine v_bwexc_all_tmp1(gga,n2ft3d,ispin,dn,xcp,xce,tmp1) 80 implicit none 81 integer gga 82 integer n2ft3d 83 integer ispin 84 real*8 dn(n2ft3d,2) 85 real*8 xcp(n2ft3d,2),xce(n2ft3d) 86 real*8 tmp1(n2ft3d) 87 88 89#include "bafdecls.fh" 90#include "errquit.fh" 91#include "nwpwxc.fh" 92#include "util.fh" 93 94 logical use_lda, use_gga, use_mgga 95 integer i 96 97 98 use_lda = (.not.nwpwxc_is_on().and.gga.eq.0).or. 99 + (nwpwxc_is_on().and.nwpwxc_is_lda()) 100 use_gga = (.not.nwpwxc_is_on().and.(gga.ge.10).and.(gga.lt.100)) 101 + .or.(nwpwxc_is_on().and.nwpwxc_is_gga()) 102 use_mgga = nwpwxc_is_mgga().or.(gga.ge.300) 103 104* **** lda's **** 105 if (use_lda) then 106 107 call vxc(n2ft3d,ispin,dn,xcp,xce,tmp1) 108 109* **** gga's **** 110 else if (use_gga) then 111 112 call v_bwexc(gga,n2ft3d,ispin,dn,1.0d0,1.0d0,xcp,xce) 113 114 115* **** meta-gga's **** 116 else if (use_mgga) then 117 call v_mexc(gga,n2ft3d,ispin,dn,1.0d0,1.0d0,xcp,xce) 118 119* **** hybrid gga's **** 120 else if (gga.eq.110) then 121 call v_bwexc(10,n2ft3d,ispin,dn,0.75d0,1.0d0,xcp,xce) 122 else if (gga.eq.111) then 123 call v_bwexc(11,n2ft3d,ispin,dn,0.75d0,1.0d0,xcp,xce) 124 else if (gga.eq.112) then 125 call v_bwexc(12,n2ft3d,ispin,dn,0.75d0,1.0d0,xcp,xce) 126 else if (gga.eq.114) then 127 call v_bwexc(14,n2ft3d,ispin,dn,1.00d0,1.0d0,xcp,xce) 128 else if (gga.eq.115) then 129 call v_bwexc(15,n2ft3d,ispin,dn,0.80d0,1.0d0,xcp,xce) 130 end if 131 132 return 133 end 134 135* ************************************ 136* * * 137* * v_bwexc_print * 138* * * 139* ************************************ 140 subroutine v_bwexc_print(luout,gga) 141 implicit none 142 integer luout,gga 143 144#include "errquit.fh" 145#include "nwpwxc.fh" 146#include "util.fh" 147 148 logical control_has_disp,control_has_vdw,control_is_vdw2 149 external control_has_disp,control_has_vdw,control_is_vdw2 150 character*80 control_options_disp 151 external control_options_disp 152 153 if (nwpwxc_is_on()) then 154 call nwpwxc_print_nwpw() 155 return 156 endif 157 IF (gga.eq.-1) THEN 158 write(luout,1131) 'off' 159 ELSE IF (gga.eq.0) THEN 160 write(luout,1131) 'LDA (Vosko et al) parameterization' 161 ELSE IF (gga.eq.10) THEN 162 write(luout,1131) 163 > 'PBE96 (White and Bird) parameterization' 164 ELSE IF (gga.eq.11) THEN 165 write(luout,1131) 166 > 'BLYP (White and Bird) parameterization' 167 ELSE IF (gga.eq.12) THEN 168 write(luout,1131) 169 > 'revPBE (White and Bird) parameterization' 170 ELSE IF (gga.eq.13) THEN 171 write(luout,1131) 172 > 'PBEsol (White and Bird) parameterization' 173 ELSE IF (gga.eq.16) THEN 174 write(luout,1131) 175 > 'BEEF (White and Bird) parameterization' 176 ELSE IF (gga.eq.17) THEN 177 write(luout,1131) 178 > 'XBEEF-CPBE (White and Bird) parameterization' 179 180 ELSE IF (gga.eq.110) THEN 181 write(luout,1131) 182 > 'PBE0 (White and Bird) parameterization' 183 ELSE IF (gga.eq.111) THEN 184 write(luout,1131) 185 > 'BLYP0 (White and Bird) parameterization' 186 ELSE IF (gga.eq.112) THEN 187 write(luout,1131) 188 > 'revPBE0 (White and Bird) parameterization' 189 ELSE IF (gga.eq.113) THEN 190 write(luout,1131) 191 > 'BNL (White and Bird) parameterization' 192 ELSE IF (gga.eq.114) THEN 193 write(luout,1131) 194 > 'HSE (White and Bird) parameterization' 195 ELSE IF (gga.eq.115) THEN 196 write(luout,1131) 197 > 'B3LYP (White and Bird) parameterization' 198 199 ELSE IF (gga.eq.200) THEN 200 write(luout,1131) 'Hartree-Fock' 201 ELSE IF (gga.eq.300) THEN 202 write(luout,1131) 'VS98' 203 ELSE IF (gga.eq.301) THEN 204 write(luout,1131) 'TPSS03' 205 ELSE IF (gga.eq.302) THEN 206 write(luout,1131) 'SCAN' 207 ELSE IF (gga.eq.303) THEN 208 write(luout,1131) 'PKZB' 209 ELSE IF (gga.eq.304) THEN 210 write(luout,1131) 'M06-L' 211 ELSE IF (gga.eq.305) THEN 212 write(luout,1131) 'M06' 213 ELSE IF (gga.eq.306) THEN 214 write(luout,1131) 'M06-2X' 215 ELSE 216 write(luout,1131) 'unknown parameterization' 217 call errquit('bad exchange_correlation',0, INPUT_ERR) 218 END IF 219 220 if (control_has_vdw()) then 221 if (control_is_vdw2()) then 222 write(luout,1132) "vdw2 Langreth functional" 223 else 224 write(luout,1132) "vdw Langreth functional" 225 end if 226 end if 227 228 if (control_has_disp()) then 229 if (index(control_options_disp(),'-old').ne.0) then 230 write(luout,1132) 'Grimme2' 231 else if (index(control_options_disp(),'-zerom').ne.0) then 232 write(luout,1132) 'Grimme5' 233 else if (index(control_options_disp(),'-zero').ne.0) then 234 write(luout,1132) 'Grimme3' 235 else if (index(control_options_disp(),'-bjm').ne.0) then 236 write(luout,1132) 'Grimme6' 237 else if (index(control_options_disp(),'-bj').ne.0) then 238 write(luout,1132) 'Grimme4' 239 end if 240 end if 241 242 243 return 244 1131 FORMAT(5X,' exchange-correlation = ',A) 245 1132 FORMAT(5X,' dispersion correction= ',A) 246 end 247