ViewVC Help
View File | Revision Log | Show Annotations | View Changeset | Root Listing
root/group/trunk/OOPSE-4/src/UseTheForce/DarkSide/electrostatic.F90
(Generate patch)

Comparing trunk/OOPSE-4/src/UseTheForce/DarkSide/electrostatic.F90 (file contents):
Revision 2339 by chrisfen, Wed Sep 28 18:47:17 2005 UTC vs.
Revision 2394 by chrisfen, Sun Oct 23 21:08:08 2005 UTC

# Line 54 | Line 54 | module electrostatic_module
54  
55    PRIVATE
56  
57 +
58   #define __FORTRAN90
59 + #include "UseTheForce/DarkSide/fInteractionMap.h"
60   #include "UseTheForce/DarkSide/fElectrostaticSummationMethod.h"
61  
62 +
63    !! these prefactors convert the multipole interactions into kcal / mol
64    !! all were computed assuming distances are measured in angstroms
65    !! Charge-Charge, assuming charges are measured in electrons
# Line 75 | Line 78 | module electrostatic_module
78    integer, save :: summationMethod = NONE
79    logical, save :: summationMethodChecked = .false.
80    real(kind=DP), save :: defaultCutoff = 0.0_DP
81 +  real(kind=DP), save :: defaultCutoff2 = 0.0_DP
82    logical, save :: haveDefaultCutoff = .false.
83    real(kind=DP), save :: dampingAlpha = 0.0_DP
84    logical, save :: haveDampingAlpha = .false.
85 <  real(kind=DP), save :: dielectric = 0.0_DP
85 >  real(kind=DP), save :: dielectric = 1.0_DP
86    logical, save :: haveDielectric = .false.
87    real(kind=DP), save :: constERFC = 0.0_DP
88    real(kind=DP), save :: constEXP = 0.0_DP
89    logical, save :: haveDWAconstants = .false.
90 <  real(kind=dp), save :: rcuti = 0.0_dp
91 <  real(kind=dp), save :: rcuti2 = 0.0_dp
92 <  real(kind=dp), save :: rcuti3 = 0.0_dp
93 <  real(kind=dp), save :: rcuti4 = 0.0_dp
94 <  real(kind=dp), save :: alphaPi = 0.0_dp
95 <  real(kind=dp), save :: invRootPi = 0.0_dp
96 <  
90 >  real(kind=dp), save :: rcuti = 0.0_DP
91 >  real(kind=dp), save :: rcuti2 = 0.0_DP
92 >  real(kind=dp), save :: rcuti3 = 0.0_DP
93 >  real(kind=dp), save :: rcuti4 = 0.0_DP
94 >  real(kind=dp), save :: alphaPi = 0.0_DP
95 >  real(kind=dp), save :: invRootPi = 0.0_DP
96 >  real(kind=dp), save :: rrf = 1.0_DP
97 >  real(kind=dp), save :: rt = 1.0_DP
98 >  real(kind=dp), save :: rrfsq = 1.0_DP
99 >  real(kind=dp), save :: preRF = 0.0_DP
100 >  real(kind=dp), save :: preRF2 = 0.0_DP
101 >  logical, save :: preRFCalculated = .false.
102 >
103   #ifdef __IFC
104   ! error function for ifc version > 7.
105    double precision, external :: derfc
# Line 99 | Line 109 | module electrostatic_module
109    public :: setElectrostaticCutoffRadius
110    public :: setDampedWolfAlpha
111    public :: setReactionFieldDielectric
112 +  public :: setReactionFieldPrefactor
113    public :: newElectrostaticType
114    public :: setCharge
115    public :: setDipoleMoment
# Line 107 | Line 118 | module electrostatic_module
118    public :: doElectrostaticPair
119    public :: getCharge
120    public :: getDipoleMoment
110  public :: pre22
121    public :: destroyElectrostaticTypes
122 +  public :: rf_self_self
123  
124    type :: Electrostatic
125       integer :: c_ident
# Line 138 | Line 149 | contains
149  
150    end subroutine setElectrostaticSummationMethod
151  
152 <  subroutine setElectrostaticCutoffRadius(thisRcut)
152 >  subroutine setElectrostaticCutoffRadius(thisRcut, thisRsw)
153      real(kind=dp), intent(in) :: thisRcut
154 +    real(kind=dp), intent(in) :: thisRsw
155      defaultCutoff = thisRcut
156 +    rrf = defaultCutoff
157 +    rt = thisRsw
158      haveDefaultCutoff = .true.
159    end subroutine setElectrostaticCutoffRadius
160  
# Line 156 | Line 170 | contains
170      haveDielectric = .true.
171    end subroutine setReactionFieldDielectric
172  
173 +  subroutine setReactionFieldPrefactor
174 +    if (haveDefaultCutoff .and. haveDielectric) then
175 +       defaultCutoff2 = defaultCutoff*defaultCutoff
176 +       preRF = (dielectric-1.0d0) / &
177 +            ((2.0d0*dielectric+1.0d0)*defaultCutoff2*defaultCutoff)
178 +       preRF2 = 2.0d0*preRF
179 +       preRFCalculated = .true.
180 +    else if (.not.haveDefaultCutoff) then
181 +       call handleError("setReactionFieldPrefactor", "Default cutoff not set")
182 +    else
183 +       call handleError("setReactionFieldPrefactor", "Dielectric not set")
184 +    endif
185 +  end subroutine setReactionFieldPrefactor
186 +
187    subroutine newElectrostaticType(c_ident, is_Charge, is_Dipole, &
188         is_SplitDipole, is_Quadrupole, is_Tap, status)
189  
# Line 392 | Line 420 | contains
420            constERFC = derfc(dampingAlpha*defaultCutoff)
421            invRootPi = 0.56418958354775628695d0
422            alphaPi = 2*dampingAlpha*invRootPi
423 <          
423 >  
424            haveDWAconstants = .true.
425         endif
426      endif
# Line 448 | Line 476 | contains
476      real (kind=dp) :: dudx, dudy, dudz
477      real (kind=dp) :: scale, sc2, bigR
478      real (kind=dp) :: varERFC, varEXP
479 +    real (kind=dp) :: limScale
480 +    real (kind=dp) :: preVal, rfVal
481  
482      if (.not.allocated(ElectrostaticMap)) then
483         call handleError("electrostatic", "no ElectrostaticMap was present before first call of do_electrostatic_pair!")
# Line 456 | Line 486 | contains
486  
487      if (.not.summationMethodChecked) then
488         call checkSummationMethod()
459      
489      endif
490  
491 +    if (.not.preRFCalculated) then
492 +       call setReactionFieldPrefactor()
493 +    endif
494  
495   #ifdef IS_MPI
496      me1 = atid_Row(atom1)
# Line 471 | Line 503 | contains
503      !! some variables we'll need independent of electrostatic type:
504  
505      riji = 1.0d0 / rij
506 <
506 >  
507      xhat = d(1) * riji
508      yhat = d(2) * riji
509      zhat = d(3) * riji
# Line 612 | Line 644 | contains
644         if (j_is_Charge) then
645  
646            if (summationMethod .eq. UNDAMPED_WOLF) then
615
647               vterm = pre11 * q_i * q_j * (riji - rcuti)
648               vpair = vpair + vterm
649               epot = epot + sw*vterm
650              
651 <             dudr  = -sw*pre11*q_i*q_j * (riji*riji*riji - rcuti2*rcuti)
651 >             dudr  = -sw*pre11*q_i*q_j * (riji*riji-rcuti2)*riji
652              
653               dudx = dudx + dudr * d(1)
654               dudy = dudy + dudr * d(2)
655               dudz = dudz + dudr * d(3)
656  
657            elseif (summationMethod .eq. DAMPED_WOLF) then
627
658               varERFC = derfc(dampingAlpha*rij)
659               varEXP = exp(-dampingAlpha*dampingAlpha*rij*rij)
660               vterm = pre11 * q_i * q_j * (varERFC*riji - constERFC*rcuti)
661               vpair = vpair + vterm
662               epot = epot + sw*vterm
663              
664 <             dudr  = -sw*pre11*q_i*q_j * ( riji*(varERFC*riji*riji &
665 <                                                 + alphaPi*varEXP) &
666 <                                         - rcuti*(constERFC*rcuti2 &
667 <                                                 + alphaPi*constEXP) )
664 >             dudr  = -sw*pre11*q_i*q_j * ( riji*((varERFC*riji*riji &
665 >                                                  + alphaPi*varEXP) &
666 >                                                 - (constERFC*rcuti2 &
667 >                                                    + alphaPi*constEXP)) )
668              
669               dudx = dudx + dudr * d(1)
670               dudy = dudy + dudr * d(2)
671               dudz = dudz + dudr * d(3)
672  
673 <          else
673 >          elseif (summationMethod .eq. REACTION_FIELD) then
674 >             preVal = pre11 * q_i * q_j
675 >             rfVal = preRF*rij*rij
676 >             vterm = preVal * ( riji + rfVal )
677 >             vpair = vpair + vterm
678 >             epot = epot + sw*vterm
679 >            
680 >             dudr  = sw * preVal * ( 2.0d0*rfVal - riji )*riji
681 >            
682 >             dudx = dudx + dudr * xhat
683 >             dudy = dudy + dudr * yhat
684 >             dudz = dudz + dudr * zhat
685  
686 +          else
687               vterm = pre11 * q_i * q_j * riji
688               vpair = vpair + vterm
689               epot = epot + sw*vterm
# Line 918 | Line 960 | contains
960                    - rcuti3*(uz_i(2) - 3.0d0*ct_i*d(2)*rcuti))
961               duduz_j(3) = duduz_j(3) + sw*pref*(ri3*(uz_i(3)-3.0d0*ct_i*zhat) &
962                    - rcuti3*(uz_i(3) - 3.0d0*ct_i*d(3)*rcuti))
963 +
964 +         elseif (summationMethod .eq. REACTION_FIELD) then
965 +             ct_ij = uz_i(1)*uz_j(1) + uz_i(2)*uz_j(2) + uz_i(3)*uz_j(3)
966  
967 +             ri2 = riji * riji
968 +             ri3 = ri2 * riji
969 +             ri4 = ri2 * ri2
970 +
971 +             pref = pre22 * mu_i * mu_j
972 +              
973 +             vterm = pref*( ri3*(ct_ij - 3.0d0 * ct_i * ct_j) - &
974 +                  preRF2*ct_ij )
975 +             vpair = vpair + vterm
976 +             epot = epot + sw*vterm
977 +            
978 +             a1 = 5.0d0 * ct_i * ct_j - ct_ij
979 +            
980 +             dudx = dudx + sw*pref*3.0d0*ri4 &
981 +                             * (a1*xhat-ct_i*uz_j(1)-ct_j*uz_i(1))
982 +             dudy = dudy + sw*pref*3.0d0*ri4 &
983 +                             * (a1*yhat-ct_i*uz_j(2)-ct_j*uz_i(2))
984 +             dudz = dudz + sw*pref*3.0d0*ri4 &
985 +                             * (a1*zhat-ct_i*uz_j(3)-ct_j*uz_i(3))
986 +            
987 +             duduz_i(1) = duduz_i(1) + sw*pref*(ri3*(uz_j(1)-3.0d0*ct_j*xhat) &
988 +                  - preRF2*uz_j(1))
989 +             duduz_i(2) = duduz_i(2) + sw*pref*(ri3*(uz_j(2)-3.0d0*ct_j*yhat) &
990 +                  - preRF2*uz_j(2))
991 +             duduz_i(3) = duduz_i(3) + sw*pref*(ri3*(uz_j(3)-3.0d0*ct_j*zhat) &
992 +                  - preRF2*uz_j(3))
993 +             duduz_j(1) = duduz_j(1) + sw*pref*(ri3*(uz_i(1)-3.0d0*ct_i*xhat) &
994 +                  - preRF2*uz_i(1))
995 +             duduz_j(2) = duduz_j(2) + sw*pref*(ri3*(uz_i(2)-3.0d0*ct_i*yhat) &
996 +                  - preRF2*uz_i(2))
997 +             duduz_j(3) = duduz_j(3) + sw*pref*(ri3*(uz_i(3)-3.0d0*ct_i*zhat) &
998 +                  - preRF2*uz_i(3))
999 +
1000            else
1001               if (i_is_SplitDipole) then
1002                  if (j_is_SplitDipole) then
# Line 1080 | Line 1158 | contains
1158  
1159      if (do_pot) then
1160   #ifdef IS_MPI
1161 <       pot_row(atom1) = pot_row(atom1) + 0.5d0*epot
1162 <       pot_col(atom2) = pot_col(atom2) + 0.5d0*epot
1161 >       pot_row(ELECTROSTATIC_POT,atom1) = pot_row(ELECTROSTATIC_POT,atom1) + 0.5d0*epot
1162 >       pot_col(ELECTROSTATIC_POT,atom2) = pot_col(ELECTROSTATIC_POT,atom2) + 0.5d0*epot
1163   #else
1164         pot = pot + epot
1165   #endif
# Line 1185 | Line 1263 | contains
1263  
1264      return
1265    end subroutine doElectrostaticPair
1188
1189  !! calculates the switching functions and their derivatives for a given
1190  subroutine calc_switch(r, mu, scale, dscale)
1191
1192    real (kind=dp), intent(in) :: r, mu
1193    real (kind=dp), intent(inout) :: scale, dscale
1194    real (kind=dp) :: rl, ru, mulow, minRatio, temp, scaleVal
1195
1196    ! distances must be in angstroms
1197    rl = 2.75d0
1198    ru = 3.75d0
1199    mulow = 0.0d0 !3.3856d0 ! 1.84 * 1.84
1200    minRatio = mulow / (mu*mu)
1201    scaleVal = 1.0d0 - minRatio
1202    
1203    if (r.lt.rl) then
1204       scale = minRatio
1205       dscale = 0.0d0
1206    elseif (r.gt.ru) then
1207       scale = 1.0d0
1208       dscale = 0.0d0
1209    else
1210       scale = 1.0d0 - scaleVal*((ru + 2.0d0*r - 3.0d0*rl) * (ru-r)**2) &
1211                        / ((ru - rl)**3)
1212       dscale = -scaleVal * 6.0d0 * (r-ru)*(r-rl)/((ru - rl)**3)    
1213    endif
1214        
1215    return
1216  end subroutine calc_switch
1266  
1267    subroutine destroyElectrostaticTypes()
1268  
# Line 1221 | Line 1270 | end module electrostatic_module
1270  
1271    end subroutine destroyElectrostaticTypes
1272  
1273 +  subroutine rf_self_self(atom1, eFrame, rfpot, t, do_pot)
1274 +    logical, intent(in) :: do_pot
1275 +    integer, intent(in) :: atom1
1276 +    integer :: atid1
1277 +    real(kind=dp), dimension(9,nLocal) :: eFrame
1278 +    real(kind=dp), dimension(3,nLocal) :: t
1279 +    real(kind=dp) :: mu1
1280 +    real(kind=dp) :: preVal, epot, rfpot
1281 +    real(kind=dp) :: eix, eiy, eiz
1282 +
1283 +    ! this is a local only array, so we use the local atom type id's:
1284 +    atid1 = atid(atom1)
1285 +    
1286 +    if (ElectrostaticMap(atid1)%is_Dipole) then
1287 +       mu1 = getDipoleMoment(atid1)
1288 +      
1289 +       preVal = pre22 * preRF2 * mu1*mu1
1290 +       rfpot = rfpot - 0.5d0*preVal
1291 +
1292 +       ! The self-correction term adds into the reaction field vector
1293 +      
1294 +       eix = preVal * eFrame(3,atom1)
1295 +       eiy = preVal * eFrame(6,atom1)
1296 +       eiz = preVal * eFrame(9,atom1)
1297 +
1298 +       ! once again, this is self-self, so only the local arrays are needed
1299 +       ! even for MPI jobs:
1300 +      
1301 +       t(1,atom1)=t(1,atom1) - eFrame(6,atom1)*eiz + &
1302 +            eFrame(9,atom1)*eiy
1303 +       t(2,atom1)=t(2,atom1) - eFrame(9,atom1)*eix + &
1304 +            eFrame(3,atom1)*eiz
1305 +       t(3,atom1)=t(3,atom1) - eFrame(3,atom1)*eiy + &
1306 +            eFrame(6,atom1)*eix
1307 +
1308 +    endif
1309 +    
1310 +    return
1311 +  end subroutine rf_self_self
1312 +
1313   end module electrostatic_module

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines