| 45 |
|
|
| 46 |
|
!! @author Charles F. Vardeman II |
| 47 |
|
!! @author Matthew Meineke |
| 48 |
< |
!! @version $Id: doForces.F90,v 1.25 2005-07-29 17:34:06 tim Exp $, $Date: 2005-07-29 17:34:06 $, $Name: not supported by cvs2svn $, $Revision: 1.25 $ |
| 48 |
> |
!! @version $Id: doForces.F90,v 1.66 2005-11-02 20:35:34 chrisfen Exp $, $Date: 2005-11-02 20:35:34 $, $Name: not supported by cvs2svn $, $Revision: 1.66 $ |
| 49 |
|
|
| 50 |
|
|
| 51 |
|
module doForces |
| 58 |
|
use lj |
| 59 |
|
use sticky |
| 60 |
|
use electrostatic_module |
| 61 |
< |
use reaction_field |
| 62 |
< |
use gb_pair |
| 61 |
> |
use gayberne |
| 62 |
|
use shapes |
| 63 |
|
use vector_class |
| 64 |
|
use eam |
| 72 |
|
|
| 73 |
|
#define __FORTRAN90 |
| 74 |
|
#include "UseTheForce/fSwitchingFunction.h" |
| 75 |
+ |
#include "UseTheForce/fCutoffPolicy.h" |
| 76 |
|
#include "UseTheForce/DarkSide/fInteractionMap.h" |
| 77 |
+ |
#include "UseTheForce/DarkSide/fElectrostaticSummationMethod.h" |
| 78 |
|
|
| 79 |
+ |
|
| 80 |
|
INTEGER, PARAMETER:: PREPAIR_LOOP = 1 |
| 81 |
|
INTEGER, PARAMETER:: PAIR_LOOP = 2 |
| 82 |
|
|
| 81 |
– |
logical, save :: haveRlist = .false. |
| 83 |
|
logical, save :: haveNeighborList = .false. |
| 84 |
|
logical, save :: haveSIMvariables = .false. |
| 85 |
|
logical, save :: haveSaneForceField = .false. |
| 86 |
< |
logical, save :: haveInteractionMap = .false. |
| 86 |
> |
logical, save :: haveInteractionHash = .false. |
| 87 |
> |
logical, save :: haveGtypeCutoffMap = .false. |
| 88 |
> |
logical, save :: haveDefaultCutoffs = .false. |
| 89 |
> |
logical, save :: haveRlist = .false. |
| 90 |
|
|
| 91 |
|
logical, save :: FF_uses_DirectionalAtoms |
| 88 |
– |
logical, save :: FF_uses_LennardJones |
| 89 |
– |
logical, save :: FF_uses_Electrostatics |
| 90 |
– |
logical, save :: FF_uses_Charges |
| 92 |
|
logical, save :: FF_uses_Dipoles |
| 92 |
– |
logical, save :: FF_uses_Quadrupoles |
| 93 |
– |
logical, save :: FF_uses_Sticky |
| 94 |
– |
logical, save :: FF_uses_StickyPower |
| 93 |
|
logical, save :: FF_uses_GayBerne |
| 94 |
|
logical, save :: FF_uses_EAM |
| 97 |
– |
logical, save :: FF_uses_Shapes |
| 98 |
– |
logical, save :: FF_uses_FLARB |
| 99 |
– |
logical, save :: FF_uses_RF |
| 95 |
|
|
| 96 |
|
logical, save :: SIM_uses_DirectionalAtoms |
| 102 |
– |
logical, save :: SIM_uses_LennardJones |
| 103 |
– |
logical, save :: SIM_uses_Electrostatics |
| 104 |
– |
logical, save :: SIM_uses_Charges |
| 105 |
– |
logical, save :: SIM_uses_Dipoles |
| 106 |
– |
logical, save :: SIM_uses_Quadrupoles |
| 107 |
– |
logical, save :: SIM_uses_Sticky |
| 108 |
– |
logical, save :: SIM_uses_StickyPower |
| 109 |
– |
logical, save :: SIM_uses_GayBerne |
| 97 |
|
logical, save :: SIM_uses_EAM |
| 111 |
– |
logical, save :: SIM_uses_Shapes |
| 112 |
– |
logical, save :: SIM_uses_FLARB |
| 113 |
– |
logical, save :: SIM_uses_RF |
| 98 |
|
logical, save :: SIM_requires_postpair_calc |
| 99 |
|
logical, save :: SIM_requires_prepair_calc |
| 100 |
|
logical, save :: SIM_uses_PBC |
| 117 |
– |
logical, save :: SIM_uses_molecular_cutoffs |
| 101 |
|
|
| 102 |
< |
!!!GO AWAY--------- |
| 120 |
< |
!!!!!real(kind=dp), save :: rlist, rlistsq |
| 102 |
> |
integer, save :: electrostaticSummationMethod |
| 103 |
|
|
| 104 |
|
public :: init_FF |
| 105 |
+ |
public :: setDefaultCutoffs |
| 106 |
|
public :: do_force_loop |
| 107 |
< |
! public :: setRlistDF |
| 108 |
< |
!public :: addInteraction |
| 109 |
< |
!public :: setInteractionHash |
| 110 |
< |
!public :: getInteractionHash |
| 111 |
< |
public :: createInteractionMap |
| 112 |
< |
public :: createRcuts |
| 107 |
> |
public :: createInteractionHash |
| 108 |
> |
public :: createGtypeCutoffMap |
| 109 |
> |
public :: getStickyCut |
| 110 |
> |
public :: getStickyPowerCut |
| 111 |
> |
public :: getGayBerneCut |
| 112 |
> |
public :: getEAMCut |
| 113 |
> |
public :: getShapeCut |
| 114 |
|
|
| 115 |
|
#ifdef PROFILE |
| 116 |
|
public :: getforcetime |
| 118 |
|
real :: forceTimeInitial, forceTimeFinal |
| 119 |
|
integer :: nLoops |
| 120 |
|
#endif |
| 137 |
– |
|
| 138 |
– |
type, public :: Interaction |
| 139 |
– |
integer :: InteractionHash |
| 140 |
– |
real(kind=dp) :: rList = 0.0_dp |
| 141 |
– |
real(kind=dp) :: rListSq = 0.0_dp |
| 142 |
– |
end type Interaction |
| 121 |
|
|
| 122 |
< |
type(Interaction), dimension(:,:),allocatable :: InteractionMap |
| 123 |
< |
|
| 122 |
> |
!! Variables for cutoff mapping and interaction mapping |
| 123 |
> |
! Bit hash to determine pair-pair interactions. |
| 124 |
> |
integer, dimension(:,:), allocatable :: InteractionHash |
| 125 |
> |
real(kind=dp), dimension(:), allocatable :: atypeMaxCutoff |
| 126 |
> |
real(kind=dp), dimension(:), allocatable, target :: groupMaxCutoffRow |
| 127 |
> |
real(kind=dp), dimension(:), pointer :: groupMaxCutoffCol |
| 128 |
|
|
| 129 |
+ |
integer, dimension(:), allocatable, target :: groupToGtypeRow |
| 130 |
+ |
integer, dimension(:), pointer :: groupToGtypeCol => null() |
| 131 |
+ |
|
| 132 |
+ |
real(kind=dp), dimension(:), allocatable,target :: gtypeMaxCutoffRow |
| 133 |
+ |
real(kind=dp), dimension(:), pointer :: gtypeMaxCutoffCol |
| 134 |
+ |
type ::gtypeCutoffs |
| 135 |
+ |
real(kind=dp) :: rcut |
| 136 |
+ |
real(kind=dp) :: rcutsq |
| 137 |
+ |
real(kind=dp) :: rlistsq |
| 138 |
+ |
end type gtypeCutoffs |
| 139 |
+ |
type(gtypeCutoffs), dimension(:,:), allocatable :: gtypeCutoffMap |
| 140 |
+ |
|
| 141 |
+ |
integer, save :: cutoffPolicy = TRADITIONAL_CUTOFF_POLICY |
| 142 |
+ |
real(kind=dp),save :: defaultRcut, defaultRsw, defaultRlist |
| 143 |
+ |
real(kind=dp),save :: listSkin |
| 144 |
|
|
| 145 |
|
contains |
| 146 |
|
|
| 147 |
< |
|
| 151 |
< |
subroutine createInteractionMap(status) |
| 147 |
> |
subroutine createInteractionHash(status) |
| 148 |
|
integer :: nAtypes |
| 149 |
|
integer, intent(out) :: status |
| 150 |
|
integer :: i |
| 151 |
|
integer :: j |
| 152 |
< |
integer :: ihash |
| 157 |
< |
real(kind=dp) :: myRcut |
| 152 |
> |
integer :: iHash |
| 153 |
|
!! Test Types |
| 154 |
|
logical :: i_is_LJ |
| 155 |
|
logical :: i_is_Elect |
| 165 |
|
logical :: j_is_GB |
| 166 |
|
logical :: j_is_EAM |
| 167 |
|
logical :: j_is_Shape |
| 168 |
< |
|
| 169 |
< |
status = 0 |
| 170 |
< |
|
| 168 |
> |
real(kind=dp) :: myRcut |
| 169 |
> |
|
| 170 |
> |
status = 0 |
| 171 |
> |
|
| 172 |
|
if (.not. associated(atypes)) then |
| 173 |
< |
call handleError("atype", "atypes was not present before call of createDefaultInteractionMap!") |
| 173 |
> |
call handleError("atype", "atypes was not present before call of createInteractionHash!") |
| 174 |
|
status = -1 |
| 175 |
|
return |
| 176 |
|
endif |
| 182 |
|
return |
| 183 |
|
end if |
| 184 |
|
|
| 185 |
< |
if (.not. allocated(InteractionMap)) then |
| 186 |
< |
allocate(InteractionMap(nAtypes,nAtypes)) |
| 185 |
> |
if (.not. allocated(InteractionHash)) then |
| 186 |
> |
allocate(InteractionHash(nAtypes,nAtypes)) |
| 187 |
> |
else |
| 188 |
> |
deallocate(InteractionHash) |
| 189 |
> |
allocate(InteractionHash(nAtypes,nAtypes)) |
| 190 |
|
endif |
| 191 |
+ |
|
| 192 |
+ |
if (.not. allocated(atypeMaxCutoff)) then |
| 193 |
+ |
allocate(atypeMaxCutoff(nAtypes)) |
| 194 |
+ |
else |
| 195 |
+ |
deallocate(atypeMaxCutoff) |
| 196 |
+ |
allocate(atypeMaxCutoff(nAtypes)) |
| 197 |
+ |
endif |
| 198 |
|
|
| 199 |
|
do i = 1, nAtypes |
| 200 |
|
call getElementProperty(atypes, i, "is_LennardJones", i_is_LJ) |
| 247 |
|
if (i_is_LJ .and. j_is_Shape) iHash = ior(iHash, SHAPE_LJ) |
| 248 |
|
|
| 249 |
|
|
| 250 |
< |
InteractionMap(i,j)%InteractionHash = iHash |
| 251 |
< |
InteractionMap(j,i)%InteractionHash = iHash |
| 250 |
> |
InteractionHash(i,j) = iHash |
| 251 |
> |
InteractionHash(j,i) = iHash |
| 252 |
|
|
| 253 |
|
end do |
| 254 |
|
|
| 255 |
|
end do |
| 256 |
|
|
| 257 |
< |
haveInteractionMap = .true. |
| 258 |
< |
end subroutine createInteractionMap |
| 257 |
> |
haveInteractionHash = .true. |
| 258 |
> |
end subroutine createInteractionHash |
| 259 |
|
|
| 260 |
< |
! Query each potential and return the cutoff for that potential. We build the neighbor list based on the largest cutoff value for that atype. Each potential can decide whether to calculate the force for that atype based upon it's own cutoff. |
| 255 |
< |
subroutine createRcuts(defaultRList,stat) |
| 256 |
< |
real(kind=dp), intent(in), optional :: defaultRList |
| 257 |
< |
integer :: iMap |
| 258 |
< |
integer :: map_i,map_j |
| 259 |
< |
real(kind=dp) :: thisRCut = 0.0_dp |
| 260 |
< |
real(kind=dp) :: actualCutoff = 0.0_dp |
| 261 |
< |
integer, intent(out) :: stat |
| 262 |
< |
integer :: nAtypes |
| 263 |
< |
integer :: myStatus |
| 260 |
> |
subroutine createGtypeCutoffMap(stat) |
| 261 |
|
|
| 262 |
< |
stat = 0 |
| 263 |
< |
if (.not. haveInteractionMap) then |
| 262 |
> |
integer, intent(out), optional :: stat |
| 263 |
> |
logical :: i_is_LJ |
| 264 |
> |
logical :: i_is_Elect |
| 265 |
> |
logical :: i_is_Sticky |
| 266 |
> |
logical :: i_is_StickyP |
| 267 |
> |
logical :: i_is_GB |
| 268 |
> |
logical :: i_is_EAM |
| 269 |
> |
logical :: i_is_Shape |
| 270 |
> |
logical :: GtypeFound |
| 271 |
|
|
| 272 |
< |
call createInteractionMap(myStatus) |
| 272 |
> |
integer :: myStatus, nAtypes, i, j, istart, iend, jstart, jend |
| 273 |
> |
integer :: n_in_i, me_i, ia, g, atom1, ja, n_in_j,me_j |
| 274 |
> |
integer :: nGroupsInRow |
| 275 |
> |
integer :: nGroupsInCol |
| 276 |
> |
integer :: nGroupTypesRow,nGroupTypesCol |
| 277 |
> |
real(kind=dp):: thisSigma, bigSigma, thisRcut, tradRcut, tol, skin |
| 278 |
> |
real(kind=dp) :: biggestAtypeCutoff |
| 279 |
|
|
| 280 |
+ |
stat = 0 |
| 281 |
+ |
if (.not. haveInteractionHash) then |
| 282 |
+ |
call createInteractionHash(myStatus) |
| 283 |
|
if (myStatus .ne. 0) then |
| 284 |
< |
write(default_error, *) 'createInteractionMap failed in doForces!' |
| 284 |
> |
write(default_error, *) 'createInteractionHash failed in doForces!' |
| 285 |
|
stat = -1 |
| 286 |
|
return |
| 287 |
|
endif |
| 288 |
|
endif |
| 289 |
< |
|
| 290 |
< |
|
| 289 |
> |
#ifdef IS_MPI |
| 290 |
> |
nGroupsInRow = getNgroupsInRow(plan_group_row) |
| 291 |
> |
nGroupsInCol = getNgroupsInCol(plan_group_col) |
| 292 |
> |
#endif |
| 293 |
|
nAtypes = getSize(atypes) |
| 294 |
< |
!! If we pass a default rcut, set all atypes to that cutoff distance |
| 295 |
< |
if(present(defaultRList)) then |
| 296 |
< |
InteractionMap(:,:)%rList = defaultRList |
| 297 |
< |
InteractionMap(:,:)%rListSq = defaultRList*defaultRList |
| 298 |
< |
haveRlist = .true. |
| 299 |
< |
return |
| 300 |
< |
end if |
| 301 |
< |
|
| 302 |
< |
do map_i = 1,nAtypes |
| 303 |
< |
do map_j = map_i,nAtypes |
| 304 |
< |
iMap = InteractionMap(map_i, map_j)%InteractionHash |
| 294 |
> |
! Set all of the initial cutoffs to zero. |
| 295 |
> |
atypeMaxCutoff = 0.0_dp |
| 296 |
> |
do i = 1, nAtypes |
| 297 |
> |
if (SimHasAtype(i)) then |
| 298 |
> |
call getElementProperty(atypes, i, "is_LennardJones", i_is_LJ) |
| 299 |
> |
call getElementProperty(atypes, i, "is_Electrostatic", i_is_Elect) |
| 300 |
> |
call getElementProperty(atypes, i, "is_Sticky", i_is_Sticky) |
| 301 |
> |
call getElementProperty(atypes, i, "is_StickyPower", i_is_StickyP) |
| 302 |
> |
call getElementProperty(atypes, i, "is_GayBerne", i_is_GB) |
| 303 |
> |
call getElementProperty(atypes, i, "is_EAM", i_is_EAM) |
| 304 |
> |
call getElementProperty(atypes, i, "is_Shape", i_is_Shape) |
| 305 |
|
|
| 306 |
< |
if ( iand(iMap, LJ_PAIR).ne.0 ) then |
| 307 |
< |
! thisRCut = getLJCutOff(map_i,map_j) |
| 308 |
< |
if (thisRcut > actualCutoff) actualCutoff = thisRcut |
| 306 |
> |
|
| 307 |
> |
if (haveDefaultCutoffs) then |
| 308 |
> |
atypeMaxCutoff(i) = defaultRcut |
| 309 |
> |
else |
| 310 |
> |
if (i_is_LJ) then |
| 311 |
> |
thisRcut = getSigma(i) * 2.5_dp |
| 312 |
> |
if (thisRCut .gt. atypeMaxCutoff(i)) atypeMaxCutoff(i) = thisRCut |
| 313 |
> |
endif |
| 314 |
> |
if (i_is_Elect) then |
| 315 |
> |
thisRcut = defaultRcut |
| 316 |
> |
if (thisRCut .gt. atypeMaxCutoff(i)) atypeMaxCutoff(i) = thisRCut |
| 317 |
> |
endif |
| 318 |
> |
if (i_is_Sticky) then |
| 319 |
> |
thisRcut = getStickyCut(i) |
| 320 |
> |
if (thisRCut .gt. atypeMaxCutoff(i)) atypeMaxCutoff(i) = thisRCut |
| 321 |
> |
endif |
| 322 |
> |
if (i_is_StickyP) then |
| 323 |
> |
thisRcut = getStickyPowerCut(i) |
| 324 |
> |
if (thisRCut .gt. atypeMaxCutoff(i)) atypeMaxCutoff(i) = thisRCut |
| 325 |
> |
endif |
| 326 |
> |
if (i_is_GB) then |
| 327 |
> |
thisRcut = getGayBerneCut(i) |
| 328 |
> |
if (thisRCut .gt. atypeMaxCutoff(i)) atypeMaxCutoff(i) = thisRCut |
| 329 |
> |
endif |
| 330 |
> |
if (i_is_EAM) then |
| 331 |
> |
thisRcut = getEAMCut(i) |
| 332 |
> |
if (thisRCut .gt. atypeMaxCutoff(i)) atypeMaxCutoff(i) = thisRCut |
| 333 |
> |
endif |
| 334 |
> |
if (i_is_Shape) then |
| 335 |
> |
thisRcut = getShapeCut(i) |
| 336 |
> |
if (thisRCut .gt. atypeMaxCutoff(i)) atypeMaxCutoff(i) = thisRCut |
| 337 |
> |
endif |
| 338 |
|
endif |
| 339 |
|
|
| 296 |
– |
if ( iand(iMap, ELECTROSTATIC_PAIR).ne.0 ) then |
| 297 |
– |
! thisRCut = getElectrostaticCutOff(map_i,map_j) |
| 298 |
– |
if (thisRcut > actualCutoff) actualCutoff = thisRcut |
| 299 |
– |
endif |
| 340 |
|
|
| 341 |
< |
if ( iand(iMap, STICKY_PAIR).ne.0 ) then |
| 342 |
< |
! thisRCut = getStickyCutOff(map_i,map_j) |
| 343 |
< |
if (thisRcut > actualCutoff) actualCutoff = thisRcut |
| 304 |
< |
endif |
| 305 |
< |
|
| 306 |
< |
if ( iand(iMap, STICKYPOWER_PAIR).ne.0 ) then |
| 307 |
< |
! thisRCut = getStickyPowerCutOff(map_i,map_j) |
| 308 |
< |
if (thisRcut > actualCutoff) actualCutoff = thisRcut |
| 309 |
< |
endif |
| 310 |
< |
|
| 311 |
< |
if ( iand(iMap, GAYBERNE_PAIR).ne.0 ) then |
| 312 |
< |
! thisRCut = getGayberneCutOff(map_i,map_j) |
| 313 |
< |
if (thisRcut > actualCutoff) actualCutoff = thisRcut |
| 314 |
< |
endif |
| 315 |
< |
|
| 316 |
< |
if ( iand(iMap, GAYBERNE_LJ).ne.0 ) then |
| 317 |
< |
! thisRCut = getGaybrneLJCutOff(map_i,map_j) |
| 318 |
< |
if (thisRcut > actualCutoff) actualCutoff = thisRcut |
| 319 |
< |
endif |
| 320 |
< |
|
| 321 |
< |
if ( iand(iMap, EAM_PAIR).ne.0 ) then |
| 322 |
< |
! thisRCut = getEAMCutOff(map_i,map_j) |
| 323 |
< |
if (thisRcut > actualCutoff) actualCutoff = thisRcut |
| 324 |
< |
endif |
| 325 |
< |
|
| 326 |
< |
if ( iand(iMap, SHAPE_PAIR).ne.0 ) then |
| 327 |
< |
! thisRCut = getShapeCutOff(map_i,map_j) |
| 328 |
< |
if (thisRcut > actualCutoff) actualCutoff = thisRcut |
| 329 |
< |
endif |
| 330 |
< |
|
| 331 |
< |
if ( iand(iMap, SHAPE_LJ).ne.0 ) then |
| 332 |
< |
! thisRCut = getShapeLJCutOff(map_i,map_j) |
| 333 |
< |
if (thisRcut > actualCutoff) actualCutoff = thisRcut |
| 334 |
< |
endif |
| 335 |
< |
InteractionMap(map_i, map_j)%rList = actualCutoff |
| 336 |
< |
InteractionMap(map_i, map_j)%rListSq = actualCutoff * actualCutoff |
| 337 |
< |
end do |
| 338 |
< |
end do |
| 339 |
< |
haveRlist = .true. |
| 340 |
< |
end subroutine createRcuts |
| 341 |
> |
if (atypeMaxCutoff(i).gt.biggestAtypeCutoff) then |
| 342 |
> |
biggestAtypeCutoff = atypeMaxCutoff(i) |
| 343 |
> |
endif |
| 344 |
|
|
| 345 |
+ |
endif |
| 346 |
+ |
enddo |
| 347 |
+ |
|
| 348 |
|
|
| 349 |
< |
!!! THIS GOES AWAY FOR SIZE DEPENDENT CUTOFF |
| 350 |
< |
!!$ subroutine setRlistDF( this_rlist ) |
| 351 |
< |
!!$ |
| 352 |
< |
!!$ real(kind=dp) :: this_rlist |
| 353 |
< |
!!$ |
| 354 |
< |
!!$ rlist = this_rlist |
| 355 |
< |
!!$ rlistsq = rlist * rlist |
| 356 |
< |
!!$ |
| 357 |
< |
!!$ haveRlist = .true. |
| 358 |
< |
!!$ |
| 359 |
< |
!!$ end subroutine setRlistDF |
| 349 |
> |
|
| 350 |
> |
istart = 1 |
| 351 |
> |
jstart = 1 |
| 352 |
> |
#ifdef IS_MPI |
| 353 |
> |
iend = nGroupsInRow |
| 354 |
> |
jend = nGroupsInCol |
| 355 |
> |
#else |
| 356 |
> |
iend = nGroups |
| 357 |
> |
jend = nGroups |
| 358 |
> |
#endif |
| 359 |
> |
|
| 360 |
> |
!! allocate the groupToGtype and gtypeMaxCutoff here. |
| 361 |
> |
if(.not.allocated(groupToGtypeRow)) then |
| 362 |
> |
! allocate(groupToGtype(iend)) |
| 363 |
> |
allocate(groupToGtypeRow(iend)) |
| 364 |
> |
else |
| 365 |
> |
deallocate(groupToGtypeRow) |
| 366 |
> |
allocate(groupToGtypeRow(iend)) |
| 367 |
> |
endif |
| 368 |
> |
if(.not.allocated(groupMaxCutoffRow)) then |
| 369 |
> |
allocate(groupMaxCutoffRow(iend)) |
| 370 |
> |
else |
| 371 |
> |
deallocate(groupMaxCutoffRow) |
| 372 |
> |
allocate(groupMaxCutoffRow(iend)) |
| 373 |
> |
end if |
| 374 |
|
|
| 375 |
+ |
if(.not.allocated(gtypeMaxCutoffRow)) then |
| 376 |
+ |
allocate(gtypeMaxCutoffRow(iend)) |
| 377 |
+ |
else |
| 378 |
+ |
deallocate(gtypeMaxCutoffRow) |
| 379 |
+ |
allocate(gtypeMaxCutoffRow(iend)) |
| 380 |
+ |
endif |
| 381 |
|
|
| 382 |
+ |
|
| 383 |
+ |
#ifdef IS_MPI |
| 384 |
+ |
! We only allocate new storage if we are in MPI because Ncol /= Nrow |
| 385 |
+ |
if(.not.associated(groupToGtypeCol)) then |
| 386 |
+ |
allocate(groupToGtypeCol(jend)) |
| 387 |
+ |
else |
| 388 |
+ |
deallocate(groupToGtypeCol) |
| 389 |
+ |
allocate(groupToGtypeCol(jend)) |
| 390 |
+ |
end if |
| 391 |
+ |
|
| 392 |
+ |
if(.not.associated(groupToGtypeCol)) then |
| 393 |
+ |
allocate(groupToGtypeCol(jend)) |
| 394 |
+ |
else |
| 395 |
+ |
deallocate(groupToGtypeCol) |
| 396 |
+ |
allocate(groupToGtypeCol(jend)) |
| 397 |
+ |
end if |
| 398 |
+ |
if(.not.associated(gtypeMaxCutoffCol)) then |
| 399 |
+ |
allocate(gtypeMaxCutoffCol(jend)) |
| 400 |
+ |
else |
| 401 |
+ |
deallocate(gtypeMaxCutoffCol) |
| 402 |
+ |
allocate(gtypeMaxCutoffCol(jend)) |
| 403 |
+ |
end if |
| 404 |
+ |
|
| 405 |
+ |
groupMaxCutoffCol = 0.0_dp |
| 406 |
+ |
gtypeMaxCutoffCol = 0.0_dp |
| 407 |
+ |
|
| 408 |
+ |
#endif |
| 409 |
+ |
groupMaxCutoffRow = 0.0_dp |
| 410 |
+ |
gtypeMaxCutoffRow = 0.0_dp |
| 411 |
+ |
|
| 412 |
+ |
|
| 413 |
+ |
!! first we do a single loop over the cutoff groups to find the |
| 414 |
+ |
!! largest cutoff for any atypes present in this group. We also |
| 415 |
+ |
!! create gtypes at this point. |
| 416 |
+ |
|
| 417 |
+ |
tol = 1.0d-6 |
| 418 |
+ |
nGroupTypesRow = 0 |
| 419 |
+ |
|
| 420 |
+ |
do i = istart, iend |
| 421 |
+ |
n_in_i = groupStartRow(i+1) - groupStartRow(i) |
| 422 |
+ |
groupMaxCutoffRow(i) = 0.0_dp |
| 423 |
+ |
do ia = groupStartRow(i), groupStartRow(i+1)-1 |
| 424 |
+ |
atom1 = groupListRow(ia) |
| 425 |
+ |
#ifdef IS_MPI |
| 426 |
+ |
me_i = atid_row(atom1) |
| 427 |
+ |
#else |
| 428 |
+ |
me_i = atid(atom1) |
| 429 |
+ |
#endif |
| 430 |
+ |
if (atypeMaxCutoff(me_i).gt.groupMaxCutoffRow(i)) then |
| 431 |
+ |
groupMaxCutoffRow(i)=atypeMaxCutoff(me_i) |
| 432 |
+ |
endif |
| 433 |
+ |
enddo |
| 434 |
+ |
|
| 435 |
+ |
if (nGroupTypesRow.eq.0) then |
| 436 |
+ |
nGroupTypesRow = nGroupTypesRow + 1 |
| 437 |
+ |
gtypeMaxCutoffRow(nGroupTypesRow) = groupMaxCutoffRow(i) |
| 438 |
+ |
groupToGtypeRow(i) = nGroupTypesRow |
| 439 |
+ |
else |
| 440 |
+ |
GtypeFound = .false. |
| 441 |
+ |
do g = 1, nGroupTypesRow |
| 442 |
+ |
if ( abs(groupMaxCutoffRow(i) - gtypeMaxCutoffRow(g)).lt.tol) then |
| 443 |
+ |
groupToGtypeRow(i) = g |
| 444 |
+ |
GtypeFound = .true. |
| 445 |
+ |
endif |
| 446 |
+ |
enddo |
| 447 |
+ |
if (.not.GtypeFound) then |
| 448 |
+ |
nGroupTypesRow = nGroupTypesRow + 1 |
| 449 |
+ |
gtypeMaxCutoffRow(nGroupTypesRow) = groupMaxCutoffRow(i) |
| 450 |
+ |
groupToGtypeRow(i) = nGroupTypesRow |
| 451 |
+ |
endif |
| 452 |
+ |
endif |
| 453 |
+ |
enddo |
| 454 |
+ |
|
| 455 |
+ |
#ifdef IS_MPI |
| 456 |
+ |
do j = jstart, jend |
| 457 |
+ |
n_in_j = groupStartCol(j+1) - groupStartCol(j) |
| 458 |
+ |
groupMaxCutoffCol(j) = 0.0_dp |
| 459 |
+ |
do ja = groupStartCol(j), groupStartCol(j+1)-1 |
| 460 |
+ |
atom1 = groupListCol(ja) |
| 461 |
+ |
|
| 462 |
+ |
me_j = atid_col(atom1) |
| 463 |
+ |
|
| 464 |
+ |
if (atypeMaxCutoff(me_j).gt.groupMaxCutoffCol(j)) then |
| 465 |
+ |
groupMaxCutoffCol(j)=atypeMaxCutoff(me_j) |
| 466 |
+ |
endif |
| 467 |
+ |
enddo |
| 468 |
+ |
|
| 469 |
+ |
if (nGroupTypesCol.eq.0) then |
| 470 |
+ |
nGroupTypesCol = nGroupTypesCol + 1 |
| 471 |
+ |
gtypeMaxCutoffCol(nGroupTypesCol) = groupMaxCutoffCol(j) |
| 472 |
+ |
groupToGtypeCol(j) = nGroupTypesCol |
| 473 |
+ |
else |
| 474 |
+ |
GtypeFound = .false. |
| 475 |
+ |
do g = 1, nGroupTypesCol |
| 476 |
+ |
if ( abs(groupMaxCutoffCol(j) - gtypeMaxCutoffCol(g)).lt.tol) then |
| 477 |
+ |
groupToGtypeCol(j) = g |
| 478 |
+ |
GtypeFound = .true. |
| 479 |
+ |
endif |
| 480 |
+ |
enddo |
| 481 |
+ |
if (.not.GtypeFound) then |
| 482 |
+ |
nGroupTypesCol = nGroupTypesCol + 1 |
| 483 |
+ |
gtypeMaxCutoffCol(nGroupTypesCol) = groupMaxCutoffCol(j) |
| 484 |
+ |
groupToGtypeCol(j) = nGroupTypesCol |
| 485 |
+ |
endif |
| 486 |
+ |
endif |
| 487 |
+ |
enddo |
| 488 |
+ |
|
| 489 |
+ |
#else |
| 490 |
+ |
! Set pointers to information we just found |
| 491 |
+ |
nGroupTypesCol = nGroupTypesRow |
| 492 |
+ |
groupToGtypeCol => groupToGtypeRow |
| 493 |
+ |
gtypeMaxCutoffCol => gtypeMaxCutoffRow |
| 494 |
+ |
groupMaxCutoffCol => groupMaxCutoffRow |
| 495 |
+ |
#endif |
| 496 |
+ |
|
| 497 |
+ |
|
| 498 |
+ |
|
| 499 |
+ |
|
| 500 |
+ |
|
| 501 |
+ |
!! allocate the gtypeCutoffMap here. |
| 502 |
+ |
allocate(gtypeCutoffMap(nGroupTypesRow,nGroupTypesCol)) |
| 503 |
+ |
!! then we do a double loop over all the group TYPES to find the cutoff |
| 504 |
+ |
!! map between groups of two types |
| 505 |
+ |
tradRcut = max(maxval(gtypeMaxCutoffRow),maxval(gtypeMaxCutoffCol)) |
| 506 |
+ |
|
| 507 |
+ |
do i = 1, nGroupTypesRow |
| 508 |
+ |
do j = 1, nGroupTypesCol |
| 509 |
+ |
|
| 510 |
+ |
select case(cutoffPolicy) |
| 511 |
+ |
case(TRADITIONAL_CUTOFF_POLICY) |
| 512 |
+ |
thisRcut = tradRcut |
| 513 |
+ |
case(MIX_CUTOFF_POLICY) |
| 514 |
+ |
thisRcut = 0.5_dp * (gtypeMaxCutoffRow(i) + gtypeMaxCutoffCol(j)) |
| 515 |
+ |
case(MAX_CUTOFF_POLICY) |
| 516 |
+ |
thisRcut = max(gtypeMaxCutoffRow(i), gtypeMaxCutoffCol(j)) |
| 517 |
+ |
case default |
| 518 |
+ |
call handleError("createGtypeCutoffMap", "Unknown Cutoff Policy") |
| 519 |
+ |
return |
| 520 |
+ |
end select |
| 521 |
+ |
gtypeCutoffMap(i,j)%rcut = thisRcut |
| 522 |
+ |
gtypeCutoffMap(i,j)%rcutsq = thisRcut*thisRcut |
| 523 |
+ |
skin = defaultRlist - defaultRcut |
| 524 |
+ |
listSkin = skin ! set neighbor list skin thickness |
| 525 |
+ |
gtypeCutoffMap(i,j)%rlistsq = (thisRcut + skin)**2 |
| 526 |
+ |
|
| 527 |
+ |
! sanity check |
| 528 |
+ |
|
| 529 |
+ |
if (haveDefaultCutoffs) then |
| 530 |
+ |
if (abs(gtypeCutoffMap(i,j)%rcut - defaultRcut).gt.0.0001) then |
| 531 |
+ |
call handleError("createGtypeCutoffMap", "user-specified rCut does not match computed group Cutoff") |
| 532 |
+ |
endif |
| 533 |
+ |
endif |
| 534 |
+ |
enddo |
| 535 |
+ |
enddo |
| 536 |
+ |
if(allocated(gtypeMaxCutoffRow)) deallocate(gtypeMaxCutoffRow) |
| 537 |
+ |
if(allocated(groupMaxCutoffRow)) deallocate(groupMaxCutoffRow) |
| 538 |
+ |
if(allocated(atypeMaxCutoff)) deallocate(atypeMaxCutoff) |
| 539 |
+ |
#ifdef IS_MPI |
| 540 |
+ |
if(associated(groupMaxCutoffCol)) deallocate(groupMaxCutoffCol) |
| 541 |
+ |
if(associated(gtypeMaxCutoffCol)) deallocate(gtypeMaxCutoffCol) |
| 542 |
+ |
#endif |
| 543 |
+ |
groupMaxCutoffCol => null() |
| 544 |
+ |
gtypeMaxCutoffCol => null() |
| 545 |
+ |
|
| 546 |
+ |
haveGtypeCutoffMap = .true. |
| 547 |
+ |
end subroutine createGtypeCutoffMap |
| 548 |
+ |
|
| 549 |
+ |
subroutine setDefaultCutoffs(defRcut, defRsw, defRlist, cutPolicy) |
| 550 |
+ |
real(kind=dp),intent(in) :: defRcut, defRsw, defRlist |
| 551 |
+ |
integer, intent(in) :: cutPolicy |
| 552 |
+ |
|
| 553 |
+ |
defaultRcut = defRcut |
| 554 |
+ |
defaultRsw = defRsw |
| 555 |
+ |
defaultRlist = defRlist |
| 556 |
+ |
cutoffPolicy = cutPolicy |
| 557 |
+ |
|
| 558 |
+ |
haveDefaultCutoffs = .true. |
| 559 |
+ |
end subroutine setDefaultCutoffs |
| 560 |
+ |
|
| 561 |
+ |
subroutine setCutoffPolicy(cutPolicy) |
| 562 |
+ |
|
| 563 |
+ |
integer, intent(in) :: cutPolicy |
| 564 |
+ |
cutoffPolicy = cutPolicy |
| 565 |
+ |
call createGtypeCutoffMap() |
| 566 |
+ |
end subroutine setCutoffPolicy |
| 567 |
+ |
|
| 568 |
+ |
|
| 569 |
|
subroutine setSimVariables() |
| 570 |
|
SIM_uses_DirectionalAtoms = SimUsesDirectionalAtoms() |
| 358 |
– |
SIM_uses_LennardJones = SimUsesLennardJones() |
| 359 |
– |
SIM_uses_Electrostatics = SimUsesElectrostatics() |
| 360 |
– |
SIM_uses_Charges = SimUsesCharges() |
| 361 |
– |
SIM_uses_Dipoles = SimUsesDipoles() |
| 362 |
– |
SIM_uses_Sticky = SimUsesSticky() |
| 363 |
– |
SIM_uses_StickyPower = SimUsesStickyPower() |
| 364 |
– |
SIM_uses_GayBerne = SimUsesGayBerne() |
| 571 |
|
SIM_uses_EAM = SimUsesEAM() |
| 366 |
– |
SIM_uses_Shapes = SimUsesShapes() |
| 367 |
– |
SIM_uses_FLARB = SimUsesFLARB() |
| 368 |
– |
SIM_uses_RF = SimUsesRF() |
| 572 |
|
SIM_requires_postpair_calc = SimRequiresPostpairCalc() |
| 573 |
|
SIM_requires_prepair_calc = SimRequiresPrepairCalc() |
| 574 |
|
SIM_uses_PBC = SimUsesPBC() |
| 585 |
|
|
| 586 |
|
error = 0 |
| 587 |
|
|
| 588 |
< |
if (.not. haveInteractionMap) then |
| 588 |
> |
if (.not. haveInteractionHash) then |
| 589 |
> |
myStatus = 0 |
| 590 |
> |
call createInteractionHash(myStatus) |
| 591 |
> |
if (myStatus .ne. 0) then |
| 592 |
> |
write(default_error, *) 'createInteractionHash failed in doForces!' |
| 593 |
> |
error = -1 |
| 594 |
> |
return |
| 595 |
> |
endif |
| 596 |
> |
endif |
| 597 |
|
|
| 598 |
< |
myStatus = 0 |
| 599 |
< |
|
| 600 |
< |
call createInteractionMap(myStatus) |
| 390 |
< |
|
| 598 |
> |
if (.not. haveGtypeCutoffMap) then |
| 599 |
> |
myStatus = 0 |
| 600 |
> |
call createGtypeCutoffMap(myStatus) |
| 601 |
|
if (myStatus .ne. 0) then |
| 602 |
< |
write(default_error, *) 'createInteractionMap failed in doForces!' |
| 602 |
> |
write(default_error, *) 'createGtypeCutoffMap failed in doForces!' |
| 603 |
|
error = -1 |
| 604 |
|
return |
| 605 |
|
endif |
| 609 |
|
call setSimVariables() |
| 610 |
|
endif |
| 611 |
|
|
| 612 |
< |
if (.not. haveRlist) then |
| 613 |
< |
write(default_error, *) 'rList has not been set in doForces!' |
| 614 |
< |
error = -1 |
| 615 |
< |
return |
| 616 |
< |
endif |
| 612 |
> |
! if (.not. haveRlist) then |
| 613 |
> |
! write(default_error, *) 'rList has not been set in doForces!' |
| 614 |
> |
! error = -1 |
| 615 |
> |
! return |
| 616 |
> |
! endif |
| 617 |
|
|
| 618 |
|
if (.not. haveNeighborList) then |
| 619 |
|
write(default_error, *) 'neighbor list has not been initialized in doForces!' |
| 638 |
|
end subroutine doReadyCheck |
| 639 |
|
|
| 640 |
|
|
| 641 |
< |
subroutine init_FF(use_RF_c, thisStat) |
| 641 |
> |
subroutine init_FF(thisESM, thisStat) |
| 642 |
|
|
| 643 |
< |
logical, intent(in) :: use_RF_c |
| 434 |
< |
|
| 643 |
> |
integer, intent(in) :: thisESM |
| 644 |
|
integer, intent(out) :: thisStat |
| 645 |
|
integer :: my_status, nMatches |
| 646 |
|
integer, pointer :: MatchList(:) => null() |
| 438 |
– |
real(kind=dp) :: rcut, rrf, rt, dielect |
| 647 |
|
|
| 648 |
|
!! assume things are copacetic, unless they aren't |
| 649 |
|
thisStat = 0 |
| 650 |
|
|
| 651 |
< |
!! Fortran's version of a cast: |
| 444 |
< |
FF_uses_RF = use_RF_c |
| 651 |
> |
electrostaticSummationMethod = thisESM |
| 652 |
|
|
| 653 |
|
!! init_FF is called *after* all of the atom types have been |
| 654 |
|
!! defined in atype_module using the new_atype subroutine. |
| 657 |
|
!! interactions are used by the force field. |
| 658 |
|
|
| 659 |
|
FF_uses_DirectionalAtoms = .false. |
| 453 |
– |
FF_uses_LennardJones = .false. |
| 454 |
– |
FF_uses_Electrostatics = .false. |
| 455 |
– |
FF_uses_Charges = .false. |
| 660 |
|
FF_uses_Dipoles = .false. |
| 457 |
– |
FF_uses_Sticky = .false. |
| 458 |
– |
FF_uses_StickyPower = .false. |
| 661 |
|
FF_uses_GayBerne = .false. |
| 662 |
|
FF_uses_EAM = .false. |
| 461 |
– |
FF_uses_Shapes = .false. |
| 462 |
– |
FF_uses_FLARB = .false. |
| 663 |
|
|
| 664 |
|
call getMatchingElementList(atypes, "is_Directional", .true., & |
| 665 |
|
nMatches, MatchList) |
| 666 |
|
if (nMatches .gt. 0) FF_uses_DirectionalAtoms = .true. |
| 667 |
|
|
| 468 |
– |
call getMatchingElementList(atypes, "is_LennardJones", .true., & |
| 469 |
– |
nMatches, MatchList) |
| 470 |
– |
if (nMatches .gt. 0) FF_uses_LennardJones = .true. |
| 471 |
– |
|
| 472 |
– |
call getMatchingElementList(atypes, "is_Electrostatic", .true., & |
| 473 |
– |
nMatches, MatchList) |
| 474 |
– |
if (nMatches .gt. 0) then |
| 475 |
– |
FF_uses_Electrostatics = .true. |
| 476 |
– |
endif |
| 477 |
– |
|
| 478 |
– |
call getMatchingElementList(atypes, "is_Charge", .true., & |
| 479 |
– |
nMatches, MatchList) |
| 480 |
– |
if (nMatches .gt. 0) then |
| 481 |
– |
FF_uses_Charges = .true. |
| 482 |
– |
FF_uses_Electrostatics = .true. |
| 483 |
– |
endif |
| 484 |
– |
|
| 668 |
|
call getMatchingElementList(atypes, "is_Dipole", .true., & |
| 669 |
|
nMatches, MatchList) |
| 670 |
< |
if (nMatches .gt. 0) then |
| 488 |
< |
FF_uses_Dipoles = .true. |
| 489 |
< |
FF_uses_Electrostatics = .true. |
| 490 |
< |
FF_uses_DirectionalAtoms = .true. |
| 491 |
< |
endif |
| 492 |
< |
|
| 493 |
< |
call getMatchingElementList(atypes, "is_Quadrupole", .true., & |
| 494 |
< |
nMatches, MatchList) |
| 495 |
< |
if (nMatches .gt. 0) then |
| 496 |
< |
FF_uses_Quadrupoles = .true. |
| 497 |
< |
FF_uses_Electrostatics = .true. |
| 498 |
< |
FF_uses_DirectionalAtoms = .true. |
| 499 |
< |
endif |
| 500 |
< |
|
| 501 |
< |
call getMatchingElementList(atypes, "is_Sticky", .true., nMatches, & |
| 502 |
< |
MatchList) |
| 503 |
< |
if (nMatches .gt. 0) then |
| 504 |
< |
FF_uses_Sticky = .true. |
| 505 |
< |
FF_uses_DirectionalAtoms = .true. |
| 506 |
< |
endif |
| 507 |
< |
|
| 508 |
< |
call getMatchingElementList(atypes, "is_StickyPower", .true., nMatches, & |
| 509 |
< |
MatchList) |
| 510 |
< |
if (nMatches .gt. 0) then |
| 511 |
< |
FF_uses_StickyPower = .true. |
| 512 |
< |
FF_uses_DirectionalAtoms = .true. |
| 513 |
< |
endif |
| 670 |
> |
if (nMatches .gt. 0) FF_uses_Dipoles = .true. |
| 671 |
|
|
| 672 |
|
call getMatchingElementList(atypes, "is_GayBerne", .true., & |
| 673 |
|
nMatches, MatchList) |
| 674 |
< |
if (nMatches .gt. 0) then |
| 518 |
< |
FF_uses_GayBerne = .true. |
| 519 |
< |
FF_uses_DirectionalAtoms = .true. |
| 520 |
< |
endif |
| 674 |
> |
if (nMatches .gt. 0) FF_uses_GayBerne = .true. |
| 675 |
|
|
| 676 |
|
call getMatchingElementList(atypes, "is_EAM", .true., nMatches, MatchList) |
| 677 |
|
if (nMatches .gt. 0) FF_uses_EAM = .true. |
| 678 |
|
|
| 525 |
– |
call getMatchingElementList(atypes, "is_Shape", .true., & |
| 526 |
– |
nMatches, MatchList) |
| 527 |
– |
if (nMatches .gt. 0) then |
| 528 |
– |
FF_uses_Shapes = .true. |
| 529 |
– |
FF_uses_DirectionalAtoms = .true. |
| 530 |
– |
endif |
| 679 |
|
|
| 532 |
– |
call getMatchingElementList(atypes, "is_FLARB", .true., & |
| 533 |
– |
nMatches, MatchList) |
| 534 |
– |
if (nMatches .gt. 0) FF_uses_FLARB = .true. |
| 535 |
– |
|
| 536 |
– |
!! Assume sanity (for the sake of argument) |
| 680 |
|
haveSaneForceField = .true. |
| 681 |
|
|
| 539 |
– |
!! check to make sure the FF_uses_RF setting makes sense |
| 540 |
– |
|
| 541 |
– |
if (FF_uses_dipoles) then |
| 542 |
– |
if (FF_uses_RF) then |
| 543 |
– |
dielect = getDielect() |
| 544 |
– |
call initialize_rf(dielect) |
| 545 |
– |
endif |
| 546 |
– |
else |
| 547 |
– |
if (FF_uses_RF) then |
| 548 |
– |
write(default_error,*) 'Using Reaction Field with no dipoles? Huh?' |
| 549 |
– |
thisStat = -1 |
| 550 |
– |
haveSaneForceField = .false. |
| 551 |
– |
return |
| 552 |
– |
endif |
| 553 |
– |
endif |
| 554 |
– |
|
| 555 |
– |
!sticky module does not contain check_sticky_FF anymore |
| 556 |
– |
!if (FF_uses_sticky) then |
| 557 |
– |
! call check_sticky_FF(my_status) |
| 558 |
– |
! if (my_status /= 0) then |
| 559 |
– |
! thisStat = -1 |
| 560 |
– |
! haveSaneForceField = .false. |
| 561 |
– |
! return |
| 562 |
– |
! end if |
| 563 |
– |
!endif |
| 564 |
– |
|
| 682 |
|
if (FF_uses_EAM) then |
| 683 |
|
call init_EAM_FF(my_status) |
| 684 |
|
if (my_status /= 0) then |
| 689 |
|
end if |
| 690 |
|
endif |
| 691 |
|
|
| 575 |
– |
if (FF_uses_GayBerne) then |
| 576 |
– |
call check_gb_pair_FF(my_status) |
| 577 |
– |
if (my_status .ne. 0) then |
| 578 |
– |
thisStat = -1 |
| 579 |
– |
haveSaneForceField = .false. |
| 580 |
– |
return |
| 581 |
– |
endif |
| 582 |
– |
endif |
| 583 |
– |
|
| 584 |
– |
if (FF_uses_GayBerne .and. FF_uses_LennardJones) then |
| 585 |
– |
endif |
| 586 |
– |
|
| 692 |
|
if (.not. haveNeighborList) then |
| 693 |
|
!! Create neighbor lists |
| 694 |
|
call expandNeighborList(nLocal, my_status) |
| 722 |
|
|
| 723 |
|
!! Stress Tensor |
| 724 |
|
real( kind = dp), dimension(9) :: tau |
| 725 |
< |
real ( kind = dp ) :: pot |
| 725 |
> |
real ( kind = dp ),dimension(LR_POT_TYPES) :: pot |
| 726 |
|
logical ( kind = 2) :: do_pot_c, do_stress_c |
| 727 |
|
logical :: do_pot |
| 728 |
|
logical :: do_stress |
| 729 |
|
logical :: in_switching_region |
| 730 |
|
#ifdef IS_MPI |
| 731 |
< |
real( kind = DP ) :: pot_local |
| 731 |
> |
real( kind = DP ), dimension(LR_POT_TYPES) :: pot_local |
| 732 |
|
integer :: nAtomsInRow |
| 733 |
|
integer :: nAtomsInCol |
| 734 |
|
integer :: nprocs |
| 743 |
|
integer :: nlist |
| 744 |
|
real( kind = DP ) :: ratmsq, rgrpsq, rgrp, vpair, vij |
| 745 |
|
real( kind = DP ) :: sw, dswdr, swderiv, mf |
| 746 |
+ |
real( kind = DP ) :: rVal |
| 747 |
|
real(kind=dp),dimension(3) :: d_atm, d_grp, fpair, fij |
| 748 |
+ |
real(kind=dp), dimension(3) :: fstrs, f2strs |
| 749 |
|
real(kind=dp) :: rfpot, mu_i, virial |
| 750 |
|
integer :: me_i, me_j, n_in_i, n_in_j |
| 751 |
|
logical :: is_dp_i |
| 754 |
|
integer :: localError |
| 755 |
|
integer :: propPack_i, propPack_j |
| 756 |
|
integer :: loopStart, loopEnd, loop |
| 757 |
< |
integer :: iMap |
| 758 |
< |
real(kind=dp) :: listSkin = 1.0 |
| 757 |
> |
integer :: iHash |
| 758 |
> |
integer :: i1 |
| 759 |
> |
|
| 760 |
|
|
| 761 |
|
!! initialize local variables |
| 762 |
|
|
| 847 |
|
#endif |
| 848 |
|
outer: do i = istart, iend |
| 849 |
|
|
| 742 |
– |
#ifdef IS_MPI |
| 743 |
– |
me_i = atid_row(i) |
| 744 |
– |
#else |
| 745 |
– |
me_i = atid(i) |
| 746 |
– |
#endif |
| 747 |
– |
|
| 850 |
|
if (update_nlist) point(i) = nlist + 1 |
| 851 |
|
|
| 852 |
|
n_in_i = groupStartRow(i+1) - groupStartRow(i) |
| 881 |
|
me_j = atid(j) |
| 882 |
|
call get_interatomic_vector(q_group(:,i), & |
| 883 |
|
q_group(:,j), d_grp, rgrpsq) |
| 884 |
< |
#endif |
| 884 |
> |
#endif |
| 885 |
|
|
| 886 |
< |
if (rgrpsq < InteractionMap(me_i,me_j)%rListsq) then |
| 886 |
> |
if (rgrpsq < gtypeCutoffMap(groupToGtypeRow(i),groupToGtypeCol(j))%rListsq) then |
| 887 |
|
if (update_nlist) then |
| 888 |
|
nlist = nlist + 1 |
| 889 |
|
|
| 903 |
|
|
| 904 |
|
list(nlist) = j |
| 905 |
|
endif |
| 906 |
+ |
|
| 907 |
+ |
if (rgrpsq < gtypeCutoffMap(groupToGtypeRow(i),groupToGtypeCol(j))%rCutsq) then |
| 908 |
|
|
| 909 |
< |
if (loop .eq. PAIR_LOOP) then |
| 910 |
< |
vij = 0.0d0 |
| 911 |
< |
fij(1:3) = 0.0d0 |
| 912 |
< |
endif |
| 913 |
< |
|
| 914 |
< |
call get_switch(rgrpsq, sw, dswdr, rgrp, group_switch, & |
| 915 |
< |
in_switching_region) |
| 916 |
< |
|
| 917 |
< |
n_in_j = groupStartCol(j+1) - groupStartCol(j) |
| 918 |
< |
|
| 919 |
< |
do ia = groupStartRow(i), groupStartRow(i+1)-1 |
| 920 |
< |
|
| 921 |
< |
atom1 = groupListRow(ia) |
| 922 |
< |
|
| 923 |
< |
inner: do jb = groupStartCol(j), groupStartCol(j+1)-1 |
| 924 |
< |
|
| 925 |
< |
atom2 = groupListCol(jb) |
| 926 |
< |
|
| 927 |
< |
if (skipThisPair(atom1, atom2)) cycle inner |
| 928 |
< |
|
| 929 |
< |
if ((n_in_i .eq. 1).and.(n_in_j .eq. 1)) then |
| 930 |
< |
d_atm(1:3) = d_grp(1:3) |
| 931 |
< |
ratmsq = rgrpsq |
| 932 |
< |
else |
| 909 |
> |
if (loop .eq. PAIR_LOOP) then |
| 910 |
> |
vij = 0.0d0 |
| 911 |
> |
fij(1:3) = 0.0d0 |
| 912 |
> |
endif |
| 913 |
> |
|
| 914 |
> |
call get_switch(rgrpsq, sw, dswdr, rgrp, group_switch, & |
| 915 |
> |
in_switching_region) |
| 916 |
> |
|
| 917 |
> |
n_in_j = groupStartCol(j+1) - groupStartCol(j) |
| 918 |
> |
|
| 919 |
> |
do ia = groupStartRow(i), groupStartRow(i+1)-1 |
| 920 |
> |
|
| 921 |
> |
atom1 = groupListRow(ia) |
| 922 |
> |
|
| 923 |
> |
inner: do jb = groupStartCol(j), groupStartCol(j+1)-1 |
| 924 |
> |
|
| 925 |
> |
atom2 = groupListCol(jb) |
| 926 |
> |
|
| 927 |
> |
if (skipThisPair(atom1, atom2)) cycle inner |
| 928 |
> |
|
| 929 |
> |
if ((n_in_i .eq. 1).and.(n_in_j .eq. 1)) then |
| 930 |
> |
d_atm(1:3) = d_grp(1:3) |
| 931 |
> |
ratmsq = rgrpsq |
| 932 |
> |
else |
| 933 |
|
#ifdef IS_MPI |
| 934 |
< |
call get_interatomic_vector(q_Row(:,atom1), & |
| 935 |
< |
q_Col(:,atom2), d_atm, ratmsq) |
| 934 |
> |
call get_interatomic_vector(q_Row(:,atom1), & |
| 935 |
> |
q_Col(:,atom2), d_atm, ratmsq) |
| 936 |
|
#else |
| 937 |
< |
call get_interatomic_vector(q(:,atom1), & |
| 938 |
< |
q(:,atom2), d_atm, ratmsq) |
| 937 |
> |
call get_interatomic_vector(q(:,atom1), & |
| 938 |
> |
q(:,atom2), d_atm, ratmsq) |
| 939 |
|
#endif |
| 940 |
< |
endif |
| 941 |
< |
|
| 942 |
< |
if (loop .eq. PREPAIR_LOOP) then |
| 940 |
> |
endif |
| 941 |
> |
|
| 942 |
> |
if (loop .eq. PREPAIR_LOOP) then |
| 943 |
|
#ifdef IS_MPI |
| 944 |
< |
call do_prepair(atom1, atom2, ratmsq, d_atm, sw, & |
| 945 |
< |
rgrpsq, d_grp, do_pot, do_stress, & |
| 946 |
< |
eFrame, A, f, t, pot_local) |
| 944 |
> |
call do_prepair(atom1, atom2, ratmsq, d_atm, sw, & |
| 945 |
> |
rgrpsq, d_grp, do_pot, do_stress, & |
| 946 |
> |
eFrame, A, f, t, pot_local) |
| 947 |
|
#else |
| 948 |
< |
call do_prepair(atom1, atom2, ratmsq, d_atm, sw, & |
| 949 |
< |
rgrpsq, d_grp, do_pot, do_stress, & |
| 950 |
< |
eFrame, A, f, t, pot) |
| 948 |
> |
call do_prepair(atom1, atom2, ratmsq, d_atm, sw, & |
| 949 |
> |
rgrpsq, d_grp, do_pot, do_stress, & |
| 950 |
> |
eFrame, A, f, t, pot) |
| 951 |
|
#endif |
| 952 |
< |
else |
| 952 |
> |
else |
| 953 |
|
#ifdef IS_MPI |
| 954 |
< |
call do_pair(atom1, atom2, ratmsq, d_atm, sw, & |
| 955 |
< |
do_pot, & |
| 956 |
< |
eFrame, A, f, t, pot_local, vpair, fpair) |
| 954 |
> |
call do_pair(atom1, atom2, ratmsq, d_atm, sw, & |
| 955 |
> |
do_pot, eFrame, A, f, t, pot_local, vpair, & |
| 956 |
> |
fpair, d_grp, rgrp, fstrs) |
| 957 |
|
#else |
| 958 |
< |
call do_pair(atom1, atom2, ratmsq, d_atm, sw, & |
| 959 |
< |
do_pot, & |
| 960 |
< |
eFrame, A, f, t, pot, vpair, fpair) |
| 958 |
> |
call do_pair(atom1, atom2, ratmsq, d_atm, sw, & |
| 959 |
> |
do_pot, eFrame, A, f, t, pot, vpair, fpair, & |
| 960 |
> |
d_grp, rgrp, fstrs) |
| 961 |
|
#endif |
| 962 |
+ |
f2strs(1:3) = f2strs(1:3) + fstrs(1:3) |
| 963 |
+ |
vij = vij + vpair |
| 964 |
+ |
fij(1:3) = fij(1:3) + fpair(1:3) |
| 965 |
+ |
endif |
| 966 |
+ |
enddo inner |
| 967 |
+ |
enddo |
| 968 |
|
|
| 969 |
< |
vij = vij + vpair |
| 970 |
< |
fij(1:3) = fij(1:3) + fpair(1:3) |
| 971 |
< |
endif |
| 972 |
< |
enddo inner |
| 973 |
< |
enddo |
| 974 |
< |
|
| 975 |
< |
if (loop .eq. PAIR_LOOP) then |
| 976 |
< |
if (in_switching_region) then |
| 977 |
< |
swderiv = vij*dswdr/rgrp |
| 978 |
< |
fij(1) = fij(1) + swderiv*d_grp(1) |
| 869 |
< |
fij(2) = fij(2) + swderiv*d_grp(2) |
| 870 |
< |
fij(3) = fij(3) + swderiv*d_grp(3) |
| 871 |
< |
|
| 872 |
< |
do ia=groupStartRow(i), groupStartRow(i+1)-1 |
| 873 |
< |
atom1=groupListRow(ia) |
| 874 |
< |
mf = mfactRow(atom1) |
| 969 |
> |
if (loop .eq. PAIR_LOOP) then |
| 970 |
> |
if (in_switching_region) then |
| 971 |
> |
swderiv = vij*dswdr/rgrp |
| 972 |
> |
fij(1) = fij(1) + swderiv*d_grp(1) |
| 973 |
> |
fij(2) = fij(2) + swderiv*d_grp(2) |
| 974 |
> |
fij(3) = fij(3) + swderiv*d_grp(3) |
| 975 |
> |
|
| 976 |
> |
do ia=groupStartRow(i), groupStartRow(i+1)-1 |
| 977 |
> |
atom1=groupListRow(ia) |
| 978 |
> |
mf = mfactRow(atom1) |
| 979 |
|
#ifdef IS_MPI |
| 980 |
< |
f_Row(1,atom1) = f_Row(1,atom1) + swderiv*d_grp(1)*mf |
| 981 |
< |
f_Row(2,atom1) = f_Row(2,atom1) + swderiv*d_grp(2)*mf |
| 982 |
< |
f_Row(3,atom1) = f_Row(3,atom1) + swderiv*d_grp(3)*mf |
| 980 |
> |
f_Row(1,atom1) = f_Row(1,atom1) + swderiv*d_grp(1)*mf |
| 981 |
> |
f_Row(2,atom1) = f_Row(2,atom1) + swderiv*d_grp(2)*mf |
| 982 |
> |
f_Row(3,atom1) = f_Row(3,atom1) + swderiv*d_grp(3)*mf |
| 983 |
|
#else |
| 984 |
< |
f(1,atom1) = f(1,atom1) + swderiv*d_grp(1)*mf |
| 985 |
< |
f(2,atom1) = f(2,atom1) + swderiv*d_grp(2)*mf |
| 986 |
< |
f(3,atom1) = f(3,atom1) + swderiv*d_grp(3)*mf |
| 984 |
> |
f(1,atom1) = f(1,atom1) + swderiv*d_grp(1)*mf |
| 985 |
> |
f(2,atom1) = f(2,atom1) + swderiv*d_grp(2)*mf |
| 986 |
> |
f(3,atom1) = f(3,atom1) + swderiv*d_grp(3)*mf |
| 987 |
|
#endif |
| 988 |
< |
enddo |
| 989 |
< |
|
| 990 |
< |
do jb=groupStartCol(j), groupStartCol(j+1)-1 |
| 991 |
< |
atom2=groupListCol(jb) |
| 992 |
< |
mf = mfactCol(atom2) |
| 988 |
> |
enddo |
| 989 |
> |
|
| 990 |
> |
do jb=groupStartCol(j), groupStartCol(j+1)-1 |
| 991 |
> |
atom2=groupListCol(jb) |
| 992 |
> |
mf = mfactCol(atom2) |
| 993 |
|
#ifdef IS_MPI |
| 994 |
< |
f_Col(1,atom2) = f_Col(1,atom2) - swderiv*d_grp(1)*mf |
| 995 |
< |
f_Col(2,atom2) = f_Col(2,atom2) - swderiv*d_grp(2)*mf |
| 996 |
< |
f_Col(3,atom2) = f_Col(3,atom2) - swderiv*d_grp(3)*mf |
| 994 |
> |
f_Col(1,atom2) = f_Col(1,atom2) - swderiv*d_grp(1)*mf |
| 995 |
> |
f_Col(2,atom2) = f_Col(2,atom2) - swderiv*d_grp(2)*mf |
| 996 |
> |
f_Col(3,atom2) = f_Col(3,atom2) - swderiv*d_grp(3)*mf |
| 997 |
|
#else |
| 998 |
< |
f(1,atom2) = f(1,atom2) - swderiv*d_grp(1)*mf |
| 999 |
< |
f(2,atom2) = f(2,atom2) - swderiv*d_grp(2)*mf |
| 1000 |
< |
f(3,atom2) = f(3,atom2) - swderiv*d_grp(3)*mf |
| 998 |
> |
f(1,atom2) = f(1,atom2) - swderiv*d_grp(1)*mf |
| 999 |
> |
f(2,atom2) = f(2,atom2) - swderiv*d_grp(2)*mf |
| 1000 |
> |
f(3,atom2) = f(3,atom2) - swderiv*d_grp(3)*mf |
| 1001 |
|
#endif |
| 1002 |
< |
enddo |
| 1003 |
< |
endif |
| 1002 |
> |
enddo |
| 1003 |
> |
endif |
| 1004 |
|
|
| 1005 |
< |
if (do_stress) call add_stress_tensor(d_grp, fij) |
| 1005 |
> |
if (do_stress) call add_stress_tensor(d_grp, fij) |
| 1006 |
> |
endif |
| 1007 |
|
endif |
| 1008 |
< |
end if |
| 1008 |
> |
endif |
| 1009 |
|
enddo |
| 1010 |
+ |
|
| 1011 |
|
enddo outer |
| 1012 |
|
|
| 1013 |
|
if (update_nlist) then |
| 1067 |
|
|
| 1068 |
|
if (do_pot) then |
| 1069 |
|
! scatter/gather pot_row into the members of my column |
| 1070 |
< |
call scatter(pot_Row, pot_Temp, plan_atom_row) |
| 1071 |
< |
|
| 1070 |
> |
do i = 1,LR_POT_TYPES |
| 1071 |
> |
call scatter(pot_Row(i,:), pot_Temp(i,:), plan_atom_row) |
| 1072 |
> |
end do |
| 1073 |
|
! scatter/gather pot_local into all other procs |
| 1074 |
|
! add resultant to get total pot |
| 1075 |
|
do i = 1, nlocal |
| 1076 |
< |
pot_local = pot_local + pot_Temp(i) |
| 1076 |
> |
pot_local(1:LR_POT_TYPES) = pot_local(1:LR_POT_TYPES) & |
| 1077 |
> |
+ pot_Temp(1:LR_POT_TYPES,i) |
| 1078 |
|
enddo |
| 1079 |
|
|
| 1080 |
|
pot_Temp = 0.0_DP |
| 1081 |
< |
|
| 1082 |
< |
call scatter(pot_Col, pot_Temp, plan_atom_col) |
| 1081 |
> |
do i = 1,LR_POT_TYPES |
| 1082 |
> |
call scatter(pot_Col(i,:), pot_Temp(i,:), plan_atom_col) |
| 1083 |
> |
end do |
| 1084 |
|
do i = 1, nlocal |
| 1085 |
< |
pot_local = pot_local + pot_Temp(i) |
| 1085 |
> |
pot_local(1:LR_POT_TYPES) = pot_local(1:LR_POT_TYPES)& |
| 1086 |
> |
+ pot_Temp(1:LR_POT_TYPES,i) |
| 1087 |
|
enddo |
| 1088 |
|
|
| 1089 |
|
endif |
| 1090 |
|
#endif |
| 981 |
– |
|
| 982 |
– |
if (FF_RequiresPostpairCalc() .and. SIM_requires_postpair_calc) then |
| 1091 |
|
|
| 1092 |
< |
if (FF_uses_RF .and. SIM_uses_RF) then |
| 1092 |
> |
if (SIM_requires_postpair_calc) then |
| 1093 |
> |
do i = 1, nlocal |
| 1094 |
> |
|
| 1095 |
> |
! we loop only over the local atoms, so we don't need row and column |
| 1096 |
> |
! lookups for the types |
| 1097 |
> |
|
| 1098 |
> |
me_i = atid(i) |
| 1099 |
> |
|
| 1100 |
> |
! is the atom electrostatic? See if it would have an |
| 1101 |
> |
! electrostatic interaction with itself |
| 1102 |
> |
iHash = InteractionHash(me_i,me_i) |
| 1103 |
|
|
| 1104 |
+ |
if ( iand(iHash, ELECTROSTATIC_PAIR).ne.0 ) then |
| 1105 |
|
#ifdef IS_MPI |
| 1106 |
< |
call scatter(rf_Row,rf,plan_atom_row_3d) |
| 1107 |
< |
call scatter(rf_Col,rf_Temp,plan_atom_col_3d) |
| 989 |
< |
do i = 1,nlocal |
| 990 |
< |
rf(1:3,i) = rf(1:3,i) + rf_Temp(1:3,i) |
| 991 |
< |
end do |
| 992 |
< |
#endif |
| 993 |
< |
|
| 994 |
< |
do i = 1, nLocal |
| 995 |
< |
|
| 996 |
< |
rfpot = 0.0_DP |
| 997 |
< |
#ifdef IS_MPI |
| 998 |
< |
me_i = atid_row(i) |
| 1106 |
> |
call self_self(i, eFrame, pot_local(ELECTROSTATIC_POT), & |
| 1107 |
> |
t, do_pot) |
| 1108 |
|
#else |
| 1109 |
< |
me_i = atid(i) |
| 1109 |
> |
call self_self(i, eFrame, pot(ELECTROSTATIC_POT), & |
| 1110 |
> |
t, do_pot) |
| 1111 |
|
#endif |
| 1112 |
< |
iMap = InteractionMap(me_i, me_j)%InteractionHash |
| 1112 |
> |
endif |
| 1113 |
> |
|
| 1114 |
> |
|
| 1115 |
> |
if (electrostaticSummationMethod.eq.REACTION_FIELD) then |
| 1116 |
|
|
| 1117 |
< |
if ( iand(iMap, ELECTROSTATIC_PAIR).ne.0 ) then |
| 1118 |
< |
|
| 1119 |
< |
mu_i = getDipoleMoment(me_i) |
| 1120 |
< |
|
| 1121 |
< |
!! The reaction field needs to include a self contribution |
| 1122 |
< |
!! to the field: |
| 1123 |
< |
call accumulate_self_rf(i, mu_i, eFrame) |
| 1124 |
< |
!! Get the reaction field contribution to the |
| 1125 |
< |
!! potential and torques: |
| 1126 |
< |
call reaction_field_final(i, mu_i, eFrame, rfpot, t, do_pot) |
| 1117 |
> |
! loop over the excludes to accumulate RF stuff we've |
| 1118 |
> |
! left out of the normal pair loop |
| 1119 |
> |
|
| 1120 |
> |
do i1 = 1, nSkipsForAtom(i) |
| 1121 |
> |
j = skipsForAtom(i, i1) |
| 1122 |
> |
|
| 1123 |
> |
! prevent overcounting of the skips |
| 1124 |
> |
if (i.lt.j) then |
| 1125 |
> |
call get_interatomic_vector(q(:,i), & |
| 1126 |
> |
q(:,j), d_atm, ratmsq) |
| 1127 |
> |
rVal = dsqrt(ratmsq) |
| 1128 |
> |
call get_switch(ratmsq, sw, dswdr, rVal, group_switch, & |
| 1129 |
> |
in_switching_region) |
| 1130 |
|
#ifdef IS_MPI |
| 1131 |
< |
pot_local = pot_local + rfpot |
| 1131 |
> |
call rf_self_excludes(i, j, sw, eFrame, d_atm, rVal, & |
| 1132 |
> |
vpair, pot_local(ELECTROSTATIC_POT), f, t, do_pot) |
| 1133 |
|
#else |
| 1134 |
< |
pot = pot + rfpot |
| 1135 |
< |
|
| 1134 |
> |
call rf_self_excludes(i, j, sw, eFrame, d_atm, rVal, & |
| 1135 |
> |
vpair, pot(ELECTROSTATIC_POT), f, t, do_pot) |
| 1136 |
|
#endif |
| 1137 |
< |
endif |
| 1138 |
< |
enddo |
| 1139 |
< |
endif |
| 1137 |
> |
endif |
| 1138 |
> |
enddo |
| 1139 |
> |
endif |
| 1140 |
> |
enddo |
| 1141 |
|
endif |
| 1142 |
< |
|
| 1025 |
< |
|
| 1142 |
> |
|
| 1143 |
|
#ifdef IS_MPI |
| 1144 |
< |
|
| 1144 |
> |
|
| 1145 |
|
if (do_pot) then |
| 1146 |
< |
pot = pot + pot_local |
| 1147 |
< |
!! we assume the c code will do the allreduce to get the total potential |
| 1031 |
< |
!! we could do it right here if we needed to... |
| 1146 |
> |
call mpi_allreduce(pot_local, pot, LR_POT_TYPES,mpi_double_precision,mpi_sum, & |
| 1147 |
> |
mpi_comm_world,mpi_err) |
| 1148 |
|
endif |
| 1149 |
< |
|
| 1149 |
> |
|
| 1150 |
|
if (do_stress) then |
| 1151 |
|
call mpi_allreduce(tau_Temp, tau, 9,mpi_double_precision,mpi_sum, & |
| 1152 |
|
mpi_comm_world,mpi_err) |
| 1153 |
|
call mpi_allreduce(virial_Temp, virial,1,mpi_double_precision,mpi_sum, & |
| 1154 |
|
mpi_comm_world,mpi_err) |
| 1155 |
|
endif |
| 1156 |
< |
|
| 1156 |
> |
|
| 1157 |
|
#else |
| 1158 |
< |
|
| 1158 |
> |
|
| 1159 |
|
if (do_stress) then |
| 1160 |
|
tau = tau_Temp |
| 1161 |
|
virial = virial_Temp |
| 1162 |
|
endif |
| 1163 |
< |
|
| 1163 |
> |
|
| 1164 |
|
#endif |
| 1165 |
< |
|
| 1165 |
> |
|
| 1166 |
|
end subroutine do_force_loop |
| 1167 |
|
|
| 1168 |
+ |
!!$ subroutine do_pair(i, j, rijsq, d, sw, do_pot, & |
| 1169 |
+ |
!!$ eFrame, A, f, t, pot, vpair, fpair, d_grp, r_grp) |
| 1170 |
|
subroutine do_pair(i, j, rijsq, d, sw, do_pot, & |
| 1171 |
< |
eFrame, A, f, t, pot, vpair, fpair) |
| 1171 |
> |
eFrame, A, f, t, pot, vpair, fpair, d_grp, r_grp, fstrs) |
| 1172 |
|
|
| 1173 |
< |
real( kind = dp ) :: pot, vpair, sw |
| 1173 |
> |
real( kind = dp ) :: vpair, sw |
| 1174 |
> |
real( kind = dp ), dimension(LR_POT_TYPES) :: pot |
| 1175 |
|
real( kind = dp ), dimension(3) :: fpair |
| 1176 |
+ |
real( kind = dp ), dimension(3) :: fstrs |
| 1177 |
|
real( kind = dp ), dimension(nLocal) :: mfact |
| 1178 |
|
real( kind = dp ), dimension(9,nLocal) :: eFrame |
| 1179 |
|
real( kind = dp ), dimension(9,nLocal) :: A |
| 1183 |
|
logical, intent(inout) :: do_pot |
| 1184 |
|
integer, intent(in) :: i, j |
| 1185 |
|
real ( kind = dp ), intent(inout) :: rijsq |
| 1186 |
< |
real ( kind = dp ) :: r |
| 1186 |
> |
real ( kind = dp ), intent(inout) :: r_grp |
| 1187 |
|
real ( kind = dp ), intent(inout) :: d(3) |
| 1188 |
< |
real ( kind = dp ) :: ebalance |
| 1188 |
> |
real ( kind = dp ), intent(inout) :: d_grp(3) |
| 1189 |
> |
real ( kind = dp ) :: r |
| 1190 |
|
integer :: me_i, me_j |
| 1191 |
|
|
| 1192 |
< |
integer :: iMap |
| 1192 |
> |
integer :: iHash |
| 1193 |
|
|
| 1194 |
|
r = sqrt(rijsq) |
| 1195 |
|
vpair = 0.0d0 |
| 1203 |
|
me_j = atid(j) |
| 1204 |
|
#endif |
| 1205 |
|
|
| 1206 |
< |
iMap = InteractionMap(me_i, me_j)%InteractionHash |
| 1207 |
< |
|
| 1208 |
< |
if ( iand(iMap, LJ_PAIR).ne.0 ) then |
| 1209 |
< |
call do_lj_pair(i, j, d, r, rijsq, sw, vpair, fpair, pot, f, do_pot) |
| 1206 |
> |
iHash = InteractionHash(me_i, me_j) |
| 1207 |
> |
|
| 1208 |
> |
if ( iand(iHash, LJ_PAIR).ne.0 ) then |
| 1209 |
> |
call do_lj_pair(i, j, d, r, rijsq, sw, vpair, fpair, & |
| 1210 |
> |
pot(VDW_POT), f, do_pot) |
| 1211 |
|
endif |
| 1212 |
< |
|
| 1213 |
< |
if ( iand(iMap, ELECTROSTATIC_PAIR).ne.0 ) then |
| 1212 |
> |
|
| 1213 |
> |
if ( iand(iHash, ELECTROSTATIC_PAIR).ne.0 ) then |
| 1214 |
> |
!!$ call doElectrostaticPair(i, j, d, r, rijsq, sw, vpair, fpair, & |
| 1215 |
> |
!!$ pot(ELECTROSTATIC_POT), eFrame, f, t, do_pot) |
| 1216 |
|
call doElectrostaticPair(i, j, d, r, rijsq, sw, vpair, fpair, & |
| 1217 |
< |
pot, eFrame, f, t, do_pot) |
| 1094 |
< |
|
| 1095 |
< |
if (FF_uses_RF .and. SIM_uses_RF) then |
| 1096 |
< |
|
| 1097 |
< |
! CHECK ME (RF needs to know about all electrostatic types) |
| 1098 |
< |
call accumulate_rf(i, j, r, eFrame, sw) |
| 1099 |
< |
call rf_correct_forces(i, j, d, r, eFrame, sw, f, fpair) |
| 1100 |
< |
endif |
| 1101 |
< |
|
| 1217 |
> |
pot(ELECTROSTATIC_POT), eFrame, f, t, do_pot, fstrs) |
| 1218 |
|
endif |
| 1219 |
< |
|
| 1220 |
< |
if ( iand(iMap, STICKY_PAIR).ne.0 ) then |
| 1219 |
> |
|
| 1220 |
> |
if ( iand(iHash, STICKY_PAIR).ne.0 ) then |
| 1221 |
|
call do_sticky_pair(i, j, d, r, rijsq, sw, vpair, fpair, & |
| 1222 |
< |
pot, A, f, t, do_pot) |
| 1222 |
> |
pot(HB_POT), A, f, t, do_pot) |
| 1223 |
|
endif |
| 1224 |
< |
|
| 1225 |
< |
if ( iand(iMap, STICKYPOWER_PAIR).ne.0 ) then |
| 1224 |
> |
|
| 1225 |
> |
if ( iand(iHash, STICKYPOWER_PAIR).ne.0 ) then |
| 1226 |
|
call do_sticky_power_pair(i, j, d, r, rijsq, sw, vpair, fpair, & |
| 1227 |
< |
pot, A, f, t, do_pot) |
| 1227 |
> |
pot(HB_POT), A, f, t, do_pot) |
| 1228 |
|
endif |
| 1229 |
< |
|
| 1230 |
< |
if ( iand(iMap, GAYBERNE_PAIR).ne.0 ) then |
| 1229 |
> |
|
| 1230 |
> |
if ( iand(iHash, GAYBERNE_PAIR).ne.0 ) then |
| 1231 |
|
call do_gb_pair(i, j, d, r, rijsq, sw, vpair, fpair, & |
| 1232 |
< |
pot, A, f, t, do_pot) |
| 1232 |
> |
pot(VDW_POT), A, f, t, do_pot) |
| 1233 |
|
endif |
| 1234 |
|
|
| 1235 |
< |
if ( iand(iMap, GAYBERNE_LJ).ne.0 ) then |
| 1236 |
< |
! call do_gblj_pair(i, j, d, r, rijsq, sw, vpair, fpair, & |
| 1237 |
< |
! pot, A, f, t, do_pot) |
| 1235 |
> |
if ( iand(iHash, GAYBERNE_LJ).ne.0 ) then |
| 1236 |
> |
call do_gb_lj_pair(i, j, d, r, rijsq, sw, vpair, fpair, & |
| 1237 |
> |
pot(VDW_POT), A, f, t, do_pot) |
| 1238 |
|
endif |
| 1239 |
< |
|
| 1240 |
< |
if ( iand(iMap, EAM_PAIR).ne.0 ) then |
| 1241 |
< |
call do_eam_pair(i, j, d, r, rijsq, sw, vpair, fpair, pot, f, & |
| 1242 |
< |
do_pot) |
| 1239 |
> |
|
| 1240 |
> |
if ( iand(iHash, EAM_PAIR).ne.0 ) then |
| 1241 |
> |
call do_eam_pair(i, j, d, r, rijsq, sw, vpair, fpair, & |
| 1242 |
> |
pot(METALLIC_POT), f, do_pot) |
| 1243 |
|
endif |
| 1244 |
< |
|
| 1245 |
< |
if ( iand(iMap, SHAPE_PAIR).ne.0 ) then |
| 1244 |
> |
|
| 1245 |
> |
if ( iand(iHash, SHAPE_PAIR).ne.0 ) then |
| 1246 |
|
call do_shape_pair(i, j, d, r, rijsq, sw, vpair, fpair, & |
| 1247 |
< |
pot, A, f, t, do_pot) |
| 1247 |
> |
pot(VDW_POT), A, f, t, do_pot) |
| 1248 |
|
endif |
| 1249 |
< |
|
| 1250 |
< |
if ( iand(iMap, SHAPE_LJ).ne.0 ) then |
| 1249 |
> |
|
| 1250 |
> |
if ( iand(iHash, SHAPE_LJ).ne.0 ) then |
| 1251 |
|
call do_shape_pair(i, j, d, r, rijsq, sw, vpair, fpair, & |
| 1252 |
< |
pot, A, f, t, do_pot) |
| 1252 |
> |
pot(VDW_POT), A, f, t, do_pot) |
| 1253 |
|
endif |
| 1254 |
< |
|
| 1254 |
> |
|
| 1255 |
|
end subroutine do_pair |
| 1256 |
|
|
| 1257 |
|
subroutine do_prepair(i, j, rijsq, d, sw, rcijsq, dc, & |
| 1258 |
|
do_pot, do_stress, eFrame, A, f, t, pot) |
| 1259 |
|
|
| 1260 |
< |
real( kind = dp ) :: pot, sw |
| 1260 |
> |
real( kind = dp ) :: sw |
| 1261 |
> |
real( kind = dp ), dimension(LR_POT_TYPES) :: pot |
| 1262 |
|
real( kind = dp ), dimension(9,nLocal) :: eFrame |
| 1263 |
|
real (kind=dp), dimension(9,nLocal) :: A |
| 1264 |
|
real (kind=dp), dimension(3,nLocal) :: f |
| 1270 |
|
real ( kind = dp ) :: r, rc |
| 1271 |
|
real ( kind = dp ), intent(inout) :: d(3), dc(3) |
| 1272 |
|
|
| 1273 |
< |
integer :: me_i, me_j, iMap |
| 1273 |
> |
integer :: me_i, me_j, iHash |
| 1274 |
|
|
| 1275 |
+ |
r = sqrt(rijsq) |
| 1276 |
+ |
|
| 1277 |
|
#ifdef IS_MPI |
| 1278 |
|
me_i = atid_row(i) |
| 1279 |
|
me_j = atid_col(j) |
| 1282 |
|
me_j = atid(j) |
| 1283 |
|
#endif |
| 1284 |
|
|
| 1285 |
< |
iMap = InteractionMap(me_i, me_j)%InteractionHash |
| 1285 |
> |
iHash = InteractionHash(me_i, me_j) |
| 1286 |
|
|
| 1287 |
< |
if ( iand(iMap, EAM_PAIR).ne.0 ) then |
| 1287 |
> |
if ( iand(iHash, EAM_PAIR).ne.0 ) then |
| 1288 |
|
call calc_EAM_prepair_rho(i, j, d, r, rijsq ) |
| 1289 |
|
endif |
| 1290 |
|
|
| 1293 |
|
|
| 1294 |
|
subroutine do_preforce(nlocal,pot) |
| 1295 |
|
integer :: nlocal |
| 1296 |
< |
real( kind = dp ) :: pot |
| 1296 |
> |
real( kind = dp ),dimension(LR_POT_TYPES) :: pot |
| 1297 |
|
|
| 1298 |
|
if (FF_uses_EAM .and. SIM_uses_EAM) then |
| 1299 |
< |
call calc_EAM_preforce_Frho(nlocal,pot) |
| 1299 |
> |
call calc_EAM_preforce_Frho(nlocal,pot(METALLIC_POT)) |
| 1300 |
|
endif |
| 1301 |
|
|
| 1302 |
|
|
| 1382 |
|
pot_Col = 0.0_dp |
| 1383 |
|
pot_Temp = 0.0_dp |
| 1384 |
|
|
| 1266 |
– |
rf_Row = 0.0_dp |
| 1267 |
– |
rf_Col = 0.0_dp |
| 1268 |
– |
rf_Temp = 0.0_dp |
| 1269 |
– |
|
| 1385 |
|
#endif |
| 1386 |
|
|
| 1387 |
|
if (FF_uses_EAM .and. SIM_uses_EAM) then |
| 1388 |
|
call clean_EAM() |
| 1389 |
|
endif |
| 1390 |
|
|
| 1276 |
– |
rf = 0.0_dp |
| 1391 |
|
tau_Temp = 0.0_dp |
| 1392 |
|
virial_Temp = 0.0_dp |
| 1393 |
|
end subroutine zero_work_arrays |
| 1476 |
|
|
| 1477 |
|
function FF_UsesDirectionalAtoms() result(doesit) |
| 1478 |
|
logical :: doesit |
| 1479 |
< |
doesit = FF_uses_DirectionalAtoms .or. FF_uses_Dipoles .or. & |
| 1366 |
< |
FF_uses_Quadrupoles .or. FF_uses_Sticky .or. & |
| 1367 |
< |
FF_uses_StickyPower .or. FF_uses_GayBerne .or. FF_uses_Shapes |
| 1479 |
> |
doesit = FF_uses_DirectionalAtoms |
| 1480 |
|
end function FF_UsesDirectionalAtoms |
| 1481 |
|
|
| 1482 |
|
function FF_RequiresPrepairCalc() result(doesit) |
| 1484 |
|
doesit = FF_uses_EAM |
| 1485 |
|
end function FF_RequiresPrepairCalc |
| 1486 |
|
|
| 1375 |
– |
function FF_RequiresPostpairCalc() result(doesit) |
| 1376 |
– |
logical :: doesit |
| 1377 |
– |
doesit = FF_uses_RF |
| 1378 |
– |
end function FF_RequiresPostpairCalc |
| 1379 |
– |
|
| 1487 |
|
#ifdef PROFILE |
| 1488 |
|
function getforcetime() result(totalforcetime) |
| 1489 |
|
real(kind=dp) :: totalforcetime |
