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 240 by chuckv, Wed Jan 22 21:45:20 2003 UTC vs.
Revision 258 by chuckv, Thu Jan 30 22:29: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.9 2003-01-22 21:45:20 chuckv Exp $, $Date: 2003-01-22 21:45:20 $, $Name: not supported by cvs2svn $, $Revision: 1.9 $
5 > !! @version $Id: lj_FF.F90,v 1.15 2003-01-30 22:29:37 chuckv Exp $, $Date: 2003-01-30 22:29:37 $, $Name: not supported by cvs2svn $, $Revision: 1.15 $
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
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 >
171   !! Allocate temperary arrays to hold gather information
172      allocate(identRow(nrow),stat=alloc_stat)
173      if (alloc_stat /= 0 ) then
# Line 287 | Line 180 | contains
180         status = -1
181         return
182      endif
183 +
184   !! Gather idents into row and column idents
185 +
186      call gather(ident,identRow,plan_row)
187      call gather(ident,identCol,plan_col)
188 <
188 >    
189 >
190   !! Create row and col pointer lists
191 <    call new_ljatypePtrList(nrow,identRow,identPtrListRow,thisStat)
191 >
192 >    call create_IdentPtrlst(identRow,ljListHead,identPtrListRow,thisStat)
193      if (thisStat /= 0 ) then
194         status = -1
195         return
196      endif
197  
198 <    call new_ljatypePtrList(ncol,identCol,identPtrListCol,thisStat)
198 >    call create_IdentPtrlst(identCol,ljListHead,identPtrListColumn,thisStat)
199      if (thisStat /= 0 ) then
200         status = -1
201         return
202      endif
203 <
203 >    write(*,*) "After createIdent row-col lists"
204   !! free temporary ident arrays
205 <    deallocate(identCol)
206 <    deallocate(identRow)
207 <
208 < !! Allocate Simulation arrays
209 < !! 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
205 >    if (allocated(identCol)) then
206 >       deallocate(identCol)
207 >    end if
208 >    if (allocated(identCol)) then
209 >       deallocate(identRow)
210      endif
211  
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
212   !! Allocate neighbor lists for mpi simulations.
213      if (.not. allocated(point)) then
214         allocate(point(nrow),stat=alloc_stat)
# Line 402 | Line 240 | contains
240  
241   #endif
242      
243 <
243 >    call createMixingList(thisStat)
244 >    if (thisStat /= 0) then
245 >       status = -1
246 >       return
247 >    endif
248      isljFFinit = .true.
249  
408
250    end subroutine init_ljFF
251  
252  
253  
254  
255  
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
256  
257 <    integer :: thisIdent
257 >  subroutine createMixingList(status)
258 >    integer :: listSize
259 >    integer :: status
260      integer :: i
261 <    integer :: alloc_error
426 <    type (lj_atype), pointer :: tmpPtr
261 >    integer :: j
262  
263 <    if (present(status)) status = 0
264 <
265 < ! First time through, allocate list
266 <    if (.not.(allocated)) then
267 <       allocate(PtrList(mysize))
433 <    else
434 < ! We want to creat a new ident list so free old list
435 <       deallocate(PrtList)
436 <       allocate(PtrList(mysize))
437 <    endif
263 >    integer :: outerCounter = 0
264 >    integer :: innerCounter = 0
265 >    type (lj_atype), pointer :: tmpPtrOuter => null()
266 >    type (lj_atype), pointer :: tmpPtrInner => null()
267 >    status = 0
268  
269 < ! Match pointer list
270 <    do i = 1, mysize
271 <       thisIdent = ident(i)
272 <       call getLJatype(thisIdent,tmpPtr)
273 <
274 <      if (.not. associated(tmpPtr)) then
275 <          status = -1
276 <          return
269 >    listSize = getListLen(ljListHead)
270 >    if (listSize == 0) then
271 >       status = -1
272 >       return
273 >    end if
274 >  
275 >
276 >    if (.not. associated(ljMixed)) then
277 >       allocate(ljMixed(listSize,listSize))
278 >    else
279 >       status = -1
280 >       return
281 >    end if
282 >
283 >    
284 >
285 >    tmpPtrOuter => ljListHead
286 >    tmpPtrInner => tmpPtrOuter%next
287 >    do while (associated(tmpPtrOuter))
288 >       outerCounter = outerCounter + 1
289 > ! do self mixing rule
290 >       ljMixed(outerCounter,outerCounter)%sigma  = tmpPtrOuter%sigma
291 >                                                                                                  
292 >       ljMixed(outerCounter,outerCounter)%sigma2  = ljMixed(outerCounter,outerCounter)%sigma &
293 >            * ljMixed(outerCounter,outerCounter)%sigma
294 >                                                                                                  
295 >       ljMixed(outerCounter,outerCounter)%sigma6 = ljMixed(outerCounter,outerCounter)%sigma2 &
296 >            * ljMixed(outerCounter,outerCounter)%sigma2 &
297 >            * ljMixed(outerCounter,outerCounter)%sigma2
298 >                                                                                                  
299 >       ljMixed(outerCounter,outerCounter)%epsilon = tmpPtrOuter%epsilon
300 >
301 >       innerCounter = outerCounter + 1
302 >       do while (associated(tmpPtrInner))
303 >          
304 >          ljMixed(outerCounter,innerCounter)%sigma  =  &
305 >               calcLJMix("sigma",tmpPtrOuter%sigma, &
306 >               tmpPtrInner%sigma)
307 >          
308 >          ljMixed(outerCounter,innerCounter)%sigma2  = &
309 >               ljMixed(outerCounter,innerCounter)%sigma &
310 >               * ljMixed(outerCounter,innerCounter)%sigma
311 >          
312 >          ljMixed(outerCounter,innerCounter)%sigma6 = &
313 >               ljMixed(outerCounter,innerCounter)%sigma2 &
314 >               * ljMixed(outerCounter,innerCounter)%sigma2 &
315 >               * ljMixed(outerCounter,innerCounter)%sigma2
316 >          
317 >          ljMixed(outerCounter,innerCounter)%epsilon = &
318 >               calcLJMix("epsilon",tmpPtrOuter%epsilon, &
319 >               tmpPtrInner%epsilon)
320 >          ljMixed(innerCounter,outerCounter)%sigma = ljMixed(outerCounter,innerCounter)%sigma
321 >          ljMixed(innerCounter,outerCounter)%sigma2 = ljMixed(outerCounter,innerCounter)%sigma2
322 >          ljMixed(innerCounter,outerCounter)%sigma6 = ljMixed(outerCounter,innerCounter)%sigma6
323 >          ljMixed(innerCounter,outerCounter)%epsilon = ljMixed(outerCounter,innerCounter)%epsilon
324 >
325 >
326 >          tmpPtrInner => tmpPtrInner%next
327 >          innerCounter = innerCounter + 1
328 >       end do
329 > ! advance pointers
330 >       tmpPtrOuter => tmpPtrOuter%next
331 >       if (associated(tmpPtrOuter)) then
332 >          tmpPtrInner => tmpPtrOuter%next
333         endif
334        
449       PtrList(i)%this => tmpPtr
335      end do
336  
337 <  end subroutine new_ljatypePtrList
337 >  end subroutine createMixingList
338  
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()
339  
462    if(.not. associated(lj_atype_list)) return
340  
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
341  
476  end subroutine getLJatype
342  
343  
344 +
345 +
346   !! FORCE routine Calculates Lennard Jones forces.
347   !------------------------------------------------------------->
348    subroutine do_lj_ff(q,f,potE,do_pot)
349 <    real ( kind = dp ), dimension(ndim,) :: q
350 <    real ( kind = dp ), dimension(ndim,nLRparticles) :: f
349 > !! Position array provided by C, dimensioned by getNlocal
350 >    real ( kind = dp ), dimension(3,getNlocal()) :: q
351 > !! Force array provided by C, dimensioned by getNlocal
352 >    real ( kind = dp ), dimension(3,getNlocal()) :: f
353      real ( kind = dp ) :: potE
354      logical ( kind = 2) :: do_pot
355      
356      type(lj_atype), pointer :: ljAtype_i
357      type(lj_atype), pointer :: ljAtype_j
358  
359 < #ifdef MPI
360 <  real( kind = DP ), dimension(3,ncol) :: efr
359 > #ifdef IS_MPI
360 >  real( kind = DP ), dimension(3,getNcol(plan_col)) :: efr
361    real( kind = DP ) :: pot_local
362   #else
363 < !  real( kind = DP ), dimension(3,natoms) :: efr
363 >  real( kind = DP ), dimension(3,getNlocal()) :: efr
364   #endif
365    
366 + !! Local arrays needed for MPI
367 + #ifdef IS_MPI
368 +  real(kind = dp), dimension(3,getNrow(plan_row)) :: qRow
369 +  real(kind = dp), dimension(3,getNcol(plan_col)) :: qCol
370 +
371 +  real(kind = dp), dimension(3,getNrow(plan_row)) :: fRow
372 +  real(kind = dp), dimension(3,getNcol(plan_col)) :: fCol
373 +  real(kind = dp), dimension(3,getNlocal()) :: fMPITemp
374 +
375 +  real(kind = dp), dimension(getNrow(plan_row)) :: eRow
376 +  real(kind = dp), dimension(getNcol(plan_col)) :: eCol
377 +
378 +  real(kind = dp), dimension(getNlocal()) :: eTemp
379 + #endif
380 +
381 +
382 +
383    real( kind = DP )   :: pe
384 <  logical,            :: update_nlist
384 >  logical             :: update_nlist
385  
386  
387    integer ::  i, j, jbeg, jend, jnab, idim, jdim, idim2, jdim2, dim, dim2
# Line 504 | Line 390 | contains
390    integer :: tag_i,tag_j
391    real( kind = DP ) ::  r, pot, ftmp, dudr, d2, drdx1, kt1, kt2, kt3, ktmp
392    real( kind = DP ) ::  rxi, ryi, rzi, rxij, ryij, rzij, rijsq
393 <  real( kind = DP ) ::  rlistsq, rcutsq
393 >  real( kind = DP ) ::  rlistsq, rcutsq,rlist,rcut
394  
395 + ! a rig that need to be fixed.
396 + #ifdef IS_MPI
397 +  logical :: newtons_thrd = .true.
398 +  real( kind = dp ) :: pe_local
399 +  integer :: nlocal
400 + #endif
401    integer :: nrow
402    integer :: ncol
403 +  integer :: natoms
404  
405 +
406 +
407 +
408 + ! Make sure we are properly initialized.
409    if (.not. isljFFInit) then
410       write(default_error,*) "ERROR: lj_FF has not been properly initialized"
411       return
412    endif
413 + #ifdef IS_MPI
414 +    if (.not. isMPISimSet()) then
415 +     write(default_error,*) "ERROR: mpiSimulation has not been properly initialized"
416 +     return
417 +  endif
418 + #endif
419  
420 + !! initialize local variables  
421 +  natoms = getNlocal()
422 +  call getRcut(rcut,rcut2=rcutsq)
423 +  call getRlist(rlist,rlistsq)
424 +
425   #ifndef IS_MPI
426    nrow = natoms - 1
427    ncol = natoms
428   #else
429    nrow = getNrow(plan_row)
430    ncol = getNcol(plan_col)
431 +  nlocal = natoms
432    j_start = 1
433   #endif
434  
435    
436 + !! See if we need to update neighbor lists
437 +  call check(q,update_nlist)
438 +  if (firstTime) then
439 +     update_nlist = .true.
440 +     firstTime = .false.
441 +  endif
442  
528  call check(update_nlist)
529
443   !--------------WARNING...........................
444   ! Zero variables, NOTE:::: Forces are zeroed in C
445   ! Zeroing them here could delete previously computed
446   ! Forces.
447   !------------------------------------------------
448   #ifndef IS_MPI
449 <  nloops = nloops + 1
450 <  pot = 0.0E0_DP
451 <  e = 0.0E0_DP
449 > !  nloops = nloops + 1
450 >  pe = 0.0E0_DP
451 >
452   #else
453 <    f_row = 0.0E0_DP
454 <    f_col = 0.0E0_DP
453 >    fRow = 0.0E0_DP
454 >    fCol = 0.0E0_DP
455  
456 <    pot_local = 0.0E0_DP
456 >    pe_local = 0.0E0_DP
457  
458 <    e_row = 0.0E0_DP
459 <    e_col = 0.0E0_DP
460 <    e_tmp = 0.0E0_DP
458 >    eRow = 0.0E0_DP
459 >    eCol = 0.0E0_DP
460 >    eTemp = 0.0E0_DP
461   #endif
462      efr = 0.0E0_DP
463  
464   ! communicate MPI positions
465 < #ifdef MPI    
466 <    call gather(q,qRow,plan_row3)
467 <    call gather(q,qCol,plan_col3)
465 > #ifdef IS_MPI    
466 >    call gather(q,qRow,plan_row3d)
467 >    call gather(q,qCol,plan_col3d)
468   #endif
469  
557 #ifndef MPI
470  
559 #endif
560
471    if (update_nlist) then
472  
473       ! save current configuration, contruct neighbor list,
474       ! and calculate forces
475 <     call save_nlist()
475 >     call save_nlist(q)
476      
477       nlist = 0
478      
479 <    
479 >    
480  
481       do i = 1, nrow
482          point(i) = nlist + 1
483 < #ifdef MPI
483 > #ifdef IS_MPI
484          ljAtype_i => identPtrListRow(i)%this
485          tag_i = tagRow(i)
486          rxi = qRow(1,i)
# Line 585 | Line 495 | contains
495   #endif
496  
497          inner: do j = j_start, ncol
498 < #ifdef MPI
498 > #ifdef IS_MPI
499   ! Assign identity pointers and tags
500             ljAtype_j => identPtrListColumn(j)%this
501 <           tag_j = tagCol(j)
501 >           tag_j = tagColumn(j)
502             if (newtons_thrd) then
503                if (tag_i <= tag_j) then
504                   if (mod(tag_i + tag_j,2) == 0) cycle inner
# Line 609 | Line 519 | contains
519   #endif          
520             rijsq = rxij*rxij + ryij*ryij + rzij*rzij
521  
522 < #ifdef MPI
523 <             if (rijsq <=  rlstsq .AND. &
522 > #ifdef IS_MPI
523 >             if (rijsq <=  rlistsq .AND. &
524                    tag_j /= tag_i) then
525   #else
526 <             if (rijsq <  rlstsq) then
526 >          
527 >             if (rijsq <  rlistsq) then
528   #endif
529              
530                nlist = nlist + 1
531                if (nlist > size(list)) then
532 < #warning "Change how nlist size is done"
532 > !!  "Change how nlist size is done"
533                   write(DEFAULT_ERROR,*) "ERROR: nlist > list size"
534                endif
535                list(nlist) = j
536  
537 <              
537 >    
538                if (rijsq <  rcutsq) then
539                  
540                   r = dsqrt(rijsq)
541        
542                   call getLJPot(r,pot,dudr,ljAtype_i,ljAtype_j)
543        
544 < #ifdef MPI
545 <                e_row(i) = e_row(i) + pot*0.5
546 <                e_col(i) = e_col(i) + pot*0.5
544 > #ifdef IS_MPI
545 >                eRow(i) = eRow(i) + pot*0.5
546 >                eCol(i) = eCol(i) + pot*0.5
547   #else
548 <                pe = pe + pot
548 >                    pe = pe + pot
549   #endif                
550              
551                   efr(1,j) = -rxij
# Line 648 | Line 559 | contains
559                      ftmp = dudr * drdx1
560  
561  
562 < #ifdef MPI
562 > #ifdef IS_MPI
563                      fCol(dim,j) = fCol(dim,j) - ftmp
564                      fRow(dim,i) = fRow(dim,i) + ftmp
565   #else                    
# Line 663 | Line 574 | contains
574          enddo inner
575       enddo
576  
577 < #ifdef MPI
577 > #ifdef IS_MPI
578       point(nrow + 1) = nlist + 1
579   #else
580       point(natoms) = nlist + 1
# Line 677 | Line 588 | contains
588          JEND = POINT(i+1) - 1
589          ! check thiat molecule i has neighbors
590          if (jbeg .le. jend) then
591 < #ifdef MPI
591 > #ifdef IS_MPI
592             ljAtype_i => identPtrListRow(i)%this
593             rxi = qRow(1,i)
594             ryi = qRow(2,i)
# Line 690 | Line 601 | contains
601   #endif
602             do jnab = jbeg, jend
603                j = list(jnab)
604 < #ifdef MPI
604 > #ifdef IS_MPI
605                ljAtype_j = identPtrListColumn(j)%this
606 <              rxij = wrap(rxi - q_col(1,j), 1)
607 <              ryij = wrap(ryi - q_col(2,j), 2)
608 <              rzij = wrap(rzi - q_col(3,j), 3)
606 >              rxij = wrap(rxi - qCol(1,j), 1)
607 >              ryij = wrap(ryi - qCol(2,j), 2)
608 >              rzij = wrap(rzi - qCol(3,j), 3)
609   #else
610                ljAtype_j = identPtrList(j)%this
611                rxij = wrap(rxi - q(1,j), 1)
# Line 708 | Line 619 | contains
619                   r = dsqrt(rijsq)
620                  
621                   call getLJPot(r,pot,dudr,ljAtype_i,ljAtype_j)
622 < #ifdef MPI
623 <                e_row(i) = e_row(i) + pot*0.5
624 <                e_col(i) = e_col(i) + pot*0.5
622 > #ifdef IS_MPI
623 >                eRow(i) = eRow(i) + pot*0.5
624 >                eCol(i) = eCol(i) + pot*0.5
625   #else
626 <               if (do_pot)  pe = pe + pot
626 >                pe = pe + pot
627   #endif                
628  
629                  
# Line 724 | Line 635 | contains
635                      
636                      drdx1 = efr(dim,j) / r
637                      ftmp = dudr * drdx1
638 < #ifdef MPI
638 > #ifdef IS_MPI
639                      fCol(dim,j) = fCol(dim,j) - ftmp
640                      fRow(dim,i) = fRow(dim,i) + ftmp
641   #else                    
# Line 740 | Line 651 | contains
651  
652  
653  
654 < #ifdef MPI
654 > #ifdef IS_MPI
655      !!distribute forces
656 <    call scatter(fRow,f,plan_row3)
656 >    call scatter(fRow,f,plan_row3d)
657  
658 <    call scatter(fCol,f_tmp,plan_col3)
658 >    call scatter(fCol,fMPITemp,plan_col3d)
659 >
660      do i = 1,nlocal
661 <       do dim = 1,3
750 <          f(dim,i) = f(dim,i) + f_tmp(dim,i)
751 <       end do
661 >       f(1:3,i) = f(1:3,i) + fMPITemp(1:3,i)
662      end do
663  
664  
665      
666      if (do_pot) then
667   ! scatter/gather pot_row into the members of my column
668 <       call scatter(e_row,e_tmp,plan_row)
668 >       call scatter(eRow,eTemp,plan_row)
669        
670         ! scatter/gather pot_local into all other procs
671         ! add resultant to get total pot
672         do i = 1, nlocal
673 <          pot_local = pot_local + e_tmp(i)
673 >          pe_local = pe_local + eTemp(i)
674         enddo
675         if (newtons_thrd) then
676 <          e_tmp = 0.0E0_DP
677 <          call scatter(e_col,e_tmp,plan_col)
676 >          eTemp = 0.0E0_DP
677 >          call scatter(eCol,eTemp,plan_col)
678            do i = 1, nlocal
679 <             pot_local = pot_local + e_tmp(i)
679 >             pe_local = pe_local + eTemp(i)
680            enddo
681         endif
682      endif
683 +    potE = pe_local
684   #endif
685  
686 +    potE = pe
687  
688 +  
689  
690  
691    end subroutine do_lj_ff
# Line 790 | Line 703 | contains
703   !! Second Derivative, optional, used mainly for normal mode calculations.
704      real( kind = dp ), intent(out), optional :: d2
705      
706 <    type (lj_atype), intent(in), pointer :: atype1
707 <    type (lj_atype), intent(in), pointer :: atype2
706 >    type (lj_atype), pointer :: atype1
707 >    type (lj_atype), pointer :: atype2
708  
709      integer, intent(out), optional :: status
710  
# Line 799 | Line 712 | contains
712      real( kind = dp ) :: sigma
713      real( kind = dp ) :: sigma2
714      real( kind = dp ) :: sigma6
715 <    real( kind = dp ) :: epslon
715 >    real( kind = dp ) :: epsilon
716  
717      real( kind = dp ) :: rcut
718      real( kind = dp ) :: rcut2
# Line 824 | Line 737 | contains
737      if (present(status)) status = 0
738  
739   ! Look up the correct parameters in the mixing matrix
740 <    sigma   = ljMixed(atype1%atype_ident,atype2_atype_ident)%sigma
741 <    sigma2  = ljMixed(atype1%atype_ident,atype2_atype_ident)%sigma2
742 <    sigma6  = ljMixed(atype1%atype_ident,atype2_atype_ident)%sigma6
743 <    epslon  = ljMixed(atype1%atype_ident,atype2_atype_ident)%epslon
740 >    sigma    = ljMixed(atype1%atype_ident,atype2%atype_ident)%sigma
741 >    sigma2   = ljMixed(atype1%atype_ident,atype2%atype_ident)%sigma2
742 >    sigma6   = ljMixed(atype1%atype_ident,atype2%atype_ident)%sigma6
743 >    epsilon  = ljMixed(atype1%atype_ident,atype2%atype_ident)%epsilon
744  
745  
746 <
746 >    
747 >
748      call getRcut(rcut,rcut2=rcut2,rcut6=rcut6,status=errorStat)
749      
750      r2 = r * r
# Line 847 | Line 761 | contains
761      delta = -4.0E0_DP*epsilon * (tp12 - tp6)
762                                                                                
763      if (r.le.rcut) then
764 <       u = 4.0E0_DP * epsilon * (t12 - t6) + delta
764 >       pot = 4.0E0_DP * epsilon * (t12 - t6) + delta
765         dudr = 24.0E0_DP * epsilon * (t6 - 2.0E0_DP*t12) / r
766         if(doSec)  d2 = 24.0E0_DP * epsilon * (26.0E0_DP*t12 - 7.0E0_DP*t6)/r/r
767      else
768 <       u = 0.0E0_DP
768 >       pot = 0.0E0_DP
769         dudr = 0.0E0_DP
770         if(doSec) d2 = 0.0E0_DP
771      endif
# Line 880 | Line 794 | contains
794  
795      case ("sigma")
796         myMixParam = 0.5_dp * (param1 + param2)
797 <    case ("epslon")
797 >    case ("epsilon")
798         myMixParam = sqrt(param1 * param2)
799      case default
800         status = -1

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines