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 230 by chuckv, Thu Jan 9 19:40:38 2003 UTC vs.
Revision 247 by chuckv, Mon Jan 27 18:28:11 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.11 2003-01-27 18:28:11 chuckv Exp $, $Date: 2003-01-27 18:28:11 $, $Name: not supported by cvs2svn $, $Revision: 1.11 $
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 !! Name of atype
22     character(len = 15) :: name = "NULL"
23 !! Unique indentifier number (ie atomic no, etc)
24     integer :: atype_ident = 0
25 !! Mass of Particle
26     real ( kind = dp )  :: mass = 0.0_dp
27 !! Lennard-Jones epslon
28     real ( kind = dp )  :: epslon = 0.0_dp
29 !! Lennard-Jones Sigma
30     real ( kind = dp )  :: sigma = 0.0_dp
31 !! Lennard-Jones Sigma Squared
32     real ( kind = dp )  :: sigma2 = 0.0_dp
33 !! Lennard-Jones Sigma to sixth
34     real ( kind = dp )  :: sigma6 = 0.0_dp
35 !! Pointer for linked list creation
36     type (lj_atype), pointer :: next => null()
37  end type lj_atype
26  
39 !! Pointer type for atype ident array
40  type :: lj_atypePtr
41     type (lj_atype), pointer :: this => null()
42  end type lj_atypePtr
43
44 !! Global list of lj atypes in simulation
45  type (lj_atype), pointer :: lj_atype_list => null()
27   !! LJ mixing array  
28 <  type (lj_atype), dimension(:,:), allocatable, pointer :: ljMixed =>null()
48 < !! identity pointer list for force loop.
49 <  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  
56 #ifdef IS_MPI
57 ! Universal routines: All types of force calculations will need these arrays
58 ! Arrays specific to a type of force calculation should be declared in that module.
59  real( kind = dp ), allocatable, dimension(:,:) :: qRow
60  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  
69
70
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(name,ident,mass,epslon,sigma,status)
67 <    character( len = 15 ) :: name
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
91 <    type (lj_atype), pointer :: lj_atype_ptr
92 <
93 <    type (lj_atype), allocatable, dimension(:,:), pointer :: thisMix
94 <    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%name       = name
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 &
117 <         * 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))
126 <       if (alloc_error /= 0 ) then
127 <          status = -1
128 <          return
129 <       end if
130 <       ljMixed => thisMix
131 < ! If we have outgrown ljMixed_blocksize, allocate a new matrix twice the size and
132 < ! point ljMix at the new matrix.
133 <    else if( (n_lj_atypes + 1) > size(ljMixed)) then
134 <       alloc_size = 2*size(ljMix)
135 <       allocate(thisMix(alloc_size,alloc_size))
136 <       if (alloc_error /= 0 ) then
137 <          status = -1
138 <          return
139 <       end if
140 < ! point oldMix at old ljMixed array
141 <       oldMix => ljMixed
142 < ! Copy oldMix into new Mixed array      
143 <       thisMix = oldMix
144 < ! Point ljMixed at new array
145 <       ljMixed => thisMix
146 < ! Free old array so we don't have a memory leak
147 <       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
161 <       lj_atype_ptr => lj_atype_list%next
162 <       atype_counter = 1
163 <       find_end: do
164 <          if (.not. associated(lj_atype_ptr%next)) then
165 <             exit find_end
166 <          end if
167 < ! Set up mixing for new atype and current atype in list
168 <       ljMix(this_lj_atype%atype_number,lj_atype_ptr%atype_number)%sigma  =  &
169 <            calcLJMix("sigma",this_lj_atype%sigma, &
170 <            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
186 <       lj_atype_ptr => lj_atype_ptr%next
187 <       atype_counter = atype_counter + 1
188 <          
189 <       end do find_end
190 <    end if
191 <
192 <
193 <
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  
208    ljMix(n_lj_atypes,n_lj_atypes)%sigma6 = ljMix(n_lj_atypes,n_lj_atypes)%sigma2 &
209            * ljMix(n_lj_atypes,n_lj_atypes)%sigma2 &
210            * 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  
221 #ifdef IS_MPI
239  
223    
240  
225 #endif
241  
227  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)
232 <    integer, intent(in) :: mysize
233 <    integer, intent(in) :: ident
234 <    integer, optional :: status
235 <    type(lj_atypePtr), dimension(:) :: PtrList
236 <
237 <    integer :: thisIdent
243 >  subroutine createMixingList(status)
244 >    integer :: listSize
245 >    integer :: status
246      integer :: i
247 <    integer :: alloc_error
240 <    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)
250 <       allocate(PtrList(mysize))
251 <    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 >    write(*,*) "Creating mixing list"
271 >    tmpPtrOuter => ljListHead
272 >    tmpPtrInner => tmpPtrOuter%next
273 >    do while (associated(tmpPtrOuter))
274 >       outerCounter = outerCounter + 1
275 >       write(*,*) "Outer index is: ", outerCounter
276 >       write(*,*) "For atype: ", tmpPtrOuter%atype_ident
277 > ! do self mixing rule
278 >       ljMixed(outerCounter,outerCounter)%sigma  = tmpPtrOuter%sigma
279 >                                                                                                  
280 >       ljMixed(outerCounter,outerCounter)%sigma2  = ljMixed(outerCounter,outerCounter)%sigma &
281 >            * ljMixed(outerCounter,outerCounter)%sigma
282 >                                                                                                  
283 >       ljMixed(outerCounter,outerCounter)%sigma6 = ljMixed(outerCounter,outerCounter)%sigma2 &
284 >            * ljMixed(outerCounter,outerCounter)%sigma2 &
285 >            * ljMixed(outerCounter,outerCounter)%sigma2
286 >                                                                                                  
287 >       ljMixed(outerCounter,outerCounter)%epsilon = tmpPtrOuter%epsilon
288 >
289 >       innerCounter = outerCounter + 1
290 >       do while (associated(tmpPtrInner))
291 >          
292 >          write(*,*) "Entered inner loop for: ", innerCounter
293 >          ljMixed(outerCounter,innerCounter)%sigma  =  &
294 >               calcLJMix("sigma",tmpPtrOuter%sigma, &
295 >               tmpPtrInner%sigma)
296 >          
297 >          ljMixed(outerCounter,innerCounter)%sigma2  = &
298 >               ljMixed(outerCounter,innerCounter)%sigma &
299 >               * ljMixed(outerCounter,innerCounter)%sigma
300 >          
301 >          ljMixed(outerCounter,innerCounter)%sigma6 = &
302 >               ljMixed(outerCounter,innerCounter)%sigma2 &
303 >               * ljMixed(outerCounter,innerCounter)%sigma2 &
304 >               * ljMixed(outerCounter,innerCounter)%sigma2
305 >          
306 >          ljMixed(outerCounter,innerCounter)%epsilon = &
307 >               calcLJMix("epsilon",tmpPtrOuter%epsilon, &
308 >               tmpPtrInner%epsilon)
309 >          ljMixed(innerCounter,outerCounter)%sigma = ljMixed(outerCounter,innerCounter)%sigma
310 >          ljMixed(innerCounter,outerCounter)%sigma2 = ljMixed(outerCounter,innerCounter)%sigma2
311 >          ljMixed(innerCounter,outerCounter)%sigma6 = ljMixed(outerCounter,innerCounter)%sigma6
312 >          ljMixed(innerCounter,outerCounter)%epsilon = ljMixed(outerCounter,innerCounter)%epsilon
313 >
314 >
315 >          tmpPtrInner => tmpPtrInner%next
316 >          innerCounter = innerCounter + 1
317 >       end do
318 > ! advance pointers
319 >       tmpPtrOuter => tmpPtrOuter%next
320 >       if (associated(tmpPtrOuter)) then
321 >          tmpPtrInner => tmpPtrOuter%next
322         endif
323        
263       PtrList(i)%this => tmpPtr
324      end do
325  
326 <  end subroutine new_ljatypePtrList
326 >  end subroutine createMixingList
327  
268 !! Finds a lj_atype based upon numerical ident
269 !! returns a null pointer if error
270  subroutine getLJatype(ident,ljAtypePtr)
271    integer, intent(in) :: ident
272    type (lj_atype), intent(out),pointer :: ljAtypePtr => null()
273    
274    type (lj_atype), pointer :: tmplj_atype_ptr => null()
328  
276    if(.not. associated(lj_atype_list)) return
329  
278 ! Point at head of list.
279    tmplj_atype_ptr => lj_atype_list
280    find_ident: do
281       if (.not.associated(tmplj_atype_ptr)) then
282          exit find_ident
283       else if( lj_atype_ptr%atype_ident == ident)
284          ljAtypePtr => tmplj_atype_ptr
285          exit find_ident
286       endif
287       tmplj_atype_ptr => tmplj_atype_ptr%next
288    end do find_ident
330  
290  end subroutine getLJatype
331  
332  
333 < ! FORCE routine
333 >
334 >
335 > !! FORCE routine Calculates Lennard Jones forces.
336   !------------------------------------------------------------->
337    subroutine do_lj_ff(q,f,potE,do_pot)
338 <    real ( kind = dp ), dimension(ndim,) :: q
339 <    real ( kind = dp ), dimension(ndim,nLRparticles) :: f
338 > !! Position array provided by C, dimensioned by getNlocal
339 >    real ( kind = dp ), dimension(3,getNlocal()) :: q
340 > !! Force array provided by C, dimensioned by getNlocal
341 >    real ( kind = dp ), dimension(3,getNlocal()) :: f
342      real ( kind = dp ) :: potE
343 +    logical ( kind = 2) :: do_pot
344 +    
345 +    type(lj_atype), pointer :: ljAtype_i
346 +    type(lj_atype), pointer :: ljAtype_j
347  
348   #ifdef MPI
349 <  real( kind = DP ), dimension(3,ncol) :: efr
349 >  real( kind = DP ), dimension(3,getNcol()) :: efr
350    real( kind = DP ) :: pot_local
351   #else
352 < !  real( kind = DP ), dimension(3,natoms) :: efr
352 >  real( kind = DP ), dimension(3,getNlocal()) :: efr
353   #endif
354    
355 + !! Local arrays needed for MPI
356 + #ifdef IS_MPI
357 +  real(kind = dp), dimension(3:getNrow()) :: qRow
358 +  real(kind = dp), dimension(3:getNcol()) :: qCol
359 +
360 +  real(kind = dp), dimension(3:getNrow()) :: fRow
361 +  real(kind = dp), dimension(3:getNcol()) :: fCol
362 +
363 +  real(kind = dp), dimension(getNrow()) :: eRow
364 +  real(kind = dp), dimension(getNcol()) :: eCol
365 +
366 +  real(kind = dp), dimension(getNlocal()) :: eTemp
367 + #endif
368 +
369 +
370 +
371    real( kind = DP )   :: pe
372 <  logical,            :: update_nlist
309 <  logical             :: do_pot
372 >  logical             :: update_nlist
373  
374 +
375    integer ::  i, j, jbeg, jend, jnab, idim, jdim, idim2, jdim2, dim, dim2
376    integer :: nlist
377    integer :: j_start
378    integer :: tag_i,tag_j
379    real( kind = DP ) ::  r, pot, ftmp, dudr, d2, drdx1, kt1, kt2, kt3, ktmp
380    real( kind = DP ) ::  rxi, ryi, rzi, rxij, ryij, rzij, rijsq
381 +  real( kind = DP ) ::  rlistsq, rcutsq,rlist,rcut
382  
383 + ! a rig that need to be fixed.
384 + #ifdef IS_MPI
385 +  logical :: newtons_thrd = .true.
386 +  real( kind = dp ) :: pe_local
387 +  integer :: nlocal
388 + #endif
389    integer :: nrow
390    integer :: ncol
391 +  integer :: natoms
392  
393 + ! Make sure we are properly initialized.
394 +  if (.not. isljFFInit) then
395 +     write(default_error,*) "ERROR: lj_FF has not been properly initialized"
396 +     return
397 +  endif
398 + #ifdef IS_MPI
399 +    if (.not. isMPISimSet()) then
400 +     write(default_error,*) "ERROR: mpiSimulation has not been properly initialized"
401 +     return
402 +  endif
403 + #endif
404  
405 <
405 > !! initialize local variables  
406 >  natoms = getNlocal()
407 >  call getRcut(rcut,rcut2=rcutsq)
408 >  call getRlist(rlist,rlistsq)
409   #ifndef IS_MPI
410    nrow = natoms - 1
411    ncol = natoms
412   #else
413 +  nrow = getNrow(plan_row)
414 +  ncol = getNcol(plan_col)
415 +  nlocal = natoms
416    j_start = 1
417   #endif
418  
419 <  call check(update_nlist)
419 >  
420 > !! See if we need to update neighbor lists
421 >  call check(q,update_nlist)
422  
423 <  do_pot = .false.
424 <  if (present(pe)) do_pot = .true.
425 <
423 > !--------------WARNING...........................
424 > ! Zero variables, NOTE:::: Forces are zeroed in C
425 > ! Zeroing them here could delete previously computed
426 > ! Forces.
427 > !------------------------------------------------
428   #ifndef IS_MPI
429 <  nloops = nloops + 1
430 <  pot = 0.0E0_DP
431 <  f = 0.0E0_DP
339 <  e = 0.0E0_DP
429 > !  nloops = nloops + 1
430 >  pe = 0.0E0_DP
431 >
432   #else
433      f_row = 0.0E0_DP
434      f_col = 0.0E0_DP
435  
436 <    pot_local = 0.0E0_DP
436 >    pe_local = 0.0E0_DP
437  
438 <    e_row = 0.0E0_DP
439 <    e_col = 0.0E0_DP
440 <    e_tmp = 0.0E0_DP
438 >    eRow = 0.0E0_DP
439 >    eCol = 0.0E0_DP
440 >    eTemp = 0.0E0_DP
441   #endif
442      efr = 0.0E0_DP
443  
444   ! communicate MPI positions
445   #ifdef MPI    
446 <    call gather(q,q_row,plan_row3)
447 <    call gather(q,q_col,plan_col3)
446 >    call gather(q,qRow,plan_row3)
447 >    call gather(q,qCol,plan_col3)
448   #endif
449  
358 #ifndef MPI
450  
360 #endif
361
451    if (update_nlist) then
452  
453       ! save current configuration, contruct neighbor list,
454       ! and calculate forces
455 <     call save_nlist()
455 >     call save_nlist(q)
456      
457       nlist = 0
458      
# Line 372 | Line 461 | contains
461       do i = 1, nrow
462          point(i) = nlist + 1
463   #ifdef MPI
464 <        tag_i = tag_row(i)
465 <        rxi = q_row(1,i)
466 <        ryi = q_row(2,i)
467 <        rzi = q_row(3,i)
464 >        ljAtype_i => identPtrListRow(i)%this
465 >        tag_i = tagRow(i)
466 >        rxi = qRow(1,i)
467 >        ryi = qRow(2,i)
468 >        rzi = qRow(3,i)
469   #else
470 +        ljAtype_i   => identPtrList(i)%this
471          j_start = i + 1
472          rxi = q(1,i)
473          ryi = q(2,i)
# Line 385 | Line 476 | contains
476  
477          inner: do j = j_start, ncol
478   #ifdef MPI
479 <           tag_j = tag_col(j)
479 > ! Assign identity pointers and tags
480 >           ljAtype_j => identPtrListColumn(j)%this
481 >           tag_j = tagCol(j)
482             if (newtons_thrd) then
483                if (tag_i <= tag_j) then
484                   if (mod(tag_i + tag_j,2) == 0) cycle inner
# Line 394 | Line 487 | contains
487                endif
488             endif
489  
490 <           rxij = wrap(rxi - q_col(1,j), 1)
491 <           ryij = wrap(ryi - q_col(2,j), 2)
492 <           rzij = wrap(rzi - q_col(3,j), 3)
490 >           rxij = wrap(rxi - qCol(1,j), 1)
491 >           ryij = wrap(ryi - qCol(2,j), 2)
492 >           rzij = wrap(rzi - qCol(3,j), 3)
493   #else          
494 <        
494 >           ljAtype_j   => identPtrList(j)%this
495             rxij = wrap(rxi - q(1,j), 1)
496             ryij = wrap(ryi - q(2,j), 2)
497             rzij = wrap(rzi - q(3,j), 3)
# Line 407 | Line 500 | contains
500             rijsq = rxij*rxij + ryij*ryij + rzij*rzij
501  
502   #ifdef MPI
503 <             if (rijsq <=  rlstsq .AND. &
503 >             if (rijsq <=  rlistsq .AND. &
504                    tag_j /= tag_i) then
505   #else
506 <             if (rijsq <  rlstsq) then
506 >             if (rijsq <  rlistsq) then
507   #endif
508              
509                nlist = nlist + 1
510                if (nlist > size(list)) then
511 <                 call info("FORCE_LJ","error size list smaller then nlist")
512 <                 write(msg,*) "nlist size(list)", nlist, size(list)
420 <                 call info("FORCE_LJ",msg)
421 < #ifdef MPI
422 <                 call mpi_abort(MPI_COMM_WORLD,mpi_err)
423 < #endif
424 <                 stop
511 > !!  "Change how nlist size is done"
512 >                 write(DEFAULT_ERROR,*) "ERROR: nlist > list size"
513                endif
514                list(nlist) = j
515  
# Line 430 | Line 518 | contains
518                  
519                   r = dsqrt(rijsq)
520        
521 <                 call LJ_mix(r,pot,dudr,d2,i,j)
521 >                 call getLJPot(r,pot,dudr,ljAtype_i,ljAtype_j)
522        
523   #ifdef MPI
524 <                e_row(i) = e_row(i) + pot*0.5
525 <                e_col(i) = e_col(i) + pot*0.5
524 >                eRow(i) = eRow(i) + pot*0.5
525 >                eCol(i) = eCol(i) + pot*0.5
526   #else
527                  pe = pe + pot
528   #endif                
# Line 451 | Line 539 | contains
539  
540  
541   #ifdef MPI
542 <                    f_col(dim,j) = f_col(dim,j) - ftmp
543 <                    f_row(dim,i) = f_row(dim,i) + ftmp
542 >                    fCol(dim,j) = fCol(dim,j) - ftmp
543 >                    fRow(dim,i) = fRow(dim,i) + ftmp
544   #else                    
545              
546                      f(dim,j) = f(dim,j) - ftmp
# Line 480 | Line 568 | contains
568          ! check thiat molecule i has neighbors
569          if (jbeg .le. jend) then
570   #ifdef MPI
571 <           rxi = q_row(1,i)
572 <           ryi = q_row(2,i)
573 <           rzi = q_row(3,i)
571 >           ljAtype_i => identPtrListRow(i)%this
572 >           rxi = qRow(1,i)
573 >           ryi = qRow(2,i)
574 >           rzi = qRow(3,i)
575   #else
576 +           ljAtype_i   => identPtrList(i)%this
577             rxi = q(1,i)
578             ryi = q(2,i)
579             rzi = q(3,i)
# Line 491 | Line 581 | contains
581             do jnab = jbeg, jend
582                j = list(jnab)
583   #ifdef MPI
584 <                rxij = wrap(rxi - q_col(1,j), 1)
585 <                ryij = wrap(ryi - q_col(2,j), 2)
586 <                rzij = wrap(rzi - q_col(3,j), 3)
584 >              ljAtype_j = identPtrListColumn(j)%this
585 >              rxij = wrap(rxi - q_col(1,j), 1)
586 >              ryij = wrap(ryi - q_col(2,j), 2)
587 >              rzij = wrap(rzi - q_col(3,j), 3)
588   #else
589 <                rxij = wrap(rxi - q(1,j), 1)
590 <                ryij = wrap(ryi - q(2,j), 2)
591 <                rzij = wrap(rzi - q(3,j), 3)
589 >              ljAtype_j = identPtrList(j)%this
590 >              rxij = wrap(rxi - q(1,j), 1)
591 >              ryij = wrap(ryi - q(2,j), 2)
592 >              rzij = wrap(rzi - q(3,j), 3)
593   #endif
594                rijsq = rxij*rxij + ryij*ryij + rzij*rzij
595                
# Line 505 | Line 597 | contains
597  
598                   r = dsqrt(rijsq)
599                  
600 <                 call LJ_mix(r,pot,dudr,d2,i,j)
600 >                 call getLJPot(r,pot,dudr,ljAtype_i,ljAtype_j)
601   #ifdef MPI
602 <                e_row(i) = e_row(i) + pot*0.5
603 <                e_col(i) = e_col(i) + pot*0.5
602 >                eRow(i) = eRow(i) + pot*0.5
603 >                eCol(i) = eCol(i) + pot*0.5
604   #else
605 <               if (do_pot)  pe = pe + pot
605 >                pe = pe + pot
606   #endif                
607  
608                  
# Line 523 | Line 615 | contains
615                      drdx1 = efr(dim,j) / r
616                      ftmp = dudr * drdx1
617   #ifdef MPI
618 <                    f_col(dim,j) = f_col(dim,j) - ftmp
619 <                    f_row(dim,i) = f_row(dim,i) + ftmp
618 >                    fCol(dim,j) = fCol(dim,j) - ftmp
619 >                    fRow(dim,i) = fRow(dim,i) + ftmp
620   #else                    
621                      f(dim,j) = f(dim,j) - ftmp
622                      f(dim,i) = f(dim,i) + ftmp
# Line 540 | Line 632 | contains
632  
633   #ifdef MPI
634      !!distribute forces
635 <    call scatter(f_row,f,plan_row3)
635 >    call scatter(fRow,f,plan_row3)
636  
637 <    call scatter(f_col,f_tmp,plan_col3)
637 >    call scatter(fCol,f_tmp,plan_col3)
638 >
639      do i = 1,nlocal
640 <       do dim = 1,3
548 <          f(dim,i) = f(dim,i) + f_tmp(dim,i)
549 <       end do
640 >       f(1:3,i) = f(1:3,i) + f_tmp(1:3,i)
641      end do
642  
643  
644      
645      if (do_pot) then
646   ! scatter/gather pot_row into the members of my column
647 <  call scatter(e_row,e_tmp,plan_row)
647 >       call scatter(e_row,e_tmp,plan_row)
648        
649         ! scatter/gather pot_local into all other procs
650         ! add resultant to get total pot
651         do i = 1, nlocal
652 <          pot_local = pot_local + e_tmp(i)
652 >          pe_local = pe_local + e_tmp(i)
653         enddo
654         if (newtons_thrd) then
655            e_tmp = 0.0E0_DP
656            call scatter(e_col,e_tmp,plan_col)
657            do i = 1, nlocal
658 <             pot_local = pot_local + e_tmp(i)
658 >             pe_local = pe_local + e_tmp(i)
659            enddo
660         endif
661      endif
662 +    potE = pe_local
663   #endif
664  
665 +    potE = pe
666  
667  
575
668    end subroutine do_lj_ff
669  
670 < !! Calculates the potential between two lj particles, optionally returns second
670 > !! Calculates the potential between two lj particles based on two lj_atype pointers, optionally returns second
671   !! derivatives.
672    subroutine getLjPot(r,pot,dudr,atype1,atype2,d2,status)
673   ! arguments
# Line 588 | Line 680 | contains
680   !! Second Derivative, optional, used mainly for normal mode calculations.
681      real( kind = dp ), intent(out), optional :: d2
682      
683 <    type (lj_atype), intent(in) :: atype1
684 <    type (lj_atype), intent(in) :: atype2
683 >    type (lj_atype), pointer :: atype1
684 >    type (lj_atype), pointer :: atype2
685  
686      integer, intent(out), optional :: status
687  
# Line 597 | Line 689 | contains
689      real( kind = dp ) :: sigma
690      real( kind = dp ) :: sigma2
691      real( kind = dp ) :: sigma6
692 <    real( kind = dp ) :: epslon
692 >    real( kind = dp ) :: epsilon
693  
694      real( kind = dp ) :: rcut
695      real( kind = dp ) :: rcut2
# Line 622 | Line 714 | contains
714      if (present(status)) status = 0
715  
716   ! Look up the correct parameters in the mixing matrix
717 <    sigma   = ljMixed(atype1%atype_ident,atype2_atype_ident)%sigma
718 <    sigma2  = ljMixed(atype1%atype_ident,atype2_atype_ident)%sigma2
719 <    sigma6  = ljMixed(atype1%atype_ident,atype2_atype_ident)%sigma6
720 <    epslon  = ljMixed(atype1%atype_ident,atype2_atype_ident)%epslon
717 >    sigma    = ljMixed(atype1%atype_ident,atype2%atype_ident)%sigma
718 >    sigma2   = ljMixed(atype1%atype_ident,atype2%atype_ident)%sigma2
719 >    sigma6   = ljMixed(atype1%atype_ident,atype2%atype_ident)%sigma6
720 >    epsilon  = ljMixed(atype1%atype_ident,atype2%atype_ident)%epsilon
721  
722  
723  
# Line 645 | Line 737 | contains
737      delta = -4.0E0_DP*epsilon * (tp12 - tp6)
738                                                                                
739      if (r.le.rcut) then
740 <       u = 4.0E0_DP * epsilon * (t12 - t6) + delta
740 >       pot = 4.0E0_DP * epsilon * (t12 - t6) + delta
741         dudr = 24.0E0_DP * epsilon * (t6 - 2.0E0_DP*t12) / r
742         if(doSec)  d2 = 24.0E0_DP * epsilon * (26.0E0_DP*t12 - 7.0E0_DP*t6)/r/r
743      else
744 <       u = 0.0E0_DP
744 >       pot = 0.0E0_DP
745         dudr = 0.0E0_DP
746         if(doSec) d2 = 0.0E0_DP
747      endif
# Line 661 | Line 753 | contains
753    end subroutine getLjPot
754  
755  
756 < !! Calculates the mixing for sigma or epslon based on character string
756 > !! Calculates the mixing for sigma or epslon based on character string for initialzition of mixing array.
757    function calcLJMix(thisParam,param1,param2,status) result(myMixParam)
758      character(len=*) :: thisParam
759      real(kind = dp)  :: param1
# Line 678 | Line 770 | contains
770  
771      case ("sigma")
772         myMixParam = 0.5_dp * (param1 + param2)
773 <    case ("epslon")
773 >    case ("epsilon")
774         myMixParam = sqrt(param1 * param2)
775      case default
776         status = -1

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines