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 235 by mmeineke, Fri Jan 10 21:56:10 2003 UTC vs.
Revision 252 by chuckv, Tue Jan 28 22:16:55 2003 UTC

# Line 1 | Line 1
1 + !! Calculates Long Range forces Lennard-Jones interactions.
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.12 2003-01-28 22:16:55 chuckv Exp $, $Date: 2003-01-28 22:16:55 $, $Name: not supported by cvs2svn $, $Revision: 1.12 $
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 10 | 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  
16  type, public :: lj_atype
17     private
18     sequence
19 !! Unique number for place in linked list
20     integer :: atype_number = 0
21 !! Unique indentifier number (ie atomic no, etc)
22     integer :: atype_ident = 0
23 !! Mass of Particle
24     real ( kind = dp )  :: mass = 0.0_dp
25 !! Lennard-Jones epslon
26     real ( kind = dp )  :: epslon = 0.0_dp
27 !! Lennard-Jones Sigma
28     real ( kind = dp )  :: sigma = 0.0_dp
29 !! Lennard-Jones Sigma Squared
30     real ( kind = dp )  :: sigma2 = 0.0_dp
31 !! Lennard-Jones Sigma to sixth
32     real ( kind = dp )  :: sigma6 = 0.0_dp
33 !! Pointer for linked list creation
34     type (lj_atype), pointer :: next => null()
35  end type lj_atype
26  
37 !! Pointer type for atype ident array
38  type, public :: lj_atypePtr
39     type (lj_atype), pointer :: this => null()
40  end type lj_atypePtr
41
42 !! Global list of lj atypes in simulation
43  type (lj_atype), pointer :: lj_atype_list => null()
27   !! LJ mixing array  
28 <  type (lj_atype), dimension(:,:), allocatable, pointer :: ljMixed =>null()
46 < !! identity pointer list for force loop.
47 <  type (lj_atypePtr), dimension(:), allocatable :: identPtrList
28 >  type (lj_atype), dimension(:,:), pointer :: ljMixed => null()
29  
30  
31   !! Neighbor list and commom arrays
32 + !! This should eventally get moved to a neighbor list type
33    integer, allocatable, dimension(:) :: point
34    integer, allocatable, dimension(:) :: list
35 +  integer, parameter :: listMultiplier = 80
36 +  integer :: nListAllocs = 0
37 +  integer, parameter :: maxListAllocs = 5
38  
54 #ifdef IS_MPI
55 ! Universal routines: All types of force calculations will need these arrays
56 ! Arrays specific to a type of force calculation should be declared in that module.
57  real( kind = dp ), allocatable, dimension(:,:) :: qRow
58  real( kind = dp ), allocatable, dimension(:,:) :: qColumn
39  
40 <  real( kind = dp ), allocatable, dimension(:,:) :: fRow
41 <  real( kind = dp ), allocatable, dimension(:,:) :: fColumn
40 > !! Atype identity pointer lists
41 > #ifdef IS_MPI
42 > !! Row lj_atype pointer list
43 >  type (lj_atypePtr), dimension(:), pointer :: identPtrListRow => null()
44 > !! Column lj_atype pointer list
45 >  type (lj_atypePtr), dimension(:), pointer :: identPtrListColumn => null()
46 > #else
47 >  type( lj_identPtrList ), dimension(:), pointer :: identPtrList => null()
48   #endif
49  
50  
51 + !! Logical has lj force field module been initialized?
52 +  logical, save :: isljFFinit = .false.
53  
54  
67
68
55   !! Public methods and data
56    public :: new_lj_atype
57    public :: do_lj_ff
58    public :: getLjPot
59 <  
59 >  public :: init_ljFF
60  
61    
62  
63  
64   contains
65  
66 <  subroutine new_lj_atype(ident,mass,epslon,sigma,status)
66 > !! Adds a new lj_atype to the list.
67 >  subroutine new_lj_atype(ident,mass,epsilon,sigma,status)
68      real( kind = dp ), intent(in) :: mass
69 <    real( kind = dp ), intent(in) :: epslon
69 >    real( kind = dp ), intent(in) :: epsilon
70      real( kind = dp ), intent(in) :: sigma
71      integer, intent(in) :: ident
72      integer, intent(out) :: status
73  
74 <    type (lj_atype), pointer :: this_lj_atype
88 <    type (lj_atype), pointer :: lj_atype_ptr
89 <
90 <    type (lj_atype), allocatable, dimension(:,:), pointer :: thisMix
91 <    type (lj_atype), allocatable, dimension(:,:), pointer :: oldMix
74 >    type (lj_atype), pointer :: newLJ_atype
75      integer :: alloc_error
76      integer :: atype_counter = 0
77      integer :: alloc_size
78 <
78 >    integer :: err_stat
79      status = 0
80  
81  
82  
83   ! allocate a new atype    
84 <    allocate(this_lj_atype,stat=alloc_error)
84 >    allocate(newLJ_atype,stat=alloc_error)
85      if (alloc_error /= 0 ) then
86         status = -1
87         return
88      end if
89  
90   ! assign our new lj_atype information
91 <    this_lj_atype%mass       = mass
92 <    this_lj_atype%epslon     = epslon
93 <    this_lj_atype%sigma      = sigma
94 <    this_lj_atype%sigma2     = sigma * sigma
95 <    this_lj_atype%sigma6     = this_lj_atype%sigma2 * this_lj_atype%sigma2 &
96 <         * this_lj_atype%sigma2
91 >    newLJ_atype%mass        = mass
92 >    newLJ_atype%epsilon     = epsilon
93 >    newLJ_atype%sigma       = sigma
94 >    newLJ_atype%sigma2      = sigma * sigma
95 >    newLJ_atype%sigma6      = newLJ_atype%sigma2 * newLJ_atype%sigma2 &
96 >         * newLJ_atype%sigma2
97   ! assume that this atype will be successfully added
98 <    this_lj_atype%atype_ident = ident
99 <    this_lj_atype%number = n_lj_atypes + 1
98 >    newLJ_atype%atype_ident = ident
99 >    newLJ_atype%atype_number = n_lj_atypes + 1
100  
101 <
102 < ! First time through allocate a array of size ljMixed_blocksize
103 <    if(.not. associated(ljMixed)) then
104 <       allocate(thisMix(ljMixed_blocksize,ljMixed_blocksize))
122 <       if (alloc_error /= 0 ) then
123 <          status = -1
124 <          return
125 <       end if
126 <       ljMixed => thisMix
127 < ! If we have outgrown ljMixed_blocksize, allocate a new matrix twice the size and
128 < ! point ljMix at the new matrix.
129 <    else if( (n_lj_atypes + 1) > size(ljMixed)) then
130 <       alloc_size = 2*size(ljMix)
131 <       allocate(thisMix(alloc_size,alloc_size))
132 <       if (alloc_error /= 0 ) then
133 <          status = -1
134 <          return
135 <       end if
136 < ! point oldMix at old ljMixed array
137 <       oldMix => ljMixed
138 < ! Copy oldMix into new Mixed array      
139 <       thisMix = oldMix
140 < ! Point ljMixed at new array
141 <       ljMixed => thisMix
142 < ! Free old array so we don't have a memory leak
143 <       deallocate(oldMix)
101 >    call add_atype(newLJ_atype,ljListHead,ljListTail,err_stat)
102 >    if (err_stat /= 0 ) then
103 >       status = -1
104 >       return
105      endif
106  
107 +    n_lj_atypes = n_lj_atypes + 1
108  
109  
110 +  end subroutine new_lj_atype
111  
112  
113 < ! Find bottom of atype master list
114 < ! if lj_atype_list is null then we are at the top of the list.
115 <    if (.not. associated(lj_atype_list)) then
116 <       lj_atype_ptr => this_lj_atype
117 <       atype_counter = 1
113 >  subroutine init_ljFF(nComponents,ident, status)
114 > !! Number of components in ident array
115 >    integer, intent(inout) :: nComponents
116 > !! Array of identities nComponents long corresponding to
117 > !! ljatype ident.
118 >    integer, dimension(nComponents),intent(inout) :: ident
119 > !!  Result status, success = 0, error = -1
120 >    integer, intent(out) :: Status
121  
122 <    else ! we need to find the bottom of the list to insert new atype
157 <       lj_atype_ptr => lj_atype_list%next
158 <       atype_counter = 1
159 <       find_end: do
160 <          if (.not. associated(lj_atype_ptr%next)) then
161 <             exit find_end
162 <          end if
163 < ! Set up mixing for new atype and current atype in list
164 <       ljMix(this_lj_atype%atype_number,lj_atype_ptr%atype_number)%sigma  =  &
165 <            calcLJMix("sigma",this_lj_atype%sigma, &
166 <            lj_atype_prt%sigma)
122 >    integer :: alloc_stat
123  
124 <       ljMix(this_lj_atype%atype_number,lj_atype_ptr%atype_number)%sigma2  = &
125 <            ljMix(this_lj_atype%atype_number,lj_atype_ptr%atype_number)%sigma &
126 <            * ljMix(this_lj_atype%atype_number,lj_atype_ptr%atype_number)%sigma
124 >    integer :: thisStat
125 >    integer :: i
126 > #ifdef IS_MPI
127 >    integer, allocatable, dimension(:) :: identRow
128 >    integer, allocatable, dimension(:) :: identCol
129 >    integer :: nrow
130 >    integer :: ncol
131 >    integer :: alloc_stat
132 > #endif
133 >    status = 0
134 > !! if were're not in MPI, we just update ljatypePtrList
135 > #ifndef IS_MPI
136 >    call create_IdentPtrlst(ident,ljListHead,identPtrList,thisStat)
137 >    if ( thisStat /= 0 ) then
138 >       status = -1
139 >       return
140 >    endif
141  
142 <       ljMix(this_lj_atype%atype_number,lj_atype_ptr%atype_number)%sigma6 = &
143 <            ljMix(this_lj_atype%atype_number,lj_atype_ptr%atype_number)%sigma2 &
144 <            * ljMix(this_lj_atype%atype_number,lj_atype_ptr%atype_number)%sigma2 &
145 <            * ljMix(this_lj_atype%atype_number,lj_atype_ptr%atype_number)%sigma2
142 > !! Allocate pointer lists
143 >    allocate(point(nComponents),stat=alloc_stat)
144 >    if (alloc_stat /=0) then
145 >       status = -1
146 >       return
147 >    endif
148  
149 <       ljMix(this_lj_atype%atype_number,lj_atype_ptr%atype_number)%epslon = &
150 <            calcLJMix("epslon",this_lj_atype%epslon, &
151 <            lj_atype_prt%epslon)
152 <
153 < ! Advance to next pointer
182 <       lj_atype_ptr => lj_atype_ptr%next
183 <       atype_counter = atype_counter + 1
184 <          
185 <       end do find_end
186 <    end if
187 <
188 <
189 <
149 >    allocate(list(nComponents*listMultiplier),stat=alloc_stat)
150 >    if (alloc_stat /=0) then
151 >       status = -1
152 >       return
153 >    endif
154      
155 < ! Insert new atype at end of list
156 <    lj_atype_ptr => this_lj_atype
157 < ! Increment number of atypes
155 > ! if were're in MPI, we also have to worry about row and col lists    
156 > #else
157 > ! We can only set up forces if mpiSimulation has been setup.
158 >    if (.not. isMPISimSet()) then
159 >       status = -1
160 >       return
161 >    endif
162 >    nrow = getNrow()
163 >    ncol = getNcol()
164 > !! Allocate temperary arrays to hold gather information
165 >    allocate(identRow(nrow),stat=alloc_stat)
166 >    if (alloc_stat /= 0 ) then
167 >       status = -1
168 >       return
169 >    endif
170  
171 <    n_lj_atypes = n_lj_atypes + 1
171 >    allocate(identCol(ncol),stat=alloc_stat)
172 >    if (alloc_stat /= 0 ) then
173 >       status = -1
174 >       return
175 >    endif
176 > !! Gather idents into row and column idents
177 >    call gather(ident,identRow,plan_row)
178 >    call gather(ident,identCol,plan_col)
179  
180 < ! Set up self mixing
180 > !! Create row and col pointer lists
181 >    call create_IdentPtrlst(identRow,ljListTail,identPtrListRow,thisStat)
182 >    if (thisStat /= 0 ) then
183 >       status = -1
184 >       return
185 >    endif
186  
187 <    ljMix(n_lj_atypes,n_lj_atypes)%sigma  = this_lj_atype%sigma
187 >    call create_IdentPtrlst(identCol,ljListTail,identPtrListCol,thisStat)
188 >    if (thisStat /= 0 ) then
189 >       status = -1
190 >       return
191 >    endif
192  
193 <    ljMix(n_lj_atypes,n_lj_atypes)%sigma2  = ljMix(n_lj_atypes,n_lj_atypes)%sigma &
194 <            * ljMix(n_lj_atypes,n_lj_atypes)%sigma
193 > !! free temporary ident arrays
194 >    deallocate(identCol)
195 >    deallocate(identRow)
196  
204    ljMix(n_lj_atypes,n_lj_atypes)%sigma6 = ljMix(n_lj_atypes,n_lj_atypes)%sigma2 &
205            * ljMix(n_lj_atypes,n_lj_atypes)%sigma2 &
206            * ljMix(n_lj_atypes,n_lj_atypes)%sigma2
197  
198 <    ljMix(n_lj_atypes,n_lj_atypes)%epslon = this_lj_atype%epslon
198 > !! Allocate neighbor lists for mpi simulations.
199 >    if (.not. allocated(point)) then
200 >       allocate(point(nrow),stat=alloc_stat)
201 >       if (alloc_stat /=0) then
202 >          status = -1
203 >          return
204 >       endif
205  
206 +       allocate(list(ncol*listMultiplier),stat=alloc_stat)
207 +       if (alloc_stat /=0) then
208 +          status = -1
209 +          return
210 +       endif
211 +    else
212 +       deallocate(list)
213 +       deallocate(point)
214 +       allocate(point(nrow),stat=alloc_stat)
215 +       if (alloc_stat /=0) then
216 +          status = -1
217 +          return
218 +       endif
219  
220 <  end subroutine new_lj_atype
220 >       allocate(list(ncol*listMultiplier),stat=alloc_stat)
221 >       if (alloc_stat /=0) then
222 >          status = -1
223 >          return
224 >       endif
225 >    endif
226  
227 + #endif
228 +    
229 +    call createMixingList(thisStat)
230 +    if (thisStat /= 0) then
231 +       status = -1
232 +       return
233 +    endif
234 +    isljFFinit = .true.
235  
236 <  subroutine init_ljFF()
236 >  end subroutine init_ljFF
237  
238  
217 #ifdef IS_MPI
239  
219    
240  
221 #endif
241  
223  end subroutine init_ljFF
242  
243 < !! Takes an ident array and creates an atype pointer list
244 < !! based on those identities
245 <  subroutine new_ljatypePtrList(mysize,ident,PtrList,status)
228 <    integer, intent(in) :: mysize
229 <    integer, intent(in) :: ident
230 <    integer, optional :: status
231 <    type(lj_atypePtr), dimension(:) :: PtrList
232 <
233 <    integer :: thisIdent
243 >  subroutine createMixingList(status)
244 >    integer :: listSize
245 >    integer :: status
246      integer :: i
247 <    integer :: alloc_error
236 <    type (lj_atype), pointer :: tmpPtr
247 >    integer :: j
248  
249 <    if (present(status)) status = 0
249 >    integer :: outerCounter = 0
250 >    integer :: innerCounter = 0
251 >    type (lj_atype), pointer :: tmpPtrOuter => null()
252 >    type (lj_atype), pointer :: tmpPtrInner => null()
253 >    status = 0
254  
255 < ! First time through, allocate list
256 <    if (.not.(allocated)) then
257 <       allocate(PtrList(mysize))
258 <    else
259 < ! We want to creat a new ident list so free old list
260 <       deallocate(PrtList)
246 <       allocate(PtrList(mysize))
247 <    endif
255 >    listSize = getListLen(ljListHead)
256 >    if (listSize == 0) then
257 >       status = -1
258 >       return
259 >    end if
260 >  
261  
262 < ! Match pointer list
263 <    do i = 1, mysize
264 <       thisIdent = ident(i)
265 <       call getLJatype(thisIdent,tmpPtr)
266 <
267 <      if (.not. associated(tmpPtr)) then
268 <          status = -1
269 <          return
262 >    if (.not. associated(ljMixed)) then
263 >       allocate(ljMixed(listSize,listSize))
264 >    else
265 >       status = -1
266 >       return
267 >    end if
268 >
269 >    
270 >
271 >    tmpPtrOuter => ljListHead
272 >    tmpPtrInner => tmpPtrOuter%next
273 >    do while (associated(tmpPtrOuter))
274 >       outerCounter = outerCounter + 1
275 > ! do self mixing rule
276 >       ljMixed(outerCounter,outerCounter)%sigma  = tmpPtrOuter%sigma
277 >                                                                                                  
278 >       ljMixed(outerCounter,outerCounter)%sigma2  = ljMixed(outerCounter,outerCounter)%sigma &
279 >            * ljMixed(outerCounter,outerCounter)%sigma
280 >                                                                                                  
281 >       ljMixed(outerCounter,outerCounter)%sigma6 = ljMixed(outerCounter,outerCounter)%sigma2 &
282 >            * ljMixed(outerCounter,outerCounter)%sigma2 &
283 >            * ljMixed(outerCounter,outerCounter)%sigma2
284 >                                                                                                  
285 >       ljMixed(outerCounter,outerCounter)%epsilon = tmpPtrOuter%epsilon
286 >
287 >       innerCounter = outerCounter + 1
288 >       do while (associated(tmpPtrInner))
289 >          
290 >          ljMixed(outerCounter,innerCounter)%sigma  =  &
291 >               calcLJMix("sigma",tmpPtrOuter%sigma, &
292 >               tmpPtrInner%sigma)
293 >          
294 >          ljMixed(outerCounter,innerCounter)%sigma2  = &
295 >               ljMixed(outerCounter,innerCounter)%sigma &
296 >               * ljMixed(outerCounter,innerCounter)%sigma
297 >          
298 >          ljMixed(outerCounter,innerCounter)%sigma6 = &
299 >               ljMixed(outerCounter,innerCounter)%sigma2 &
300 >               * ljMixed(outerCounter,innerCounter)%sigma2 &
301 >               * ljMixed(outerCounter,innerCounter)%sigma2
302 >          
303 >          ljMixed(outerCounter,innerCounter)%epsilon = &
304 >               calcLJMix("epsilon",tmpPtrOuter%epsilon, &
305 >               tmpPtrInner%epsilon)
306 >          ljMixed(innerCounter,outerCounter)%sigma = ljMixed(outerCounter,innerCounter)%sigma
307 >          ljMixed(innerCounter,outerCounter)%sigma2 = ljMixed(outerCounter,innerCounter)%sigma2
308 >          ljMixed(innerCounter,outerCounter)%sigma6 = ljMixed(outerCounter,innerCounter)%sigma6
309 >          ljMixed(innerCounter,outerCounter)%epsilon = ljMixed(outerCounter,innerCounter)%epsilon
310 >
311 >
312 >          tmpPtrInner => tmpPtrInner%next
313 >          innerCounter = innerCounter + 1
314 >       end do
315 > ! advance pointers
316 >       tmpPtrOuter => tmpPtrOuter%next
317 >       if (associated(tmpPtrOuter)) then
318 >          tmpPtrInner => tmpPtrOuter%next
319         endif
320        
259       PtrList(i)%this => tmpPtr
321      end do
322  
323 <  end subroutine new_ljatypePtrList
323 >  end subroutine createMixingList
324  
264 !! Finds a lj_atype based upon numerical ident
265 !! returns a null pointer if error
266  subroutine getLJatype(ident,ljAtypePtr)
267    integer, intent(in) :: ident
268    type (lj_atype), intent(out),pointer :: ljAtypePtr => null()
269    
270    type (lj_atype), pointer :: tmplj_atype_ptr => null()
325  
272    if(.not. associated(lj_atype_list)) return
326  
274 ! Point at head of list.
275    tmplj_atype_ptr => lj_atype_list
276    find_ident: do
277       if (.not.associated(tmplj_atype_ptr)) then
278          exit find_ident
279       else if( lj_atype_ptr%atype_ident == ident)
280          ljAtypePtr => tmplj_atype_ptr
281          exit find_ident
282       endif
283       tmplj_atype_ptr => tmplj_atype_ptr%next
284    end do find_ident
327  
286  end subroutine getLJatype
328  
329  
330 < ! FORCE routine
330 >
331 >
332 > !! FORCE routine Calculates Lennard Jones forces.
333   !------------------------------------------------------------->
334    subroutine do_lj_ff(q,f,potE,do_pot)
335 <    real ( kind = dp ), dimension(ndim,) :: q
336 <    real ( kind = dp ), dimension(ndim,nLRparticles) :: f
335 > !! Position array provided by C, dimensioned by getNlocal
336 >    real ( kind = dp ), dimension(3,getNlocal()) :: q
337 > !! Force array provided by C, dimensioned by getNlocal
338 >    real ( kind = dp ), dimension(3,getNlocal()) :: f
339      real ( kind = dp ) :: potE
340      logical ( kind = 2) :: do_pot
341 +    
342 +    type(lj_atype), pointer :: ljAtype_i
343 +    type(lj_atype), pointer :: ljAtype_j
344 +
345   #ifdef MPI
346 <  real( kind = DP ), dimension(3,ncol) :: efr
346 >  real( kind = DP ), dimension(3,getNcol()) :: efr
347    real( kind = DP ) :: pot_local
348   #else
349 < !  real( kind = DP ), dimension(3,natoms) :: efr
349 >  real( kind = DP ), dimension(3,getNlocal()) :: efr
350   #endif
351    
352 + !! Local arrays needed for MPI
353 + #ifdef IS_MPI
354 +  real(kind = dp), dimension(3:getNrow()) :: qRow
355 +  real(kind = dp), dimension(3:getNcol()) :: qCol
356 +
357 +  real(kind = dp), dimension(3:getNrow()) :: fRow
358 +  real(kind = dp), dimension(3:getNcol()) :: fCol
359 +
360 +  real(kind = dp), dimension(getNrow()) :: eRow
361 +  real(kind = dp), dimension(getNcol()) :: eCol
362 +
363 +  real(kind = dp), dimension(getNlocal()) :: eTemp
364 + #endif
365 +
366 +
367 +
368    real( kind = DP )   :: pe
369 <  logical,            :: update_nlist
369 >  logical             :: update_nlist
370  
371  
372    integer ::  i, j, jbeg, jend, jnab, idim, jdim, idim2, jdim2, dim, dim2
# Line 310 | Line 375 | contains
375    integer :: tag_i,tag_j
376    real( kind = DP ) ::  r, pot, ftmp, dudr, d2, drdx1, kt1, kt2, kt3, ktmp
377    real( kind = DP ) ::  rxi, ryi, rzi, rxij, ryij, rzij, rijsq
378 +  real( kind = DP ) ::  rlistsq, rcutsq,rlist,rcut
379  
380 + ! a rig that need to be fixed.
381 + #ifdef IS_MPI
382 +  logical :: newtons_thrd = .true.
383 +  real( kind = dp ) :: pe_local
384 +  integer :: nlocal
385 + #endif
386    integer :: nrow
387    integer :: ncol
388 +  integer :: natoms
389  
390 + ! Make sure we are properly initialized.
391 +  if (.not. isljFFInit) then
392 +     write(default_error,*) "ERROR: lj_FF has not been properly initialized"
393 +     return
394 +  endif
395 + #ifdef IS_MPI
396 +    if (.not. isMPISimSet()) then
397 +     write(default_error,*) "ERROR: mpiSimulation has not been properly initialized"
398 +     return
399 +  endif
400 + #endif
401  
402 <
402 > !! initialize local variables  
403 >  natoms = getNlocal()
404 >  call getRcut(rcut,rcut2=rcutsq)
405 >  call getRlist(rlist,rlistsq)
406   #ifndef IS_MPI
407    nrow = natoms - 1
408    ncol = natoms
409   #else
410 +  nrow = getNrow(plan_row)
411 +  ncol = getNcol(plan_col)
412 +  nlocal = natoms
413    j_start = 1
414   #endif
415  
416 <  call check(update_nlist)
416 >  
417 > !! See if we need to update neighbor lists
418 >  call check(q,update_nlist)
419  
420 + !--------------WARNING...........................
421 + ! Zero variables, NOTE:::: Forces are zeroed in C
422 + ! Zeroing them here could delete previously computed
423 + ! Forces.
424 + !------------------------------------------------
425   #ifndef IS_MPI
426 <  nloops = nloops + 1
427 <  pot = 0.0E0_DP
428 <  f = 0.0E0_DP
332 <  e = 0.0E0_DP
426 > !  nloops = nloops + 1
427 >  pe = 0.0E0_DP
428 >
429   #else
430      f_row = 0.0E0_DP
431      f_col = 0.0E0_DP
432  
433 <    pot_local = 0.0E0_DP
433 >    pe_local = 0.0E0_DP
434  
435 <    e_row = 0.0E0_DP
436 <    e_col = 0.0E0_DP
437 <    e_tmp = 0.0E0_DP
435 >    eRow = 0.0E0_DP
436 >    eCol = 0.0E0_DP
437 >    eTemp = 0.0E0_DP
438   #endif
439      efr = 0.0E0_DP
440  
441   ! communicate MPI positions
442   #ifdef MPI    
443 <    call gather(q,q_row,plan_row3)
444 <    call gather(q,q_col,plan_col3)
443 >    call gather(q,qRow,plan_row3)
444 >    call gather(q,qCol,plan_col3)
445   #endif
446  
351 #ifndef MPI
447  
353 #endif
354
448    if (update_nlist) then
449  
450       ! save current configuration, contruct neighbor list,
451       ! and calculate forces
452 <     call save_nlist()
452 >     call save_nlist(q)
453      
454       nlist = 0
455      
# Line 365 | Line 458 | contains
458       do i = 1, nrow
459          point(i) = nlist + 1
460   #ifdef MPI
461 <        tag_i = tag_row(i)
462 <        rxi = q_row(1,i)
463 <        ryi = q_row(2,i)
464 <        rzi = q_row(3,i)
461 >        ljAtype_i => identPtrListRow(i)%this
462 >        tag_i = tagRow(i)
463 >        rxi = qRow(1,i)
464 >        ryi = qRow(2,i)
465 >        rzi = qRow(3,i)
466   #else
467 +        ljAtype_i   => identPtrList(i)%this
468          j_start = i + 1
469          rxi = q(1,i)
470          ryi = q(2,i)
# Line 378 | Line 473 | contains
473  
474          inner: do j = j_start, ncol
475   #ifdef MPI
476 <           tag_j = tag_col(j)
476 > ! Assign identity pointers and tags
477 >           ljAtype_j => identPtrListColumn(j)%this
478 >           tag_j = tagCol(j)
479             if (newtons_thrd) then
480                if (tag_i <= tag_j) then
481                   if (mod(tag_i + tag_j,2) == 0) cycle inner
# Line 387 | Line 484 | contains
484                endif
485             endif
486  
487 <           rxij = wrap(rxi - q_col(1,j), 1)
488 <           ryij = wrap(ryi - q_col(2,j), 2)
489 <           rzij = wrap(rzi - q_col(3,j), 3)
487 >           rxij = wrap(rxi - qCol(1,j), 1)
488 >           ryij = wrap(ryi - qCol(2,j), 2)
489 >           rzij = wrap(rzi - qCol(3,j), 3)
490   #else          
491 <        
491 >           ljAtype_j   => identPtrList(j)%this
492             rxij = wrap(rxi - q(1,j), 1)
493             ryij = wrap(ryi - q(2,j), 2)
494             rzij = wrap(rzi - q(3,j), 3)
# Line 400 | Line 497 | contains
497             rijsq = rxij*rxij + ryij*ryij + rzij*rzij
498  
499   #ifdef MPI
500 <             if (rijsq <=  rlstsq .AND. &
500 >             if (rijsq <=  rlistsq .AND. &
501                    tag_j /= tag_i) then
502   #else
503 <             if (rijsq <  rlstsq) then
503 >             if (rijsq <  rlistsq) then
504   #endif
505              
506                nlist = nlist + 1
507                if (nlist > size(list)) then
508 <                 call info("FORCE_LJ","error size list smaller then nlist")
509 <                 write(msg,*) "nlist size(list)", nlist, size(list)
413 <                 call info("FORCE_LJ",msg)
414 < #ifdef MPI
415 <                 call mpi_abort(MPI_COMM_WORLD,mpi_err)
416 < #endif
417 <                 stop
508 > !!  "Change how nlist size is done"
509 >                 write(DEFAULT_ERROR,*) "ERROR: nlist > list size"
510                endif
511                list(nlist) = j
512  
# Line 423 | Line 515 | contains
515                  
516                   r = dsqrt(rijsq)
517        
518 <                 call LJ_mix(r,pot,dudr,d2,i,j)
518 >                 call getLJPot(r,pot,dudr,ljAtype_i,ljAtype_j)
519        
520   #ifdef MPI
521 <                e_row(i) = e_row(i) + pot*0.5
522 <                e_col(i) = e_col(i) + pot*0.5
521 >                eRow(i) = eRow(i) + pot*0.5
522 >                eCol(i) = eCol(i) + pot*0.5
523   #else
524                  pe = pe + pot
525   #endif                
# Line 444 | Line 536 | contains
536  
537  
538   #ifdef MPI
539 <                    f_col(dim,j) = f_col(dim,j) - ftmp
540 <                    f_row(dim,i) = f_row(dim,i) + ftmp
539 >                    fCol(dim,j) = fCol(dim,j) - ftmp
540 >                    fRow(dim,i) = fRow(dim,i) + ftmp
541   #else                    
542              
543                      f(dim,j) = f(dim,j) - ftmp
# Line 473 | Line 565 | contains
565          ! check thiat molecule i has neighbors
566          if (jbeg .le. jend) then
567   #ifdef MPI
568 <           rxi = q_row(1,i)
569 <           ryi = q_row(2,i)
570 <           rzi = q_row(3,i)
568 >           ljAtype_i => identPtrListRow(i)%this
569 >           rxi = qRow(1,i)
570 >           ryi = qRow(2,i)
571 >           rzi = qRow(3,i)
572   #else
573 +           ljAtype_i   => identPtrList(i)%this
574             rxi = q(1,i)
575             ryi = q(2,i)
576             rzi = q(3,i)
# Line 484 | Line 578 | contains
578             do jnab = jbeg, jend
579                j = list(jnab)
580   #ifdef MPI
581 <                rxij = wrap(rxi - q_col(1,j), 1)
582 <                ryij = wrap(ryi - q_col(2,j), 2)
583 <                rzij = wrap(rzi - q_col(3,j), 3)
581 >              ljAtype_j = identPtrListColumn(j)%this
582 >              rxij = wrap(rxi - q_col(1,j), 1)
583 >              ryij = wrap(ryi - q_col(2,j), 2)
584 >              rzij = wrap(rzi - q_col(3,j), 3)
585   #else
586 <                rxij = wrap(rxi - q(1,j), 1)
587 <                ryij = wrap(ryi - q(2,j), 2)
588 <                rzij = wrap(rzi - q(3,j), 3)
586 >              ljAtype_j = identPtrList(j)%this
587 >              rxij = wrap(rxi - q(1,j), 1)
588 >              ryij = wrap(ryi - q(2,j), 2)
589 >              rzij = wrap(rzi - q(3,j), 3)
590   #endif
591                rijsq = rxij*rxij + ryij*ryij + rzij*rzij
592                
# Line 498 | Line 594 | contains
594  
595                   r = dsqrt(rijsq)
596                  
597 <                 call LJ_mix(r,pot,dudr,d2,i,j)
597 >                 call getLJPot(r,pot,dudr,ljAtype_i,ljAtype_j)
598   #ifdef MPI
599 <                e_row(i) = e_row(i) + pot*0.5
600 <                e_col(i) = e_col(i) + pot*0.5
599 >                eRow(i) = eRow(i) + pot*0.5
600 >                eCol(i) = eCol(i) + pot*0.5
601   #else
602 <               if (do_pot)  pe = pe + pot
602 >                pe = pe + pot
603   #endif                
604  
605                  
# Line 516 | Line 612 | contains
612                      drdx1 = efr(dim,j) / r
613                      ftmp = dudr * drdx1
614   #ifdef MPI
615 <                    f_col(dim,j) = f_col(dim,j) - ftmp
616 <                    f_row(dim,i) = f_row(dim,i) + ftmp
615 >                    fCol(dim,j) = fCol(dim,j) - ftmp
616 >                    fRow(dim,i) = fRow(dim,i) + ftmp
617   #else                    
618                      f(dim,j) = f(dim,j) - ftmp
619                      f(dim,i) = f(dim,i) + ftmp
# Line 533 | Line 629 | contains
629  
630   #ifdef MPI
631      !!distribute forces
632 <    call scatter(f_row,f,plan_row3)
632 >    call scatter(fRow,f,plan_row3)
633  
634 <    call scatter(f_col,f_tmp,plan_col3)
634 >    call scatter(fCol,f_tmp,plan_col3)
635 >
636      do i = 1,nlocal
637 <       do dim = 1,3
541 <          f(dim,i) = f(dim,i) + f_tmp(dim,i)
542 <       end do
637 >       f(1:3,i) = f(1:3,i) + f_tmp(1:3,i)
638      end do
639  
640  
# Line 551 | Line 646 | contains
646         ! scatter/gather pot_local into all other procs
647         ! add resultant to get total pot
648         do i = 1, nlocal
649 <          pot_local = pot_local + e_tmp(i)
649 >          pe_local = pe_local + e_tmp(i)
650         enddo
651         if (newtons_thrd) then
652            e_tmp = 0.0E0_DP
653            call scatter(e_col,e_tmp,plan_col)
654            do i = 1, nlocal
655 <             pot_local = pot_local + e_tmp(i)
655 >             pe_local = pe_local + e_tmp(i)
656            enddo
657         endif
658      endif
659 +    potE = pe_local
660   #endif
661  
662 +    potE = pe
663  
664  
568
665    end subroutine do_lj_ff
666  
667 < !! Calculates the potential between two lj particles, optionally returns second
667 > !! Calculates the potential between two lj particles based on two lj_atype pointers, optionally returns second
668   !! derivatives.
669    subroutine getLjPot(r,pot,dudr,atype1,atype2,d2,status)
670   ! arguments
# Line 581 | Line 677 | contains
677   !! Second Derivative, optional, used mainly for normal mode calculations.
678      real( kind = dp ), intent(out), optional :: d2
679      
680 <    type (lj_atype), intent(in) :: atype1
681 <    type (lj_atype), intent(in) :: atype2
680 >    type (lj_atype), pointer :: atype1
681 >    type (lj_atype), pointer :: atype2
682  
683      integer, intent(out), optional :: status
684  
# Line 590 | Line 686 | contains
686      real( kind = dp ) :: sigma
687      real( kind = dp ) :: sigma2
688      real( kind = dp ) :: sigma6
689 <    real( kind = dp ) :: epslon
689 >    real( kind = dp ) :: epsilon
690  
691      real( kind = dp ) :: rcut
692      real( kind = dp ) :: rcut2
# Line 615 | Line 711 | contains
711      if (present(status)) status = 0
712  
713   ! Look up the correct parameters in the mixing matrix
714 <    sigma   = ljMixed(atype1%atype_ident,atype2_atype_ident)%sigma
715 <    sigma2  = ljMixed(atype1%atype_ident,atype2_atype_ident)%sigma2
716 <    sigma6  = ljMixed(atype1%atype_ident,atype2_atype_ident)%sigma6
717 <    epslon  = ljMixed(atype1%atype_ident,atype2_atype_ident)%epslon
714 >    sigma    = ljMixed(atype1%atype_ident,atype2%atype_ident)%sigma
715 >    sigma2   = ljMixed(atype1%atype_ident,atype2%atype_ident)%sigma2
716 >    sigma6   = ljMixed(atype1%atype_ident,atype2%atype_ident)%sigma6
717 >    epsilon  = ljMixed(atype1%atype_ident,atype2%atype_ident)%epsilon
718  
719  
720  
# Line 638 | Line 734 | contains
734      delta = -4.0E0_DP*epsilon * (tp12 - tp6)
735                                                                                
736      if (r.le.rcut) then
737 <       u = 4.0E0_DP * epsilon * (t12 - t6) + delta
737 >       pot = 4.0E0_DP * epsilon * (t12 - t6) + delta
738         dudr = 24.0E0_DP * epsilon * (t6 - 2.0E0_DP*t12) / r
739         if(doSec)  d2 = 24.0E0_DP * epsilon * (26.0E0_DP*t12 - 7.0E0_DP*t6)/r/r
740      else
741 <       u = 0.0E0_DP
741 >       pot = 0.0E0_DP
742         dudr = 0.0E0_DP
743         if(doSec) d2 = 0.0E0_DP
744      endif
# Line 654 | Line 750 | contains
750    end subroutine getLjPot
751  
752  
753 < !! Calculates the mixing for sigma or epslon based on character string
753 > !! Calculates the mixing for sigma or epslon based on character string for initialzition of mixing array.
754    function calcLJMix(thisParam,param1,param2,status) result(myMixParam)
755      character(len=*) :: thisParam
756      real(kind = dp)  :: param1
# Line 671 | Line 767 | contains
767  
768      case ("sigma")
769         myMixParam = 0.5_dp * (param1 + param2)
770 <    case ("epslon")
770 >    case ("epsilon")
771         myMixParam = sqrt(param1 * param2)
772      case default
773         status = -1

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines