1 subroutine dimqm_fldpot(d_xyz, q_xyz, q_chrg, fld) 2c use err_func 3 implicit none 4#include "stdio.fh" 5#include "dimqm_constants.fh" 6#include "dimqm.fh" 7c 8c Input Variables 9 double precision d_xyz(3) 10 double precision q_xyz(3) 11 double precision q_chrg 12 double precision fld(3) 13c Local Variables 14 double precision r(3) 15 double precision dist, dist3 16 double precision screen 17 double precision screen_fld 18c 19c Distance between points 20c 21c if(ldebug) write(luout,*) "Start FldPot" 22 r(:) = d_xyz(:) - q_xyz(:) 23 dist = SQRT(DOT_PRODUCT(r, r)) 24c write(luout,*) "Distance:",dist 25c write(luout,*) "Charge:",q_chrg 26c write(luout,*) "R:",r 27c 28c Determine screening factor based off screening type 29c 30 screen_fld = ONE 31 if(scrnType == ERFSCRN) then 32 screen = erf(scrnFactor*dist) 33 screen_fld = screen * screen 34 else if(scrnType == EXPSCRN) then 35 screen = ONE - EXP(-scrnFactor*dist) 36 screen_fld = screen * screen * screen 37 else 38 if(dist < 1.0d-12) dist = 1.0d-12 39 end if 40c 41 dist3 = dist * dist * dist 42c write(luout,*) "Screen:", screen_fld 43c 44c Add E-field to previous value 45c 46 fld(1) = fld(1) + screen_fld * q_chrg * r(1) / dist3 47 fld(2) = fld(2) + screen_fld * q_chrg * r(2) / dist3 48 fld(3) = fld(3) + screen_fld * q_chrg * r(3) / dist3 49c write(luout,*) "Field:",fld 50c 51c if(ldebug) write(luout,*) "End FldPot" 52 end subroutine dimqm_fldpot 53