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 254 by chuckv, Thu Jan 30 20:03:37 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.14 2003-01-30 20:03:36 chuckv Exp $, $Date: 2003-01-30 20:03:36 $, $Name: not supported by cvs2svn $, $Revision: 1.14 $
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
161
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
107  
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
134 +  
135  
136 +
137 +
138   !! if were're not in MPI, we just update ljatypePtrList
139   #ifndef IS_MPI
140 <    call new_ljatypePtrList(nComponents,ident,identPtrList,thisStat)
140 >    call create_IdentPtrlst(ident,ljListHead,identPtrList,thisStat)
141      if ( thisStat /= 0 ) then
142         status = -1
143         return
144      endif
145 +
146   !! Allocate pointer lists
147      allocate(point(nComponents),stat=alloc_stat)
148      if (alloc_stat /=0) then
# Line 268 | Line 158 | contains
158      
159   ! if were're in MPI, we also have to worry about row and col lists    
160   #else
161 +  
162   ! We can only set up forces if mpiSimulation has been setup.
163      if (.not. isMPISimSet()) then
164 +       write(default_error,*) "MPI is not set"
165         status = -1
166         return
167      endif
168 <    nrow = getNrow()
169 <    ncol = getNcol()
168 >    nrow = getNrow(plan_row)
169 >    ncol = getNcol(plan_col)
170   !! Allocate temperary arrays to hold gather information
171      allocate(identRow(nrow),stat=alloc_stat)
172      if (alloc_stat /= 0 ) then
# Line 287 | Line 179 | contains
179         status = -1
180         return
181      endif
182 +
183   !! Gather idents into row and column idents
184 +
185      call gather(ident,identRow,plan_row)
186      call gather(ident,identCol,plan_col)
187 +
188  
189   !! Create row and col pointer lists
190 <    call new_ljatypePtrList(nrow,identRow,identPtrListRow,thisStat)
190 >
191 >    call create_IdentPtrlst(identRow,ljListHead,identPtrListRow,thisStat)
192      if (thisStat /= 0 ) then
193         status = -1
194         return
195      endif
196  
197 <    call new_ljatypePtrList(ncol,identCol,identPtrListCol,thisStat)
197 >    call create_IdentPtrlst(identCol,ljListHead,identPtrListColumn,thisStat)
198      if (thisStat /= 0 ) then
199         status = -1
200         return
# Line 308 | Line 204 | contains
204      deallocate(identCol)
205      deallocate(identRow)
206  
311 !! Allocate Simulation arrays
312 !! NOTE: This bit of code should be fixed, it can cause large
313 !! memory fragmentation if call repeatedly
207  
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
208   !! Allocate neighbor lists for mpi simulations.
209      if (.not. allocated(point)) then
210         allocate(point(nrow),stat=alloc_stat)
# Line 402 | Line 236 | contains
236  
237   #endif
238      
239 <
239 >    call createMixingList(thisStat)
240 >    if (thisStat /= 0) then
241 >       status = -1
242 >       return
243 >    endif
244      isljFFinit = .true.
245  
408
246    end subroutine init_ljFF
247  
248  
249  
250  
251  
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
252  
253 <    integer :: thisIdent
253 >  subroutine createMixingList(status)
254 >    integer :: listSize
255 >    integer :: status
256      integer :: i
257 <    integer :: alloc_error
426 <    type (lj_atype), pointer :: tmpPtr
257 >    integer :: j
258  
259 <    if (present(status)) status = 0
259 >    integer :: outerCounter = 0
260 >    integer :: innerCounter = 0
261 >    type (lj_atype), pointer :: tmpPtrOuter => null()
262 >    type (lj_atype), pointer :: tmpPtrInner => null()
263 >    status = 0
264  
265 < ! First time through, allocate list
266 <    if (.not.(allocated)) then
267 <       allocate(PtrList(mysize))
268 <    else
269 < ! We want to creat a new ident list so free old list
270 <       deallocate(PrtList)
436 <       allocate(PtrList(mysize))
437 <    endif
265 >    listSize = getListLen(ljListHead)
266 >    if (listSize == 0) then
267 >       status = -1
268 >       return
269 >    end if
270 >  
271  
272 < ! Match pointer list
273 <    do i = 1, mysize
274 <       thisIdent = ident(i)
275 <       call getLJatype(thisIdent,tmpPtr)
276 <
277 <      if (.not. associated(tmpPtr)) then
278 <          status = -1
279 <          return
272 >    if (.not. associated(ljMixed)) then
273 >       allocate(ljMixed(listSize,listSize))
274 >    else
275 >       status = -1
276 >       return
277 >    end if
278 >
279 >    
280 >
281 >    tmpPtrOuter => ljListHead
282 >    tmpPtrInner => tmpPtrOuter%next
283 >    do while (associated(tmpPtrOuter))
284 >       outerCounter = outerCounter + 1
285 > ! do self mixing rule
286 >       ljMixed(outerCounter,outerCounter)%sigma  = tmpPtrOuter%sigma
287 >                                                                                                  
288 >       ljMixed(outerCounter,outerCounter)%sigma2  = ljMixed(outerCounter,outerCounter)%sigma &
289 >            * ljMixed(outerCounter,outerCounter)%sigma
290 >                                                                                                  
291 >       ljMixed(outerCounter,outerCounter)%sigma6 = ljMixed(outerCounter,outerCounter)%sigma2 &
292 >            * ljMixed(outerCounter,outerCounter)%sigma2 &
293 >            * ljMixed(outerCounter,outerCounter)%sigma2
294 >                                                                                                  
295 >       ljMixed(outerCounter,outerCounter)%epsilon = tmpPtrOuter%epsilon
296 >
297 >       innerCounter = outerCounter + 1
298 >       do while (associated(tmpPtrInner))
299 >          
300 >          ljMixed(outerCounter,innerCounter)%sigma  =  &
301 >               calcLJMix("sigma",tmpPtrOuter%sigma, &
302 >               tmpPtrInner%sigma)
303 >          
304 >          ljMixed(outerCounter,innerCounter)%sigma2  = &
305 >               ljMixed(outerCounter,innerCounter)%sigma &
306 >               * ljMixed(outerCounter,innerCounter)%sigma
307 >          
308 >          ljMixed(outerCounter,innerCounter)%sigma6 = &
309 >               ljMixed(outerCounter,innerCounter)%sigma2 &
310 >               * ljMixed(outerCounter,innerCounter)%sigma2 &
311 >               * ljMixed(outerCounter,innerCounter)%sigma2
312 >          
313 >          ljMixed(outerCounter,innerCounter)%epsilon = &
314 >               calcLJMix("epsilon",tmpPtrOuter%epsilon, &
315 >               tmpPtrInner%epsilon)
316 >          ljMixed(innerCounter,outerCounter)%sigma = ljMixed(outerCounter,innerCounter)%sigma
317 >          ljMixed(innerCounter,outerCounter)%sigma2 = ljMixed(outerCounter,innerCounter)%sigma2
318 >          ljMixed(innerCounter,outerCounter)%sigma6 = ljMixed(outerCounter,innerCounter)%sigma6
319 >          ljMixed(innerCounter,outerCounter)%epsilon = ljMixed(outerCounter,innerCounter)%epsilon
320 >
321 >
322 >          tmpPtrInner => tmpPtrInner%next
323 >          innerCounter = innerCounter + 1
324 >       end do
325 > ! advance pointers
326 >       tmpPtrOuter => tmpPtrOuter%next
327 >       if (associated(tmpPtrOuter)) then
328 >          tmpPtrInner => tmpPtrOuter%next
329         endif
330        
449       PtrList(i)%this => tmpPtr
331      end do
332  
333 <  end subroutine new_ljatypePtrList
333 >  end subroutine createMixingList
334  
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()
335  
462    if(.not. associated(lj_atype_list)) return
336  
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
337  
476  end subroutine getLJatype
338  
339  
340 +
341 +
342   !! FORCE routine Calculates Lennard Jones forces.
343   !------------------------------------------------------------->
344    subroutine do_lj_ff(q,f,potE,do_pot)
345 <    real ( kind = dp ), dimension(ndim,) :: q
346 <    real ( kind = dp ), dimension(ndim,nLRparticles) :: f
345 > !! Position array provided by C, dimensioned by getNlocal
346 >    real ( kind = dp ), dimension(3,getNlocal()) :: q
347 > !! Force array provided by C, dimensioned by getNlocal
348 >    real ( kind = dp ), dimension(3,getNlocal()) :: f
349      real ( kind = dp ) :: potE
350      logical ( kind = 2) :: do_pot
351      
352      type(lj_atype), pointer :: ljAtype_i
353      type(lj_atype), pointer :: ljAtype_j
354  
355 < #ifdef MPI
356 <  real( kind = DP ), dimension(3,ncol) :: efr
355 > #ifdef IS_MPI
356 >  real( kind = DP ), dimension(3,getNcol(plan_col)) :: efr
357    real( kind = DP ) :: pot_local
358   #else
359 < !  real( kind = DP ), dimension(3,natoms) :: efr
359 >  real( kind = DP ), dimension(3,getNlocal()) :: efr
360   #endif
361    
362 + !! Local arrays needed for MPI
363 + #ifdef IS_MPI
364 +  real(kind = dp), dimension(3,getNrow(plan_row)) :: qRow
365 +  real(kind = dp), dimension(3,getNcol(plan_col)) :: qCol
366 +
367 +  real(kind = dp), dimension(3,getNrow(plan_row)) :: fRow
368 +  real(kind = dp), dimension(3,getNcol(plan_col)) :: fCol
369 +  real(kind = dp), dimension(3,getNlocal()) :: fMPITemp
370 +
371 +  real(kind = dp), dimension(getNrow(plan_row)) :: eRow
372 +  real(kind = dp), dimension(getNcol(plan_col)) :: eCol
373 +
374 +  real(kind = dp), dimension(getNlocal()) :: eTemp
375 + #endif
376 +
377 +
378 +
379    real( kind = DP )   :: pe
380 <  logical,            :: update_nlist
380 >  logical             :: update_nlist
381  
382  
383    integer ::  i, j, jbeg, jend, jnab, idim, jdim, idim2, jdim2, dim, dim2
# Line 504 | Line 386 | contains
386    integer :: tag_i,tag_j
387    real( kind = DP ) ::  r, pot, ftmp, dudr, d2, drdx1, kt1, kt2, kt3, ktmp
388    real( kind = DP ) ::  rxi, ryi, rzi, rxij, ryij, rzij, rijsq
389 +  real( kind = DP ) ::  rlistsq, rcutsq,rlist,rcut
390  
391 + ! a rig that need to be fixed.
392 + #ifdef IS_MPI
393 +  logical :: newtons_thrd = .true.
394 +  real( kind = dp ) :: pe_local
395 +  integer :: nlocal
396 + #endif
397    integer :: nrow
398    integer :: ncol
399 +  integer :: natoms
400  
401 +
402 +
403 +
404 + ! Make sure we are properly initialized.
405    if (.not. isljFFInit) then
406       write(default_error,*) "ERROR: lj_FF has not been properly initialized"
407       return
408    endif
409 + #ifdef IS_MPI
410 +    if (.not. isMPISimSet()) then
411 +     write(default_error,*) "ERROR: mpiSimulation has not been properly initialized"
412 +     return
413 +  endif
414 + #endif
415  
416 + !! initialize local variables  
417 +  natoms = getNlocal()
418 +  call getRcut(rcut,rcut2=rcutsq)
419 +  call getRlist(rlist,rlistsq)
420 +
421   #ifndef IS_MPI
422    nrow = natoms - 1
423    ncol = natoms
424   #else
425    nrow = getNrow(plan_row)
426    ncol = getNcol(plan_col)
427 +  nlocal = natoms
428    j_start = 1
429   #endif
430  
431    
432 <
433 <  call check(update_nlist)
432 > !! See if we need to update neighbor lists
433 >  call check(q,update_nlist)
434 >  if (firstTime) then
435 >     update_nlist = .true.
436 >     firstTime = .false.
437 >  endif
438  
439   !--------------WARNING...........................
440   ! Zero variables, NOTE:::: Forces are zeroed in C
# Line 532 | Line 442 | contains
442   ! Forces.
443   !------------------------------------------------
444   #ifndef IS_MPI
445 <  nloops = nloops + 1
446 <  pot = 0.0E0_DP
447 <  e = 0.0E0_DP
445 > !  nloops = nloops + 1
446 >  pe = 0.0E0_DP
447 >
448   #else
449 <    f_row = 0.0E0_DP
450 <    f_col = 0.0E0_DP
449 >    fRow = 0.0E0_DP
450 >    fCol = 0.0E0_DP
451  
452 <    pot_local = 0.0E0_DP
452 >    pe_local = 0.0E0_DP
453  
454 <    e_row = 0.0E0_DP
455 <    e_col = 0.0E0_DP
456 <    e_tmp = 0.0E0_DP
454 >    eRow = 0.0E0_DP
455 >    eCol = 0.0E0_DP
456 >    eTemp = 0.0E0_DP
457   #endif
458      efr = 0.0E0_DP
459  
460   ! communicate MPI positions
461 < #ifdef MPI    
462 <    call gather(q,qRow,plan_row3)
463 <    call gather(q,qCol,plan_col3)
461 > #ifdef IS_MPI    
462 >    call gather(q,qRow,plan_row3d)
463 >    call gather(q,qCol,plan_col3d)
464   #endif
465  
556 #ifndef MPI
466  
558 #endif
559
467    if (update_nlist) then
468  
469       ! save current configuration, contruct neighbor list,
470       ! and calculate forces
471 <     call save_nlist()
471 >     call save_nlist(q)
472      
473       nlist = 0
474      
475 <    
475 >    
476  
477       do i = 1, nrow
478          point(i) = nlist + 1
479 < #ifdef MPI
479 > #ifdef IS_MPI
480          ljAtype_i => identPtrListRow(i)%this
481          tag_i = tagRow(i)
482          rxi = qRow(1,i)
# Line 584 | Line 491 | contains
491   #endif
492  
493          inner: do j = j_start, ncol
494 < #ifdef MPI
494 > #ifdef IS_MPI
495   ! Assign identity pointers and tags
496             ljAtype_j => identPtrListColumn(j)%this
497 <           tag_j = tagCol(j)
497 >           tag_j = tagColumn(j)
498             if (newtons_thrd) then
499                if (tag_i <= tag_j) then
500                   if (mod(tag_i + tag_j,2) == 0) cycle inner
# Line 608 | Line 515 | contains
515   #endif          
516             rijsq = rxij*rxij + ryij*ryij + rzij*rzij
517  
518 < #ifdef MPI
519 <             if (rijsq <=  rlstsq .AND. &
518 > #ifdef IS_MPI
519 >             if (rijsq <=  rlistsq .AND. &
520                    tag_j /= tag_i) then
521   #else
522 <             if (rijsq <  rlstsq) then
522 >          
523 >             if (rijsq <  rlistsq) then
524   #endif
525              
526                nlist = nlist + 1
527                if (nlist > size(list)) then
528 < #warning "Change how nlist size is done"
528 > !!  "Change how nlist size is done"
529                   write(DEFAULT_ERROR,*) "ERROR: nlist > list size"
530                endif
531                list(nlist) = j
532  
533 <              
533 >    
534                if (rijsq <  rcutsq) then
535                  
536                   r = dsqrt(rijsq)
537        
538                   call getLJPot(r,pot,dudr,ljAtype_i,ljAtype_j)
539        
540 < #ifdef MPI
541 <                e_row(i) = e_row(i) + pot*0.5
542 <                e_col(i) = e_col(i) + pot*0.5
540 > #ifdef IS_MPI
541 >                eRow(i) = eRow(i) + pot*0.5
542 >                eCol(i) = eCol(i) + pot*0.5
543   #else
544 <                pe = pe + pot
544 >                    pe = pe + pot
545   #endif                
546              
547                   efr(1,j) = -rxij
# Line 647 | Line 555 | contains
555                      ftmp = dudr * drdx1
556  
557  
558 < #ifdef MPI
558 > #ifdef IS_MPI
559                      fCol(dim,j) = fCol(dim,j) - ftmp
560                      fRow(dim,i) = fRow(dim,i) + ftmp
561   #else                    
# Line 662 | Line 570 | contains
570          enddo inner
571       enddo
572  
573 < #ifdef MPI
573 > #ifdef IS_MPI
574       point(nrow + 1) = nlist + 1
575   #else
576       point(natoms) = nlist + 1
# Line 676 | Line 584 | contains
584          JEND = POINT(i+1) - 1
585          ! check thiat molecule i has neighbors
586          if (jbeg .le. jend) then
587 < #ifdef MPI
587 > #ifdef IS_MPI
588             ljAtype_i => identPtrListRow(i)%this
589             rxi = qRow(1,i)
590             ryi = qRow(2,i)
# Line 689 | Line 597 | contains
597   #endif
598             do jnab = jbeg, jend
599                j = list(jnab)
600 < #ifdef MPI
600 > #ifdef IS_MPI
601                ljAtype_j = identPtrListColumn(j)%this
602 <              rxij = wrap(rxi - q_col(1,j), 1)
603 <              ryij = wrap(ryi - q_col(2,j), 2)
604 <              rzij = wrap(rzi - q_col(3,j), 3)
602 >              rxij = wrap(rxi - qCol(1,j), 1)
603 >              ryij = wrap(ryi - qCol(2,j), 2)
604 >              rzij = wrap(rzi - qCol(3,j), 3)
605   #else
606                ljAtype_j = identPtrList(j)%this
607                rxij = wrap(rxi - q(1,j), 1)
# Line 707 | Line 615 | contains
615                   r = dsqrt(rijsq)
616                  
617                   call getLJPot(r,pot,dudr,ljAtype_i,ljAtype_j)
618 < #ifdef MPI
619 <                e_row(i) = e_row(i) + pot*0.5
620 <                e_col(i) = e_col(i) + pot*0.5
618 > #ifdef IS_MPI
619 >                eRow(i) = eRow(i) + pot*0.5
620 >                eCol(i) = eCol(i) + pot*0.5
621   #else
622 <               if (do_pot)  pe = pe + pot
622 >                pe = pe + pot
623   #endif                
624  
625                  
# Line 723 | Line 631 | contains
631                      
632                      drdx1 = efr(dim,j) / r
633                      ftmp = dudr * drdx1
634 < #ifdef MPI
634 > #ifdef IS_MPI
635                      fCol(dim,j) = fCol(dim,j) - ftmp
636                      fRow(dim,i) = fRow(dim,i) + ftmp
637   #else                    
# Line 739 | Line 647 | contains
647  
648  
649  
650 < #ifdef MPI
650 > #ifdef IS_MPI
651      !!distribute forces
652 <    call scatter(fRow,f,plan_row3)
652 >    call scatter(fRow,f,plan_row3d)
653  
654 <    call scatter(fCol,f_tmp,plan_col3)
654 >    call scatter(fCol,fMPITemp,plan_col3d)
655 >
656      do i = 1,nlocal
657 <       do dim = 1,3
749 <          f(dim,i) = f(dim,i) + f_tmp(dim,i)
750 <       end do
657 >       f(1:3,i) = f(1:3,i) + fMPITemp(1:3,i)
658      end do
659  
660  
661      
662      if (do_pot) then
663   ! scatter/gather pot_row into the members of my column
664 <       call scatter(e_row,e_tmp,plan_row)
664 >       call scatter(eRow,eTemp,plan_row)
665        
666         ! scatter/gather pot_local into all other procs
667         ! add resultant to get total pot
668         do i = 1, nlocal
669 <          pot_local = pot_local + e_tmp(i)
669 >          pe_local = pe_local + eTemp(i)
670         enddo
671         if (newtons_thrd) then
672 <          e_tmp = 0.0E0_DP
673 <          call scatter(e_col,e_tmp,plan_col)
672 >          eTemp = 0.0E0_DP
673 >          call scatter(eCol,eTemp,plan_col)
674            do i = 1, nlocal
675 <             pot_local = pot_local + e_tmp(i)
675 >             pe_local = pe_local + eTemp(i)
676            enddo
677         endif
678      endif
679 +    potE = pe_local
680   #endif
681  
682 +    potE = pe
683  
684 +  
685  
686  
687    end subroutine do_lj_ff
# Line 789 | Line 699 | contains
699   !! Second Derivative, optional, used mainly for normal mode calculations.
700      real( kind = dp ), intent(out), optional :: d2
701      
702 <    type (lj_atype), intent(in), pointer :: atype1
703 <    type (lj_atype), intent(in), pointer :: atype2
702 >    type (lj_atype), pointer :: atype1
703 >    type (lj_atype), pointer :: atype2
704  
705      integer, intent(out), optional :: status
706  
# Line 798 | Line 708 | contains
708      real( kind = dp ) :: sigma
709      real( kind = dp ) :: sigma2
710      real( kind = dp ) :: sigma6
711 <    real( kind = dp ) :: epslon
711 >    real( kind = dp ) :: epsilon
712  
713      real( kind = dp ) :: rcut
714      real( kind = dp ) :: rcut2
# Line 823 | Line 733 | contains
733      if (present(status)) status = 0
734  
735   ! Look up the correct parameters in the mixing matrix
736 <    sigma   = ljMixed(atype1%atype_ident,atype2_atype_ident)%sigma
737 <    sigma2  = ljMixed(atype1%atype_ident,atype2_atype_ident)%sigma2
738 <    sigma6  = ljMixed(atype1%atype_ident,atype2_atype_ident)%sigma6
739 <    epslon  = ljMixed(atype1%atype_ident,atype2_atype_ident)%epslon
736 >    sigma    = ljMixed(atype1%atype_ident,atype2%atype_ident)%sigma
737 >    sigma2   = ljMixed(atype1%atype_ident,atype2%atype_ident)%sigma2
738 >    sigma6   = ljMixed(atype1%atype_ident,atype2%atype_ident)%sigma6
739 >    epsilon  = ljMixed(atype1%atype_ident,atype2%atype_ident)%epsilon
740  
741  
742 <
742 >    
743 >
744      call getRcut(rcut,rcut2=rcut2,rcut6=rcut6,status=errorStat)
745      
746      r2 = r * r
# Line 846 | Line 757 | contains
757      delta = -4.0E0_DP*epsilon * (tp12 - tp6)
758                                                                                
759      if (r.le.rcut) then
760 <       u = 4.0E0_DP * epsilon * (t12 - t6) + delta
760 >       pot = 4.0E0_DP * epsilon * (t12 - t6) + delta
761         dudr = 24.0E0_DP * epsilon * (t6 - 2.0E0_DP*t12) / r
762         if(doSec)  d2 = 24.0E0_DP * epsilon * (26.0E0_DP*t12 - 7.0E0_DP*t6)/r/r
763      else
764 <       u = 0.0E0_DP
764 >       pot = 0.0E0_DP
765         dudr = 0.0E0_DP
766         if(doSec) d2 = 0.0E0_DP
767      endif
# Line 879 | Line 790 | contains
790  
791      case ("sigma")
792         myMixParam = 0.5_dp * (param1 + param2)
793 <    case ("epslon")
793 >    case ("epsilon")
794         myMixParam = sqrt(param1 * param2)
795      case default
796         status = -1

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines