ViewVC Help
View File | Revision Log | Show Annotations | View Changeset | Root Listing
root/group/trunk/mdtools/md_code/lj_FF.F90
(Generate patch)

Comparing trunk/mdtools/md_code/lj_FF.F90 (file contents):
Revision 239 by chuckv, Mon Jan 20 22:36:12 2003 UTC vs.
Revision 253 by chuckv, Thu Jan 30 15:20:21 2003 UTC

# Line 2 | Line 2
2   !! Corresponds to the force field defined in lj_FF.cpp
3   !! @author Charles F. Vardeman II
4   !! @author Matthew Meineke
5 < !! @version $Id: lj_FF.F90,v 1.8 2003-01-20 22:36:12 chuckv Exp $, $Date: 2003-01-20 22:36:12 $, $Name: not supported by cvs2svn $, $Revision: 1.8 $
5 > !! @version $Id: lj_FF.F90,v 1.13 2003-01-30 15:20:21 chuckv Exp $, $Date: 2003-01-30 15:20:21 $, $Name: not supported by cvs2svn $, $Revision: 1.13 $
6  
7  
8  
9   module lj_ff
10    use simulation
11 <  use definitions, ONLY : dp, ndim
11 >  use definitions
12 >  use generic_atypes
13   #ifdef IS_MPI
14    use mpiSimulation
15   #endif
# Line 18 | Line 19 | module lj_ff
19   !! Number of lj_atypes in lj_atype_list
20    integer, save :: n_lj_atypes = 0
21  
22 < !! Starting Size for ljMixed Array
23 <  integer, parameter :: ljMixed_blocksize = 10
22 > !! Global list of lj atypes in simulation
23 >  type (lj_atype), pointer :: ljListHead => null()
24 >  type (lj_atype), pointer :: ljListTail => null()
25  
24 !! Basic atom type for a Lennard-Jones Atom.
25  type, public :: lj_atype
26     private
27     sequence
28 !! Unique number for place in linked list
29     integer :: atype_number = 0
30 !! Unique indentifier number (ie atomic no, etc)
31     integer :: atype_ident = 0
32 !! Mass of Particle
33     real ( kind = dp )  :: mass = 0.0_dp
34 !! Lennard-Jones epslon
35     real ( kind = dp )  :: epslon = 0.0_dp
36 !! Lennard-Jones Sigma
37     real ( kind = dp )  :: sigma = 0.0_dp
38 !! Lennard-Jones Sigma Squared
39     real ( kind = dp )  :: sigma2 = 0.0_dp
40 !! Lennard-Jones Sigma to sixth
41     real ( kind = dp )  :: sigma6 = 0.0_dp
42 !! Pointer for linked list creation
43     type (lj_atype), pointer :: next => null()
44  end type lj_atype
26  
46 !! Pointer type for atype ident array
47  type, public :: lj_atypePtr
48     type (lj_atype), pointer :: this => null()
49  end type lj_atypePtr
50
51 !! Global list of lj atypes in simulation
52  type (lj_atype), pointer :: lj_atype_list => null()
27   !! LJ mixing array  
28 <  type (lj_atype), dimension(:,:), allocatable, pointer :: ljMixed =>null()
55 < !! identity pointer list for force loop.
56 <  type (lj_atypePtr), dimension(:), allocatable :: identPtrList
28 >  type (lj_atype), dimension(:,:), pointer :: ljMixed => null()
29  
30  
31   !! Neighbor list and commom arrays
# Line 64 | Line 36 | module lj_ff
36    integer :: nListAllocs = 0
37    integer, parameter :: maxListAllocs = 5
38  
39 < #ifdef IS_MPI
68 < ! Universal routines: All types of force calculations will need these arrays
69 < ! Arrays specific to a type of force calculation should be declared in that module.
70 <  real( kind = dp ), allocatable, dimension(:,:) :: qRow
71 <  real( kind = dp ), allocatable, dimension(:,:) :: qColumn
39 >  logical, save :: firstTime = .True.
40  
41 <  real( kind = dp ), allocatable, dimension(:,:) :: fRow
42 <  real( kind = dp ), allocatable, dimension(:,:) :: fColumn
43 <
44 <  type (lj_atypePtr), dimension(:), allocatable :: identPtrListRow
45 <  type (lj_atypePtr), dimension(:), allocatable :: identPtrListColumn
41 > !! Atype identity pointer lists
42 > #ifdef IS_MPI
43 > !! Row lj_atype pointer list
44 >  type (lj_identPtrList), dimension(:), pointer :: identPtrListRow => null()
45 > !! Column lj_atype pointer list
46 >  type (lj_identPtrList), dimension(:), pointer :: identPtrListColumn => null()
47 > #else
48 >  type( lj_identPtrList ), dimension(:), pointer :: identPtrList => null()
49   #endif
50  
51  
52 + !! Logical has lj force field module been initialized?
53 +  logical, save :: isljFFinit = .false.
54  
82  logical :: isljFFinit = .false.
55  
84
56   !! Public methods and data
57    public :: new_lj_atype
58    public :: do_lj_ff
59    public :: getLjPot
60 <  
60 >  public :: init_ljFF
61  
62    
63  
64  
65   contains
66  
67 <  subroutine new_lj_atype(ident,mass,epslon,sigma,status)
67 > !! Adds a new lj_atype to the list.
68 >  subroutine new_lj_atype(ident,mass,epsilon,sigma,status)
69      real( kind = dp ), intent(in) :: mass
70 <    real( kind = dp ), intent(in) :: epslon
70 >    real( kind = dp ), intent(in) :: epsilon
71      real( kind = dp ), intent(in) :: sigma
72      integer, intent(in) :: ident
73      integer, intent(out) :: status
74  
75 <    type (lj_atype), pointer :: this_lj_atype
104 <    type (lj_atype), pointer :: lj_atype_ptr
105 <
106 <    type (lj_atype), allocatable, dimension(:,:), pointer :: thisMix
107 <    type (lj_atype), allocatable, dimension(:,:), pointer :: oldMix
75 >    type (lj_atype), pointer :: newLJ_atype
76      integer :: alloc_error
77      integer :: atype_counter = 0
78      integer :: alloc_size
79 <
79 >    integer :: err_stat
80      status = 0
81  
82  
83  
84   ! allocate a new atype    
85 <    allocate(this_lj_atype,stat=alloc_error)
85 >    allocate(newLJ_atype,stat=alloc_error)
86      if (alloc_error /= 0 ) then
87         status = -1
88         return
89      end if
90  
91   ! assign our new lj_atype information
92 <    this_lj_atype%mass       = mass
93 <    this_lj_atype%epslon     = epslon
94 <    this_lj_atype%sigma      = sigma
95 <    this_lj_atype%sigma2     = sigma * sigma
96 <    this_lj_atype%sigma6     = this_lj_atype%sigma2 * this_lj_atype%sigma2 &
97 <         * this_lj_atype%sigma2
92 >    newLJ_atype%mass        = mass
93 >    newLJ_atype%epsilon     = epsilon
94 >    newLJ_atype%sigma       = sigma
95 >    newLJ_atype%sigma2      = sigma * sigma
96 >    newLJ_atype%sigma6      = newLJ_atype%sigma2 * newLJ_atype%sigma2 &
97 >         * newLJ_atype%sigma2
98   ! assume that this atype will be successfully added
99 <    this_lj_atype%atype_ident = ident
100 <    this_lj_atype%number = n_lj_atypes + 1
99 >    newLJ_atype%atype_ident = ident
100 >    newLJ_atype%atype_number = n_lj_atypes + 1
101  
102 <
103 < ! First time through allocate a array of size ljMixed_blocksize
104 <    if(.not. associated(ljMixed)) then
105 <       allocate(thisMix(ljMixed_blocksize,ljMixed_blocksize))
138 <       if (alloc_error /= 0 ) then
139 <          status = -1
140 <          return
141 <       end if
142 <       ljMixed => thisMix
143 < ! If we have outgrown ljMixed_blocksize, allocate a new matrix twice the size and
144 < ! point ljMix at the new matrix.
145 <    else if( (n_lj_atypes + 1) > size(ljMixed)) then
146 <       alloc_size = 2*size(ljMix)
147 <       allocate(thisMix(alloc_size,alloc_size))
148 <       if (alloc_error /= 0 ) then
149 <          status = -1
150 <          return
151 <       end if
152 < ! point oldMix at old ljMixed array
153 <       oldMix => ljMixed
154 < ! Copy oldMix into new Mixed array      
155 <       thisMix = oldMix
156 < ! Point ljMixed at new array
157 <       ljMixed => thisMix
158 < ! Free old array so we don't have a memory leak
159 <       deallocate(oldMix)
102 >    call add_atype(newLJ_atype,ljListHead,ljListTail,err_stat)
103 >    if (err_stat /= 0 ) then
104 >       status = -1
105 >       return
106      endif
107  
162
163
164
165
166 ! Find bottom of atype master list
167 ! if lj_atype_list is null then we are at the top of the list.
168    if (.not. associated(lj_atype_list)) then
169       lj_atype_ptr => this_lj_atype
170       atype_counter = 1
171
172    else ! we need to find the bottom of the list to insert new atype
173       lj_atype_ptr => lj_atype_list%next
174       atype_counter = 1
175       find_end: do
176          if (.not. associated(lj_atype_ptr%next)) then
177             exit find_end
178          end if
179 ! Set up mixing for new atype and current atype in list
180       ljMix(this_lj_atype%atype_number,lj_atype_ptr%atype_number)%sigma  =  &
181            calcLJMix("sigma",this_lj_atype%sigma, &
182            lj_atype_prt%sigma)
183
184       ljMix(this_lj_atype%atype_number,lj_atype_ptr%atype_number)%sigma2  = &
185            ljMix(this_lj_atype%atype_number,lj_atype_ptr%atype_number)%sigma &
186            * ljMix(this_lj_atype%atype_number,lj_atype_ptr%atype_number)%sigma
187
188       ljMix(this_lj_atype%atype_number,lj_atype_ptr%atype_number)%sigma6 = &
189            ljMix(this_lj_atype%atype_number,lj_atype_ptr%atype_number)%sigma2 &
190            * ljMix(this_lj_atype%atype_number,lj_atype_ptr%atype_number)%sigma2 &
191            * ljMix(this_lj_atype%atype_number,lj_atype_ptr%atype_number)%sigma2
192
193       ljMix(this_lj_atype%atype_number,lj_atype_ptr%atype_number)%epslon = &
194            calcLJMix("epslon",this_lj_atype%epslon, &
195            lj_atype_prt%epslon)
196
197 ! Advance to next pointer
198       lj_atype_ptr => lj_atype_ptr%next
199       atype_counter = atype_counter + 1
200          
201       end do find_end
202    end if
203
204
205
206    
207 ! Insert new atype at end of list
208    lj_atype_ptr => this_lj_atype
209 ! Increment number of atypes
210
108      n_lj_atypes = n_lj_atypes + 1
109  
213 ! Set up self mixing
110  
215    ljMix(n_lj_atypes,n_lj_atypes)%sigma  = this_lj_atype%sigma
216
217    ljMix(n_lj_atypes,n_lj_atypes)%sigma2  = ljMix(n_lj_atypes,n_lj_atypes)%sigma &
218            * ljMix(n_lj_atypes,n_lj_atypes)%sigma
219
220    ljMix(n_lj_atypes,n_lj_atypes)%sigma6 = ljMix(n_lj_atypes,n_lj_atypes)%sigma2 &
221            * ljMix(n_lj_atypes,n_lj_atypes)%sigma2 &
222            * ljMix(n_lj_atypes,n_lj_atypes)%sigma2
223
224    ljMix(n_lj_atypes,n_lj_atypes)%epslon = this_lj_atype%epslon
225
226
111    end subroutine new_lj_atype
112  
113  
# Line 236 | Line 120 | contains
120   !!  Result status, success = 0, error = -1
121      integer, intent(out) :: Status
122  
123 +    integer :: alloc_stat
124 +
125      integer :: thisStat
126 +    integer :: i
127   #ifdef IS_MPI
128      integer, allocatable, dimension(:) :: identRow
129      integer, allocatable, dimension(:) :: identCol
130      integer :: nrow
131      integer :: ncol
245    integer :: alloc_stat
132   #endif
133      status = 0
248
134   !! if were're not in MPI, we just update ljatypePtrList
135   #ifndef IS_MPI
136 <    call new_ljatypePtrList(nComponents,ident,identPtrList,thisStat)
136 >    call create_IdentPtrlst(ident,ljListHead,identPtrList,thisStat)
137      if ( thisStat /= 0 ) then
138         status = -1
139         return
140      endif
141 +
142   !! Allocate pointer lists
143      allocate(point(nComponents),stat=alloc_stat)
144      if (alloc_stat /=0) then
# Line 292 | Line 178 | contains
178      call gather(ident,identCol,plan_col)
179  
180   !! Create row and col pointer lists
181 <    call new_ljatypePtrList(nrow,identRow,identPtrListRow,thisStat)
181 >    call create_IdentPtrlst(identRow,ljListTail,identPtrListRow,thisStat)
182      if (thisStat /= 0 ) then
183         status = -1
184         return
185      endif
186  
187 <    call new_ljatypePtrList(ncol,identCol,identPtrListCol,thisStat)
187 >    call create_IdentPtrlst(identCol,ljListTail,identPtrListColumn,thisStat)
188      if (thisStat /= 0 ) then
189         status = -1
190         return
# Line 308 | Line 194 | contains
194      deallocate(identCol)
195      deallocate(identRow)
196  
311 !! Allocate Simulation arrays
312 !! NOTE: This bit of code should be fixed, it can cause large
313 !! memory fragmentation if call repeatedly
197  
315    if (.not.allocated(qRow)) then
316       allocate(qRow(3,nrow),stat=alloc_stat)
317       if (alloc_stat /= 0 ) then
318          status = -1
319          return
320       endif
321    else
322       deallocate(qrow)
323       allocate(qRow(3,nrow),stat=alloc_stat)
324       if (alloc_stat /= 0 ) then
325          status = -1
326          return
327       endif
328    endif
329
330    if (.not.allocated(3,qCol)) then
331       allocate(qCol(ncol),stat=alloc_stat)
332       if (alloc_stat /= 0 ) then
333          status = -1
334          return
335       endif
336    else
337       deallocate(qCol)
338       allocate(qCol(3,ncol),stat=alloc_stat)
339       if (alloc_stat /= 0 ) then
340          status = -1
341          return
342       endif
343    endif
344
345    if (.not.allocated(fRow)) then
346       allocate(fRow(3,nrow),stat=alloc_stat)
347       if (alloc_stat /= 0 ) then
348          status = -1
349          return
350       endif
351    else
352       deallocate(fRow)
353       allocate(fRow(3,nrow),stat=alloc_stat)
354       if (alloc_stat /= 0 ) then
355          status = -1
356          return
357       endif
358    endif
359
360    if (.not.allocated(fCol)) then
361       allocate(fCol(3,ncol),stat=alloc_stat)
362       if (alloc_stat /= 0 ) then
363          status = -1
364          return
365       endif
366    else
367       deallocate(fCol)
368       allocate(fCol(3,ncol),stat=alloc_stat)
369       if (alloc_stat /= 0 ) then
370          status = -1
371          return
372       endif
373    endif
198   !! Allocate neighbor lists for mpi simulations.
199      if (.not. allocated(point)) then
200         allocate(point(nrow),stat=alloc_stat)
# Line 402 | Line 226 | contains
226  
227   #endif
228      
229 <
229 >    call createMixingList(thisStat)
230 >    if (thisStat /= 0) then
231 >       status = -1
232 >       return
233 >    endif
234      isljFFinit = .true.
235  
408
236    end subroutine init_ljFF
237  
238  
239  
240  
241  
415 !! Takes an ident array and creates an atype pointer list
416 !! based on those identities
417  subroutine new_ljatypePtrList(mysize,ident,PtrList,status)
418    integer, intent(in) :: mysize
419    integer, intent(in) :: ident
420    integer, optional :: status
421    type(lj_atypePtr), dimension(:) :: PtrList
242  
243 <    integer :: thisIdent
243 >  subroutine createMixingList(status)
244 >    integer :: listSize
245 >    integer :: status
246      integer :: i
247 <    integer :: alloc_error
426 <    type (lj_atype), pointer :: tmpPtr
247 >    integer :: j
248  
249 <    if (present(status)) status = 0
249 >    integer :: outerCounter = 0
250 >    integer :: innerCounter = 0
251 >    type (lj_atype), pointer :: tmpPtrOuter => null()
252 >    type (lj_atype), pointer :: tmpPtrInner => null()
253 >    status = 0
254  
255 < ! First time through, allocate list
256 <    if (.not.(allocated)) then
257 <       allocate(PtrList(mysize))
258 <    else
259 < ! We want to creat a new ident list so free old list
260 <       deallocate(PrtList)
436 <       allocate(PtrList(mysize))
437 <    endif
255 >    listSize = getListLen(ljListHead)
256 >    if (listSize == 0) then
257 >       status = -1
258 >       return
259 >    end if
260 >  
261  
262 < ! Match pointer list
263 <    do i = 1, mysize
264 <       thisIdent = ident(i)
265 <       call getLJatype(thisIdent,tmpPtr)
266 <
267 <      if (.not. associated(tmpPtr)) then
268 <          status = -1
269 <          return
262 >    if (.not. associated(ljMixed)) then
263 >       allocate(ljMixed(listSize,listSize))
264 >    else
265 >       status = -1
266 >       return
267 >    end if
268 >
269 >    
270 >
271 >    tmpPtrOuter => ljListHead
272 >    tmpPtrInner => tmpPtrOuter%next
273 >    do while (associated(tmpPtrOuter))
274 >       outerCounter = outerCounter + 1
275 > ! do self mixing rule
276 >       ljMixed(outerCounter,outerCounter)%sigma  = tmpPtrOuter%sigma
277 >                                                                                                  
278 >       ljMixed(outerCounter,outerCounter)%sigma2  = ljMixed(outerCounter,outerCounter)%sigma &
279 >            * ljMixed(outerCounter,outerCounter)%sigma
280 >                                                                                                  
281 >       ljMixed(outerCounter,outerCounter)%sigma6 = ljMixed(outerCounter,outerCounter)%sigma2 &
282 >            * ljMixed(outerCounter,outerCounter)%sigma2 &
283 >            * ljMixed(outerCounter,outerCounter)%sigma2
284 >                                                                                                  
285 >       ljMixed(outerCounter,outerCounter)%epsilon = tmpPtrOuter%epsilon
286 >
287 >       innerCounter = outerCounter + 1
288 >       do while (associated(tmpPtrInner))
289 >          
290 >          ljMixed(outerCounter,innerCounter)%sigma  =  &
291 >               calcLJMix("sigma",tmpPtrOuter%sigma, &
292 >               tmpPtrInner%sigma)
293 >          
294 >          ljMixed(outerCounter,innerCounter)%sigma2  = &
295 >               ljMixed(outerCounter,innerCounter)%sigma &
296 >               * ljMixed(outerCounter,innerCounter)%sigma
297 >          
298 >          ljMixed(outerCounter,innerCounter)%sigma6 = &
299 >               ljMixed(outerCounter,innerCounter)%sigma2 &
300 >               * ljMixed(outerCounter,innerCounter)%sigma2 &
301 >               * ljMixed(outerCounter,innerCounter)%sigma2
302 >          
303 >          ljMixed(outerCounter,innerCounter)%epsilon = &
304 >               calcLJMix("epsilon",tmpPtrOuter%epsilon, &
305 >               tmpPtrInner%epsilon)
306 >          ljMixed(innerCounter,outerCounter)%sigma = ljMixed(outerCounter,innerCounter)%sigma
307 >          ljMixed(innerCounter,outerCounter)%sigma2 = ljMixed(outerCounter,innerCounter)%sigma2
308 >          ljMixed(innerCounter,outerCounter)%sigma6 = ljMixed(outerCounter,innerCounter)%sigma6
309 >          ljMixed(innerCounter,outerCounter)%epsilon = ljMixed(outerCounter,innerCounter)%epsilon
310 >
311 >
312 >          tmpPtrInner => tmpPtrInner%next
313 >          innerCounter = innerCounter + 1
314 >       end do
315 > ! advance pointers
316 >       tmpPtrOuter => tmpPtrOuter%next
317 >       if (associated(tmpPtrOuter)) then
318 >          tmpPtrInner => tmpPtrOuter%next
319         endif
320        
449       PtrList(i)%this => tmpPtr
321      end do
322  
323 <  end subroutine new_ljatypePtrList
323 >  end subroutine createMixingList
324  
454 !! Finds a lj_atype based upon numerical ident
455 !! returns a null pointer if error
456  subroutine getLJatype(ident,ljAtypePtr)
457    integer, intent(in) :: ident
458    type (lj_atype), intent(out),pointer :: ljAtypePtr => null()
459    
460    type (lj_atype), pointer :: tmplj_atype_ptr => null()
325  
462    if(.not. associated(lj_atype_list)) return
326  
464 ! Point at head of list.
465    tmplj_atype_ptr => lj_atype_list
466    find_ident: do
467       if (.not.associated(tmplj_atype_ptr)) then
468          exit find_ident
469       else if( lj_atype_ptr%atype_ident == ident)
470          ljAtypePtr => tmplj_atype_ptr
471          exit find_ident
472       endif
473       tmplj_atype_ptr => tmplj_atype_ptr%next
474    end do find_ident
327  
476  end subroutine getLJatype
328  
329  
330 +
331 +
332   !! FORCE routine Calculates Lennard Jones forces.
333   !------------------------------------------------------------->
334    subroutine do_lj_ff(q,f,potE,do_pot)
335 <    real ( kind = dp ), dimension(ndim,) :: q
336 <    real ( kind = dp ), dimension(ndim,nLRparticles) :: f
335 > !! Position array provided by C, dimensioned by getNlocal
336 >    real ( kind = dp ), dimension(3,getNlocal()) :: q
337 > !! Force array provided by C, dimensioned by getNlocal
338 >    real ( kind = dp ), dimension(3,getNlocal()) :: f
339      real ( kind = dp ) :: potE
340      logical ( kind = 2) :: do_pot
341      
342      type(lj_atype), pointer :: ljAtype_i
343      type(lj_atype), pointer :: ljAtype_j
344  
345 < #ifdef MPI
346 <  real( kind = DP ), dimension(3,ncol) :: efr
345 > #ifdef IS_MPI
346 >  real( kind = DP ), dimension(3,getNcol()) :: efr
347    real( kind = DP ) :: pot_local
348   #else
349 < !  real( kind = DP ), dimension(3,natoms) :: efr
349 >  real( kind = DP ), dimension(3,getNlocal()) :: efr
350   #endif
351    
352 + !! Local arrays needed for MPI
353 + #ifdef IS_MPI
354 +  real(kind = dp), dimension(3:getNrow()) :: qRow
355 +  real(kind = dp), dimension(3:getNcol()) :: qCol
356 +
357 +  real(kind = dp), dimension(3:getNrow()) :: fRow
358 +  real(kind = dp), dimension(3:getNcol()) :: fCol
359 +  real(kind = dp), dimension(3:getNlocal()) :: fMPITemp
360 +
361 +  real(kind = dp), dimension(getNrow()) :: eRow
362 +  real(kind = dp), dimension(getNcol()) :: eCol
363 +
364 +  real(kind = dp), dimension(getNlocal()) :: eTemp
365 + #endif
366 +
367 +
368 +
369    real( kind = DP )   :: pe
370 <  logical,            :: update_nlist
370 >  logical             :: update_nlist
371  
372  
373    integer ::  i, j, jbeg, jend, jnab, idim, jdim, idim2, jdim2, dim, dim2
# Line 504 | Line 376 | contains
376    integer :: tag_i,tag_j
377    real( kind = DP ) ::  r, pot, ftmp, dudr, d2, drdx1, kt1, kt2, kt3, ktmp
378    real( kind = DP ) ::  rxi, ryi, rzi, rxij, ryij, rzij, rijsq
379 +  real( kind = DP ) ::  rlistsq, rcutsq,rlist,rcut
380  
381 + ! a rig that need to be fixed.
382 + #ifdef IS_MPI
383 +  logical :: newtons_thrd = .true.
384 +  real( kind = dp ) :: pe_local
385 +  integer :: nlocal
386 + #endif
387    integer :: nrow
388    integer :: ncol
389 +  integer :: natoms
390  
391 +
392 +
393 +
394 + ! Make sure we are properly initialized.
395    if (.not. isljFFInit) then
396       write(default_error,*) "ERROR: lj_FF has not been properly initialized"
397       return
398    endif
399 + #ifdef IS_MPI
400 +    if (.not. isMPISimSet()) then
401 +     write(default_error,*) "ERROR: mpiSimulation has not been properly initialized"
402 +     return
403 +  endif
404 + #endif
405  
406 + !! initialize local variables  
407 +  natoms = getNlocal()
408 +  call getRcut(rcut,rcut2=rcutsq)
409 +  call getRlist(rlist,rlistsq)
410 +
411   #ifndef IS_MPI
412    nrow = natoms - 1
413    ncol = natoms
414   #else
415    nrow = getNrow(plan_row)
416    ncol = getNcol(plan_col)
417 +  nlocal = natoms
418    j_start = 1
419   #endif
420  
421    
422 + !! See if we need to update neighbor lists
423 +  call check(q,update_nlist)
424 +  if (firstTime) then
425 +     update_nlist = .true.
426 +     firstTime = .false.
427 +  endif
428  
527  call check(update_nlist)
528
429   !--------------WARNING...........................
430   ! Zero variables, NOTE:::: Forces are zeroed in C
431   ! Zeroing them here could delete previously computed
432   ! Forces.
433   !------------------------------------------------
434   #ifndef IS_MPI
435 <  nloops = nloops + 1
436 <  pot = 0.0E0_DP
437 <  e = 0.0E0_DP
435 > !  nloops = nloops + 1
436 >  pe = 0.0E0_DP
437 >
438   #else
439 <    f_row = 0.0E0_DP
440 <    f_col = 0.0E0_DP
439 >    fRow = 0.0E0_DP
440 >    fCol = 0.0E0_DP
441  
442 <    pot_local = 0.0E0_DP
442 >    pe_local = 0.0E0_DP
443  
444 <    e_row = 0.0E0_DP
445 <    e_col = 0.0E0_DP
446 <    e_tmp = 0.0E0_DP
444 >    eRow = 0.0E0_DP
445 >    eCol = 0.0E0_DP
446 >    eTemp = 0.0E0_DP
447   #endif
448      efr = 0.0E0_DP
449  
450   ! communicate MPI positions
451 < #ifdef MPI    
452 <    call gather(q,qRow,plan_row3)
453 <    call gather(q,qCol,plan_col3)
451 > #ifdef IS_MPI    
452 >    call gather(q,qRow,plan_row3d)
453 >    call gather(q,qCol,plan_col3d)
454   #endif
455  
556 #ifndef MPI
456  
558 #endif
559
457    if (update_nlist) then
458  
459       ! save current configuration, contruct neighbor list,
460       ! and calculate forces
461 <     call save_nlist()
461 >     call save_nlist(q)
462      
463       nlist = 0
464      
465 <    
465 >    
466  
467       do i = 1, nrow
468          point(i) = nlist + 1
469 < #ifdef MPI
469 > #ifdef IS_MPI
470          ljAtype_i => identPtrListRow(i)%this
471          tag_i = tagRow(i)
472          rxi = qRow(1,i)
# Line 584 | Line 481 | contains
481   #endif
482  
483          inner: do j = j_start, ncol
484 < #ifdef MPI
484 > #ifdef IS_MPI
485   ! Assign identity pointers and tags
486             ljAtype_j => identPtrListColumn(j)%this
487             tag_j = tagCol(j)
# Line 608 | Line 505 | contains
505   #endif          
506             rijsq = rxij*rxij + ryij*ryij + rzij*rzij
507  
508 < #ifdef MPI
509 <             if (rijsq <=  rlstsq .AND. &
508 > #ifdef IS_MPI
509 >             if (rijsq <=  rlistsq .AND. &
510                    tag_j /= tag_i) then
511   #else
512 <             if (rijsq <  rlstsq) then
512 >          
513 >             if (rijsq <  rlistsq) then
514   #endif
515              
516                nlist = nlist + 1
517                if (nlist > size(list)) then
518 < #warning "Change how nlist size is done"
518 > !!  "Change how nlist size is done"
519                   write(DEFAULT_ERROR,*) "ERROR: nlist > list size"
520                endif
521                list(nlist) = j
522  
523 <              
523 >    
524                if (rijsq <  rcutsq) then
525                  
526                   r = dsqrt(rijsq)
527        
528                   call getLJPot(r,pot,dudr,ljAtype_i,ljAtype_j)
529        
530 < #ifdef MPI
531 <                e_row(i) = e_row(i) + pot*0.5
532 <                e_col(i) = e_col(i) + pot*0.5
530 > #ifdef IS_MPI
531 >                eRow(i) = eRow(i) + pot*0.5
532 >                eCol(i) = eCol(i) + pot*0.5
533   #else
534 <                pe = pe + pot
534 >                    pe = pe + pot
535   #endif                
536              
537                   efr(1,j) = -rxij
# Line 647 | Line 545 | contains
545                      ftmp = dudr * drdx1
546  
547  
548 < #ifdef MPI
548 > #ifdef IS_MPI
549                      fCol(dim,j) = fCol(dim,j) - ftmp
550                      fRow(dim,i) = fRow(dim,i) + ftmp
551   #else                    
# Line 662 | Line 560 | contains
560          enddo inner
561       enddo
562  
563 < #ifdef MPI
563 > #ifdef IS_MPI
564       point(nrow + 1) = nlist + 1
565   #else
566       point(natoms) = nlist + 1
# Line 676 | Line 574 | contains
574          JEND = POINT(i+1) - 1
575          ! check thiat molecule i has neighbors
576          if (jbeg .le. jend) then
577 < #ifdef MPI
577 > #ifdef IS_MPI
578             ljAtype_i => identPtrListRow(i)%this
579             rxi = qRow(1,i)
580             ryi = qRow(2,i)
# Line 689 | Line 587 | contains
587   #endif
588             do jnab = jbeg, jend
589                j = list(jnab)
590 < #ifdef MPI
590 > #ifdef IS_MPI
591                ljAtype_j = identPtrListColumn(j)%this
592                rxij = wrap(rxi - q_col(1,j), 1)
593                ryij = wrap(ryi - q_col(2,j), 2)
# Line 707 | Line 605 | contains
605                   r = dsqrt(rijsq)
606                  
607                   call getLJPot(r,pot,dudr,ljAtype_i,ljAtype_j)
608 < #ifdef MPI
609 <                e_row(i) = e_row(i) + pot*0.5
610 <                e_col(i) = e_col(i) + pot*0.5
608 > #ifdef IS_MPI
609 >                eRow(i) = eRow(i) + pot*0.5
610 >                eCol(i) = eCol(i) + pot*0.5
611   #else
612 <               if (do_pot)  pe = pe + pot
612 >                pe = pe + pot
613   #endif                
614  
615                  
# Line 723 | Line 621 | contains
621                      
622                      drdx1 = efr(dim,j) / r
623                      ftmp = dudr * drdx1
624 < #ifdef MPI
624 > #ifdef IS_MPI
625                      fCol(dim,j) = fCol(dim,j) - ftmp
626                      fRow(dim,i) = fRow(dim,i) + ftmp
627   #else                    
# Line 739 | Line 637 | contains
637  
638  
639  
640 < #ifdef MPI
640 > #ifdef IS_MPI
641      !!distribute forces
642 <    call scatter(fRow,f,plan_row3)
642 >    call scatter(fRow,f,plan_row3d)
643  
644 <    call scatter(fCol,f_tmp,plan_col3)
644 >    call scatter(fCol,fMPITemp,plan_col3d)
645 >
646      do i = 1,nlocal
647 <       do dim = 1,3
749 <          f(dim,i) = f(dim,i) + f_tmp(dim,i)
750 <       end do
647 >       f(1:3,i) = f(1:3,i) + fMPITemp(1:3,i)
648      end do
649  
650  
651      
652      if (do_pot) then
653   ! scatter/gather pot_row into the members of my column
654 <       call scatter(e_row,e_tmp,plan_row)
654 >       call scatter(eRow,eTemp,plan_row)
655        
656         ! scatter/gather pot_local into all other procs
657         ! add resultant to get total pot
658         do i = 1, nlocal
659 <          pot_local = pot_local + e_tmp(i)
659 >          pe_local = pe_local + eTemp(i)
660         enddo
661         if (newtons_thrd) then
662 <          e_tmp = 0.0E0_DP
663 <          call scatter(e_col,e_tmp,plan_col)
662 >          eTemp = 0.0E0_DP
663 >          call scatter(eCol,eTemp,plan_col)
664            do i = 1, nlocal
665 <             pot_local = pot_local + e_tmp(i)
665 >             pe_local = pe_local + eTemp(i)
666            enddo
667         endif
668      endif
669 +    potE = pe_local
670   #endif
671  
672 +    potE = pe
673  
674 +  
675  
676  
677    end subroutine do_lj_ff
# Line 789 | Line 689 | contains
689   !! Second Derivative, optional, used mainly for normal mode calculations.
690      real( kind = dp ), intent(out), optional :: d2
691      
692 <    type (lj_atype), intent(in), pointer :: atype1
693 <    type (lj_atype), intent(in), pointer :: atype2
692 >    type (lj_atype), pointer :: atype1
693 >    type (lj_atype), pointer :: atype2
694  
695      integer, intent(out), optional :: status
696  
# Line 798 | Line 698 | contains
698      real( kind = dp ) :: sigma
699      real( kind = dp ) :: sigma2
700      real( kind = dp ) :: sigma6
701 <    real( kind = dp ) :: epslon
701 >    real( kind = dp ) :: epsilon
702  
703      real( kind = dp ) :: rcut
704      real( kind = dp ) :: rcut2
# Line 823 | Line 723 | contains
723      if (present(status)) status = 0
724  
725   ! Look up the correct parameters in the mixing matrix
726 <    sigma   = ljMixed(atype1%atype_ident,atype2_atype_ident)%sigma
727 <    sigma2  = ljMixed(atype1%atype_ident,atype2_atype_ident)%sigma2
728 <    sigma6  = ljMixed(atype1%atype_ident,atype2_atype_ident)%sigma6
729 <    epslon  = ljMixed(atype1%atype_ident,atype2_atype_ident)%epslon
726 >    sigma    = ljMixed(atype1%atype_ident,atype2%atype_ident)%sigma
727 >    sigma2   = ljMixed(atype1%atype_ident,atype2%atype_ident)%sigma2
728 >    sigma6   = ljMixed(atype1%atype_ident,atype2%atype_ident)%sigma6
729 >    epsilon  = ljMixed(atype1%atype_ident,atype2%atype_ident)%epsilon
730  
731  
732 <
732 >    
733 >
734      call getRcut(rcut,rcut2=rcut2,rcut6=rcut6,status=errorStat)
735      
736      r2 = r * r
# Line 846 | Line 747 | contains
747      delta = -4.0E0_DP*epsilon * (tp12 - tp6)
748                                                                                
749      if (r.le.rcut) then
750 <       u = 4.0E0_DP * epsilon * (t12 - t6) + delta
750 >       pot = 4.0E0_DP * epsilon * (t12 - t6) + delta
751         dudr = 24.0E0_DP * epsilon * (t6 - 2.0E0_DP*t12) / r
752         if(doSec)  d2 = 24.0E0_DP * epsilon * (26.0E0_DP*t12 - 7.0E0_DP*t6)/r/r
753      else
754 <       u = 0.0E0_DP
754 >       pot = 0.0E0_DP
755         dudr = 0.0E0_DP
756         if(doSec) d2 = 0.0E0_DP
757      endif
# Line 879 | Line 780 | contains
780  
781      case ("sigma")
782         myMixParam = 0.5_dp * (param1 + param2)
783 <    case ("epslon")
783 >    case ("epsilon")
784         myMixParam = sqrt(param1 * param2)
785      case default
786         status = -1

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines