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 261 by chuckv, Mon Feb 3 21:15:59 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.17 2003-02-03 21:15:59 chuckv Exp $, $Date: 2003-02-03 21:15:59 $, $Name: not supported by cvs2svn $, $Revision: 1.17 $
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 +
128 +    integer :: myNode
129   #ifdef IS_MPI
130      integer, allocatable, dimension(:) :: identRow
131      integer, allocatable, dimension(:) :: identCol
132      integer :: nrow
133      integer :: ncol
245    integer :: alloc_stat
134   #endif
135      status = 0
136 +  
137  
138 +    
139 +
140   !! if were're not in MPI, we just update ljatypePtrList
141   #ifndef IS_MPI
142 <    call new_ljatypePtrList(nComponents,ident,identPtrList,thisStat)
142 >    call create_IdentPtrlst(ident,ljListHead,identPtrList,thisStat)
143      if ( thisStat /= 0 ) then
144         status = -1
145         return
146      endif
147 +
148   !! Allocate pointer lists
149      allocate(point(nComponents),stat=alloc_stat)
150      if (alloc_stat /=0) then
# Line 268 | Line 160 | contains
160      
161   ! if were're in MPI, we also have to worry about row and col lists    
162   #else
163 +  
164   ! We can only set up forces if mpiSimulation has been setup.
165      if (.not. isMPISimSet()) then
166 +       write(default_error,*) "MPI is not set"
167         status = -1
168         return
169      endif
170 <    nrow = getNrow()
171 <    ncol = getNcol()
170 >    nrow = getNrow(plan_row)
171 >    ncol = getNcol(plan_col)
172 >    mynode = getMyNode()
173   !! Allocate temperary arrays to hold gather information
174      allocate(identRow(nrow),stat=alloc_stat)
175      if (alloc_stat /= 0 ) then
# Line 287 | Line 182 | contains
182         status = -1
183         return
184      endif
185 +
186   !! Gather idents into row and column idents
187 +
188      call gather(ident,identRow,plan_row)
189      call gather(ident,identCol,plan_col)
190 <
190 >    
191 >  
192   !! Create row and col pointer lists
193 <    call new_ljatypePtrList(nrow,identRow,identPtrListRow,thisStat)
193 >  
194 >    call create_IdentPtrlst(identRow,ljListHead,identPtrListRow,thisStat)
195      if (thisStat /= 0 ) then
196         status = -1
197         return
198      endif
199 <
200 <    call new_ljatypePtrList(ncol,identCol,identPtrListCol,thisStat)
199 >  
200 >    call create_IdentPtrlst(identCol,ljListHead,identPtrListColumn,thisStat)
201      if (thisStat /= 0 ) then
202         status = -1
203         return
204      endif
205  
206   !! free temporary ident arrays
207 <    deallocate(identCol)
208 <    deallocate(identRow)
209 <
210 < !! Allocate Simulation arrays
211 < !! NOTE: This bit of code should be fixed, it can cause large
313 < !! memory fragmentation if call repeatedly
314 <
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
207 >    if (allocated(identCol)) then
208 >       deallocate(identCol)
209 >    end if
210 >    if (allocated(identCol)) then
211 >       deallocate(identRow)
212      endif
213  
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
214   !! Allocate neighbor lists for mpi simulations.
215      if (.not. allocated(point)) then
216         allocate(point(nrow),stat=alloc_stat)
# Line 402 | Line 242 | contains
242  
243   #endif
244      
245 <
245 >    call createMixingList(thisStat)
246 >    if (thisStat /= 0) then
247 >       status = -1
248 >       return
249 >    endif
250      isljFFinit = .true.
251  
252  
# Line 412 | Line 256 | contains
256  
257  
258  
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
259  
260 <    integer :: thisIdent
260 >  subroutine createMixingList(status)
261 >    integer :: listSize
262 >    integer :: status
263      integer :: i
264 <    integer :: alloc_error
426 <    type (lj_atype), pointer :: tmpPtr
264 >    integer :: j
265  
266 <    if (present(status)) status = 0
266 >    integer :: outerCounter = 0
267 >    integer :: innerCounter = 0
268 >    type (lj_atype), pointer :: tmpPtrOuter => null()
269 >    type (lj_atype), pointer :: tmpPtrInner => null()
270 >    status = 0
271  
272 < ! First time through, allocate list
273 <    if (.not.(allocated)) then
274 <       allocate(PtrList(mysize))
272 >    listSize = getListLen(ljListHead)
273 >    if (listSize == 0) then
274 >       status = -1
275 >       return
276 >    end if
277 >  
278 >
279 >    if (.not. associated(ljMixed)) then
280 >       allocate(ljMixed(listSize,listSize))
281      else
282 < ! We want to creat a new ident list so free old list
283 <       deallocate(PrtList)
284 <       allocate(PtrList(mysize))
437 <    endif
282 >       status = -1
283 >       return
284 >    end if
285  
286 < ! Match pointer list
287 <    do i = 1, mysize
288 <       thisIdent = ident(i)
289 <       call getLJatype(thisIdent,tmpPtr)
290 <
291 <      if (.not. associated(tmpPtr)) then
292 <          status = -1
293 <          return
286 >    
287 >
288 >    tmpPtrOuter => ljListHead
289 >    tmpPtrInner => tmpPtrOuter%next
290 >    do while (associated(tmpPtrOuter))
291 >       outerCounter = outerCounter + 1
292 > ! do self mixing rule
293 >       ljMixed(outerCounter,outerCounter)%sigma  = tmpPtrOuter%sigma
294 >                                                                                                  
295 >       ljMixed(outerCounter,outerCounter)%sigma2  = ljMixed(outerCounter,outerCounter)%sigma &
296 >            * ljMixed(outerCounter,outerCounter)%sigma
297 >                                                                                                  
298 >       ljMixed(outerCounter,outerCounter)%sigma6 = ljMixed(outerCounter,outerCounter)%sigma2 &
299 >            * ljMixed(outerCounter,outerCounter)%sigma2 &
300 >            * ljMixed(outerCounter,outerCounter)%sigma2
301 >                                                                                                  
302 >       ljMixed(outerCounter,outerCounter)%epsilon = tmpPtrOuter%epsilon
303 >
304 >       innerCounter = outerCounter + 1
305 >       do while (associated(tmpPtrInner))
306 >          
307 >          ljMixed(outerCounter,innerCounter)%sigma  =  &
308 >               calcLJMix("sigma",tmpPtrOuter%sigma, &
309 >               tmpPtrInner%sigma)
310 >          
311 >          ljMixed(outerCounter,innerCounter)%sigma2  = &
312 >               ljMixed(outerCounter,innerCounter)%sigma &
313 >               * ljMixed(outerCounter,innerCounter)%sigma
314 >          
315 >          ljMixed(outerCounter,innerCounter)%sigma6 = &
316 >               ljMixed(outerCounter,innerCounter)%sigma2 &
317 >               * ljMixed(outerCounter,innerCounter)%sigma2 &
318 >               * ljMixed(outerCounter,innerCounter)%sigma2
319 >          
320 >          ljMixed(outerCounter,innerCounter)%epsilon = &
321 >               calcLJMix("epsilon",tmpPtrOuter%epsilon, &
322 >               tmpPtrInner%epsilon)
323 >          ljMixed(innerCounter,outerCounter)%sigma = ljMixed(outerCounter,innerCounter)%sigma
324 >          ljMixed(innerCounter,outerCounter)%sigma2 = ljMixed(outerCounter,innerCounter)%sigma2
325 >          ljMixed(innerCounter,outerCounter)%sigma6 = ljMixed(outerCounter,innerCounter)%sigma6
326 >          ljMixed(innerCounter,outerCounter)%epsilon = ljMixed(outerCounter,innerCounter)%epsilon
327 >
328 >
329 >          tmpPtrInner => tmpPtrInner%next
330 >          innerCounter = innerCounter + 1
331 >       end do
332 > ! advance pointers
333 >       tmpPtrOuter => tmpPtrOuter%next
334 >       if (associated(tmpPtrOuter)) then
335 >          tmpPtrInner => tmpPtrOuter%next
336         endif
337        
449       PtrList(i)%this => tmpPtr
338      end do
339  
340 <  end subroutine new_ljatypePtrList
340 >  end subroutine createMixingList
341  
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()
342  
462    if(.not. associated(lj_atype_list)) return
343  
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
344  
476  end subroutine getLJatype
345  
346  
347 +
348 +
349   !! FORCE routine Calculates Lennard Jones forces.
350   !------------------------------------------------------------->
351    subroutine do_lj_ff(q,f,potE,do_pot)
352 <    real ( kind = dp ), dimension(ndim,) :: q
353 <    real ( kind = dp ), dimension(ndim,nLRparticles) :: f
352 > !! Position array provided by C, dimensioned by getNlocal
353 >    real ( kind = dp ), dimension(3,getNlocal()) :: q
354 > !! Force array provided by C, dimensioned by getNlocal
355 >    real ( kind = dp ), dimension(3,getNlocal()) :: f
356      real ( kind = dp ) :: potE
357      logical ( kind = 2) :: do_pot
358      
359      type(lj_atype), pointer :: ljAtype_i
360      type(lj_atype), pointer :: ljAtype_j
361  
362 < #ifdef MPI
363 <  real( kind = DP ), dimension(3,ncol) :: efr
362 > #ifdef IS_MPI
363 >  real( kind = DP ), dimension(3,getNcol(plan_col)) :: efr
364    real( kind = DP ) :: pot_local
365   #else
366 < !  real( kind = DP ), dimension(3,natoms) :: efr
366 >  real( kind = DP ), dimension(3,getNlocal()) :: efr
367   #endif
368    
369 + !! Local arrays needed for MPI
370 + #ifdef IS_MPI
371 +  real(kind = dp), dimension(3,getNrow(plan_row)) :: qRow
372 +  real(kind = dp), dimension(3,getNcol(plan_col)) :: qCol
373 +
374 +  real(kind = dp), dimension(3,getNrow(plan_row)) :: fRow
375 +  real(kind = dp), dimension(3,getNcol(plan_col)) :: fCol
376 +  real(kind = dp), dimension(3,getNlocal()) :: fMPITemp
377 +
378 +  real(kind = dp), dimension(getNrow(plan_row)) :: eRow
379 +  real(kind = dp), dimension(getNcol(plan_col)) :: eCol
380 +
381 +  real(kind = dp), dimension(getNlocal()) :: eTemp
382 + #endif
383 +
384 +
385 +
386    real( kind = DP )   :: pe
387 <  logical,            :: update_nlist
387 >  logical             :: update_nlist
388  
389  
390    integer ::  i, j, jbeg, jend, jnab, idim, jdim, idim2, jdim2, dim, dim2
# Line 504 | Line 393 | contains
393    integer :: tag_i,tag_j
394    real( kind = DP ) ::  r, pot, ftmp, dudr, d2, drdx1, kt1, kt2, kt3, ktmp
395    real( kind = DP ) ::  rxi, ryi, rzi, rxij, ryij, rzij, rijsq
396 +  real( kind = DP ) ::  rlistsq, rcutsq,rlist,rcut
397  
398 + ! a rig that need to be fixed.
399 + #ifdef IS_MPI
400 +  logical :: newtons_thrd = .true.
401 +  real( kind = dp ) :: pe_local
402 +  integer :: nlocal
403 + #endif
404    integer :: nrow
405    integer :: ncol
406 +  integer :: natoms
407  
408 +
409 +
410 +
411 + ! Make sure we are properly initialized.
412    if (.not. isljFFInit) then
413       write(default_error,*) "ERROR: lj_FF has not been properly initialized"
414       return
415    endif
416 + #ifdef IS_MPI
417 +    if (.not. isMPISimSet()) then
418 +     write(default_error,*) "ERROR: mpiSimulation has not been properly initialized"
419 +     return
420 +  endif
421 + #endif
422  
423 + !! initialize local variables  
424 +  natoms = getNlocal()
425 +  call getRcut(rcut,rcut2=rcutsq)
426 +  call getRlist(rlist,rlistsq)
427 +
428   #ifndef IS_MPI
429    nrow = natoms - 1
430    ncol = natoms
431   #else
432    nrow = getNrow(plan_row)
433    ncol = getNcol(plan_col)
434 +  nlocal = natoms
435    j_start = 1
436   #endif
437  
438    
439 <
440 <  call check(update_nlist)
439 > !! See if we need to update neighbor lists
440 >  call check(q,update_nlist)
441 >  if (firstTime) then
442 >     update_nlist = .true.
443 >     firstTime = .false.
444 >  endif
445  
446   !--------------WARNING...........................
447   ! Zero variables, NOTE:::: Forces are zeroed in C
# Line 532 | Line 449 | contains
449   ! Forces.
450   !------------------------------------------------
451   #ifndef IS_MPI
452 <  nloops = nloops + 1
453 <  pot = 0.0E0_DP
454 <  e = 0.0E0_DP
452 > !  nloops = nloops + 1
453 >  pe = 0.0E0_DP
454 >
455   #else
456 <    f_row = 0.0E0_DP
457 <    f_col = 0.0E0_DP
456 >    fRow = 0.0E0_DP
457 >    fCol = 0.0E0_DP
458  
459 <    pot_local = 0.0E0_DP
459 >    pe_local = 0.0E0_DP
460  
461 <    e_row = 0.0E0_DP
462 <    e_col = 0.0E0_DP
463 <    e_tmp = 0.0E0_DP
461 >    eRow = 0.0E0_DP
462 >    eCol = 0.0E0_DP
463 >    eTemp = 0.0E0_DP
464   #endif
465      efr = 0.0E0_DP
466  
467   ! communicate MPI positions
468 < #ifdef MPI    
469 <    call gather(q,qRow,plan_row3)
470 <    call gather(q,qCol,plan_col3)
468 > #ifdef IS_MPI    
469 >    call gather(q,qRow,plan_row3d)
470 >    call gather(q,qCol,plan_col3d)
471   #endif
472  
556 #ifndef MPI
473  
558 #endif
559
474    if (update_nlist) then
475  
476       ! save current configuration, contruct neighbor list,
477       ! and calculate forces
478 <     call save_nlist()
478 >     call save_nlist(q)
479      
480       nlist = 0
481      
482 <    
482 >    
483  
484       do i = 1, nrow
485          point(i) = nlist + 1
486 < #ifdef MPI
486 > #ifdef IS_MPI
487          ljAtype_i => identPtrListRow(i)%this
488          tag_i = tagRow(i)
489          rxi = qRow(1,i)
# Line 584 | Line 498 | contains
498   #endif
499  
500          inner: do j = j_start, ncol
501 < #ifdef MPI
501 > #ifdef IS_MPI
502   ! Assign identity pointers and tags
503             ljAtype_j => identPtrListColumn(j)%this
504 <           tag_j = tagCol(j)
504 >           tag_j = tagColumn(j)
505             if (newtons_thrd) then
506                if (tag_i <= tag_j) then
507                   if (mod(tag_i + tag_j,2) == 0) cycle inner
# Line 608 | Line 522 | contains
522   #endif          
523             rijsq = rxij*rxij + ryij*ryij + rzij*rzij
524  
525 < #ifdef MPI
526 <             if (rijsq <=  rlstsq .AND. &
525 > #ifdef IS_MPI
526 >             if (rijsq <=  rlistsq .AND. &
527                    tag_j /= tag_i) then
528   #else
529 <             if (rijsq <  rlstsq) then
529 >          
530 >             if (rijsq <  rlistsq) then
531   #endif
532              
533                nlist = nlist + 1
534                if (nlist > size(list)) then
535 < #warning "Change how nlist size is done"
535 > !!  "Change how nlist size is done"
536                   write(DEFAULT_ERROR,*) "ERROR: nlist > list size"
537                endif
538                list(nlist) = j
539  
540 <              
540 >    
541                if (rijsq <  rcutsq) then
542                  
543                   r = dsqrt(rijsq)
544        
545                   call getLJPot(r,pot,dudr,ljAtype_i,ljAtype_j)
546        
547 < #ifdef MPI
548 <                e_row(i) = e_row(i) + pot*0.5
549 <                e_col(i) = e_col(i) + pot*0.5
547 > #ifdef IS_MPI
548 >                eRow(i) = eRow(i) + pot*0.5
549 >                eCol(i) = eCol(i) + pot*0.5
550   #else
551 <                pe = pe + pot
551 >                    pe = pe + pot
552   #endif                
553              
554                   efr(1,j) = -rxij
# Line 647 | Line 562 | contains
562                      ftmp = dudr * drdx1
563  
564  
565 < #ifdef MPI
565 > #ifdef IS_MPI
566                      fCol(dim,j) = fCol(dim,j) - ftmp
567                      fRow(dim,i) = fRow(dim,i) + ftmp
568   #else                    
# Line 662 | Line 577 | contains
577          enddo inner
578       enddo
579  
580 < #ifdef MPI
580 > #ifdef IS_MPI
581       point(nrow + 1) = nlist + 1
582   #else
583       point(natoms) = nlist + 1
# Line 676 | Line 591 | contains
591          JEND = POINT(i+1) - 1
592          ! check thiat molecule i has neighbors
593          if (jbeg .le. jend) then
594 < #ifdef MPI
594 > #ifdef IS_MPI
595             ljAtype_i => identPtrListRow(i)%this
596             rxi = qRow(1,i)
597             ryi = qRow(2,i)
# Line 689 | Line 604 | contains
604   #endif
605             do jnab = jbeg, jend
606                j = list(jnab)
607 < #ifdef MPI
607 > #ifdef IS_MPI
608                ljAtype_j = identPtrListColumn(j)%this
609 <              rxij = wrap(rxi - q_col(1,j), 1)
610 <              ryij = wrap(ryi - q_col(2,j), 2)
611 <              rzij = wrap(rzi - q_col(3,j), 3)
609 >              rxij = wrap(rxi - qCol(1,j), 1)
610 >              ryij = wrap(ryi - qCol(2,j), 2)
611 >              rzij = wrap(rzi - qCol(3,j), 3)
612   #else
613                ljAtype_j = identPtrList(j)%this
614                rxij = wrap(rxi - q(1,j), 1)
# Line 707 | Line 622 | contains
622                   r = dsqrt(rijsq)
623                  
624                   call getLJPot(r,pot,dudr,ljAtype_i,ljAtype_j)
625 < #ifdef MPI
626 <                e_row(i) = e_row(i) + pot*0.5
627 <                e_col(i) = e_col(i) + pot*0.5
625 > #ifdef IS_MPI
626 >                eRow(i) = eRow(i) + pot*0.5
627 >                eCol(i) = eCol(i) + pot*0.5
628   #else
629 <               if (do_pot)  pe = pe + pot
629 >                pe = pe + pot
630   #endif                
631  
632                  
# Line 723 | Line 638 | contains
638                      
639                      drdx1 = efr(dim,j) / r
640                      ftmp = dudr * drdx1
641 < #ifdef MPI
641 > #ifdef IS_MPI
642                      fCol(dim,j) = fCol(dim,j) - ftmp
643                      fRow(dim,i) = fRow(dim,i) + ftmp
644   #else                    
# Line 739 | Line 654 | contains
654  
655  
656  
657 < #ifdef MPI
657 > #ifdef IS_MPI
658      !!distribute forces
744    call scatter(fRow,f,plan_row3)
659  
660 <    call scatter(fCol,f_tmp,plan_col3)
660 >    call scatter(fRow,f,plan_row3d)
661 >
662 >    call scatter(fCol,fMPITemp,plan_col3d)
663 >
664      do i = 1,nlocal
665 <       do dim = 1,3
749 <          f(dim,i) = f(dim,i) + f_tmp(dim,i)
750 <       end do
665 >       f(1:3,i) = f(1:3,i) + fMPITemp(1:3,i)
666      end do
667  
668  
669      
670      if (do_pot) then
671   ! scatter/gather pot_row into the members of my column
672 <       call scatter(e_row,e_tmp,plan_row)
672 >       call scatter(eRow,eTemp,plan_row)
673        
674         ! scatter/gather pot_local into all other procs
675         ! add resultant to get total pot
676         do i = 1, nlocal
677 <          pot_local = pot_local + e_tmp(i)
677 >          pe_local = pe_local + eTemp(i)
678         enddo
679         if (newtons_thrd) then
680 <          e_tmp = 0.0E0_DP
681 <          call scatter(e_col,e_tmp,plan_col)
680 >          eTemp = 0.0E0_DP
681 >          call scatter(eCol,eTemp,plan_col)
682            do i = 1, nlocal
683 <             pot_local = pot_local + e_tmp(i)
683 >             pe_local = pe_local + eTemp(i)
684            enddo
685         endif
686      endif
687 +    potE = pe_local
688   #endif
689  
690 +    potE = pe
691  
775
776
692    end subroutine do_lj_ff
693  
694   !! Calculates the potential between two lj particles based on two lj_atype pointers, optionally returns second
# Line 789 | Line 704 | contains
704   !! Second Derivative, optional, used mainly for normal mode calculations.
705      real( kind = dp ), intent(out), optional :: d2
706      
707 <    type (lj_atype), intent(in), pointer :: atype1
708 <    type (lj_atype), intent(in), pointer :: atype2
707 >    type (lj_atype), pointer :: atype1
708 >    type (lj_atype), pointer :: atype2
709  
710      integer, intent(out), optional :: status
711  
# Line 798 | Line 713 | contains
713      real( kind = dp ) :: sigma
714      real( kind = dp ) :: sigma2
715      real( kind = dp ) :: sigma6
716 <    real( kind = dp ) :: epslon
716 >    real( kind = dp ) :: epsilon
717  
718      real( kind = dp ) :: rcut
719      real( kind = dp ) :: rcut2
# Line 823 | Line 738 | contains
738      if (present(status)) status = 0
739  
740   ! Look up the correct parameters in the mixing matrix
741 <    sigma   = ljMixed(atype1%atype_ident,atype2_atype_ident)%sigma
742 <    sigma2  = ljMixed(atype1%atype_ident,atype2_atype_ident)%sigma2
743 <    sigma6  = ljMixed(atype1%atype_ident,atype2_atype_ident)%sigma6
744 <    epslon  = ljMixed(atype1%atype_ident,atype2_atype_ident)%epslon
741 >    sigma    = ljMixed(atype1%atype_ident,atype2%atype_ident)%sigma
742 >    sigma2   = ljMixed(atype1%atype_ident,atype2%atype_ident)%sigma2
743 >    sigma6   = ljMixed(atype1%atype_ident,atype2%atype_ident)%sigma6
744 >    epsilon  = ljMixed(atype1%atype_ident,atype2%atype_ident)%epsilon
745  
746  
747 <
747 >    
748 >
749      call getRcut(rcut,rcut2=rcut2,rcut6=rcut6,status=errorStat)
750      
751      r2 = r * r
# Line 846 | Line 762 | contains
762      delta = -4.0E0_DP*epsilon * (tp12 - tp6)
763                                                                                
764      if (r.le.rcut) then
765 <       u = 4.0E0_DP * epsilon * (t12 - t6) + delta
765 >       pot = 4.0E0_DP * epsilon * (t12 - t6) + delta
766         dudr = 24.0E0_DP * epsilon * (t6 - 2.0E0_DP*t12) / r
767         if(doSec)  d2 = 24.0E0_DP * epsilon * (26.0E0_DP*t12 - 7.0E0_DP*t6)/r/r
768      else
769 <       u = 0.0E0_DP
769 >       pot = 0.0E0_DP
770         dudr = 0.0E0_DP
771         if(doSec) d2 = 0.0E0_DP
772      endif
# Line 879 | Line 795 | contains
795  
796      case ("sigma")
797         myMixParam = 0.5_dp * (param1 + param2)
798 <    case ("epslon")
798 >    case ("epsilon")
799         myMixParam = sqrt(param1 * param2)
800      case default
801         status = -1

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines