ViewVC Help
View File | Revision Log | Show Annotations | View Changeset | Root Listing
root/group/trunk/OOPSE/libmdtools/simulation_module.F90
Revision: 1214
Committed: Tue Jun 1 18:42:58 2004 UTC (20 years, 1 month ago) by gezelter
File size: 14912 byte(s)
Log Message:
Cutoff Groups for MPI

File Contents

# Content
1 !! Fortran interface to C entry plug.
2
3 module simulation
4 use definitions
5 use neighborLists
6 use force_globals
7 use vector_class
8 use atype_module
9 use switcheroo
10 #ifdef IS_MPI
11 use mpiSimulation
12 #endif
13
14 implicit none
15 PRIVATE
16
17 #define __FORTRAN90
18 #include "fSimulation.h"
19 #include "fSwitchingFunction.h"
20
21 type (simtype), public, save :: thisSim
22
23 logical, save :: simulation_setup_complete = .false.
24
25 integer, public, save :: nLocal, nGlobal
26 integer, public, save :: nGroups, nGroupGlobal
27 integer, public, save :: nExcludes_Global = 0
28 integer, public, save :: nExcludes_Local = 0
29 integer, allocatable, dimension(:,:), public :: excludesLocal
30 integer, allocatable, dimension(:), public :: excludesGlobal
31 integer, allocatable, dimension(:), public :: molMembershipList
32 integer, allocatable, dimension(:), public :: groupListRow
33 integer, allocatable, dimension(:), public :: groupStartRow
34 integer, allocatable, dimension(:), public :: groupListCol
35 integer, allocatable, dimension(:), public :: groupStartCol
36 integer, allocatable, dimension(:), public :: groupListLocal
37 integer, allocatable, dimension(:), public :: groupStartLocal
38 integer, allocatable, dimension(:), public :: nSkipsForAtom
39 integer, allocatable, dimension(:,:), public :: skipsForAtom
40 real(kind=dp), allocatable, dimension(:), public :: mfactRow
41 real(kind=dp), allocatable, dimension(:), public :: mfactCol
42 real(kind=dp), allocatable, dimension(:), public :: mfactLocal
43
44 real(kind=dp), public, dimension(3,3), save :: Hmat, HmatInv
45 logical, public, save :: boxIsOrthorhombic
46
47 public :: SimulationSetup
48 public :: getNlocal
49 public :: setBox
50 public :: getDielect
51 public :: SimUsesPBC
52 public :: SimUsesLJ
53 public :: SimUsesCharges
54 public :: SimUsesDipoles
55 public :: SimUsesSticky
56 public :: SimUsesRF
57 public :: SimUsesGB
58 public :: SimUsesEAM
59 public :: SimRequiresPrepairCalc
60 public :: SimRequiresPostpairCalc
61 public :: SimUsesDirectionalAtoms
62
63 contains
64
65 subroutine SimulationSetup(setThisSim, CnGlobal, CnLocal, c_idents, &
66 CnLocalExcludes, CexcludesLocal, CnGlobalExcludes, CexcludesGlobal, &
67 CmolMembership, Cmfact, CnGroups, CglobalGroupMembership, &
68 status)
69
70 type (simtype) :: setThisSim
71 integer, intent(inout) :: CnGlobal, CnLocal
72 integer, dimension(CnLocal),intent(inout) :: c_idents
73
74 integer :: CnLocalExcludes
75 integer, dimension(2,CnLocalExcludes), intent(in) :: CexcludesLocal
76 integer :: CnGlobalExcludes
77 integer, dimension(CnGlobalExcludes), intent(in) :: CexcludesGlobal
78 integer, dimension(CnGlobal),intent(in) :: CmolMembership
79 !! Result status, success = 0, status = -1
80 integer, intent(out) :: status
81 integer :: i, j, me, thisStat, alloc_stat, myNode, id1, id2
82 integer :: ia
83
84 !! mass factors used for molecular cutoffs
85 real ( kind = dp ), dimension(CnLocal) :: Cmfact
86 integer, intent(in):: CnGroups
87 integer, dimension(CnGlobal), intent(in):: CglobalGroupMembership
88 integer :: maxSkipsForAtom, glPointer
89
90 #ifdef IS_MPI
91 integer, allocatable, dimension(:) :: c_idents_Row
92 integer, allocatable, dimension(:) :: c_idents_Col
93 integer :: nAtomsInRow, nGroupsInRow, aid
94 integer :: nAtomsInCol, nGroupsInCol, gid
95 #endif
96
97 simulation_setup_complete = .false.
98 status = 0
99
100 ! copy C struct into fortran type
101
102 nLocal = CnLocal
103 nGlobal = CnGlobal
104 nGroups = CnGroups
105
106 thisSim = setThisSim
107
108 nExcludes_Global = CnGlobalExcludes
109 nExcludes_Local = CnLocalExcludes
110
111 call InitializeForceGlobals(nLocal, thisStat)
112 if (thisStat /= 0) then
113 write(default_error,*) "SimSetup: InitializeForceGlobals error"
114 status = -1
115 return
116 endif
117
118 call InitializeSimGlobals(thisStat)
119 if (thisStat /= 0) then
120 write(default_error,*) "SimSetup: InitializeSimGlobals error"
121 status = -1
122 return
123 endif
124
125 #ifdef IS_MPI
126 ! We can only set up forces if mpiSimulation has been setup.
127 if (.not. isMPISimSet()) then
128 write(default_error,*) "MPI is not set"
129 status = -1
130 return
131 endif
132 nAtomsInRow = getNatomsInRow(plan_atom_row)
133 nAtomsInCol = getNatomsInCol(plan_atom_col)
134 nGroupsInRow = getNgroupsInRow(plan_group_row)
135 nGroupsInCol = getNgroupsInCol(plan_group_col)
136 mynode = getMyNode()
137
138 allocate(c_idents_Row(nAtomsInRow),stat=alloc_stat)
139 if (alloc_stat /= 0 ) then
140 status = -1
141 return
142 endif
143
144 allocate(c_idents_Col(nAtomsInCol),stat=alloc_stat)
145 if (alloc_stat /= 0 ) then
146 status = -1
147 return
148 endif
149
150 call gather(c_idents, c_idents_Row, plan_atom_row)
151 call gather(c_idents, c_idents_Col, plan_atom_col)
152
153 do i = 1, nAtomsInRow
154 me = getFirstMatchingElement(atypes, "c_ident", c_idents_Row(i))
155 atid_Row(i) = me
156 enddo
157
158 do i = 1, nAtomsInCol
159 me = getFirstMatchingElement(atypes, "c_ident", c_idents_Col(i))
160 atid_Col(i) = me
161 enddo
162
163 !! free temporary ident arrays
164 if (allocated(c_idents_Col)) then
165 deallocate(c_idents_Col)
166 end if
167 if (allocated(c_idents_Row)) then
168 deallocate(c_idents_Row)
169 endif
170
171 #endif
172
173 #ifdef IS_MPI
174 allocate(groupStartRow(nGroupsInRow+1),stat=alloc_stat)
175 if (alloc_stat /= 0 ) then
176 status = -1
177 return
178 endif
179 allocate(groupStartCol(nGroupsInCol+1),stat=alloc_stat)
180 if (alloc_stat /= 0 ) then
181 status = -1
182 return
183 endif
184 allocate(groupListRow(nAtomsInRow),stat=alloc_stat)
185 if (alloc_stat /= 0 ) then
186 status = -1
187 return
188 endif
189 allocate(groupListCol(nAtomsInCol),stat=alloc_stat)
190 if (alloc_stat /= 0 ) then
191 status = -1
192 return
193 endif
194 allocate(mfactRow(nAtomsInRow),stat=alloc_stat)
195 if (alloc_stat /= 0 ) then
196 status = -1
197 return
198 endif
199 allocate(mfactCol(nAtomsInCol),stat=alloc_stat)
200 if (alloc_stat /= 0 ) then
201 status = -1
202 return
203 endif
204 allocate(mfactLocal(nLocal),stat=alloc_stat)
205 if (alloc_stat /= 0 ) then
206 status = -1
207 return
208 endif
209
210 glPointer = 1
211
212 do i = 1, nGroupsInRow
213
214 gid = GroupRowToGlobal(i)
215 groupStartRow(i) = glPointer
216
217 do j = 1, nAtomsInRow
218 aid = AtomRowToGlobal(j)
219 if (CglobalGroupMembership(aid) .eq. gid) then
220 groupListRow(glPointer) = j
221 glPointer = glPointer + 1
222 endif
223 enddo
224 enddo
225 groupStartRow(nGroupsInRow+1) = nAtomsInRow + 1
226
227 glPointer = 1
228
229 do i = 1, nGroupsInCol
230
231 gid = GroupColToGlobal(i)
232 groupStartCol(i) = glPointer
233
234 do j = 1, nAtomsInCol
235 aid = AtomColToGlobal(j)
236 if (CglobalGroupMembership(aid) .eq. gid) then
237 groupListCol(glPointer) = j
238 glPointer = glPointer + 1
239 endif
240 enddo
241 enddo
242 groupStartCol(nGroupsInCol+1) = nAtomsInCol + 1
243
244 mfactLocal = Cmfact
245
246 call gather(mfactLocal, mfactRow, plan_atom_row)
247 call gather(mfactLocal, mfactCol, plan_atom_col)
248
249 if (allocated(mfactLocal)) then
250 deallocate(mfactLocal)
251 end if
252 #else
253 allocate(groupStartRow(nGroups+1),stat=alloc_stat)
254 if (alloc_stat /= 0 ) then
255 status = -1
256 return
257 endif
258 allocate(groupStartCol(nGroups+1),stat=alloc_stat)
259 if (alloc_stat /= 0 ) then
260 status = -1
261 return
262 endif
263 allocate(groupListRow(nLocal),stat=alloc_stat)
264 if (alloc_stat /= 0 ) then
265 status = -1
266 return
267 endif
268 allocate(groupListCol(nLocal),stat=alloc_stat)
269 if (alloc_stat /= 0 ) then
270 status = -1
271 return
272 endif
273 allocate(mfactRow(nLocal),stat=alloc_stat)
274 if (alloc_stat /= 0 ) then
275 status = -1
276 return
277 endif
278 allocate(mfactCol(nLocal),stat=alloc_stat)
279 if (alloc_stat /= 0 ) then
280 status = -1
281 return
282 endif
283 allocate(mfactLocal(nLocal),stat=alloc_stat)
284 if (alloc_stat /= 0 ) then
285 status = -1
286 return
287 endif
288
289 glPointer = 1
290 do i = 1, nGroups
291 groupStartRow(i) = glPointer
292 groupStartCol(i) = glPointer
293 do j = 1, nLocal
294 if (CglobalGroupMembership(j) .eq. i) then
295 groupListRow(glPointer) = j
296 groupListCol(glPointer) = j
297 glPointer = glPointer + 1
298 endif
299 enddo
300 enddo
301 groupStartRow(nGroups+1) = nLocal + 1
302 groupStartCol(nGroups+1) = nLocal + 1
303
304 do i = 1, nLocal
305 mfactRow(i) = Cmfact(i)
306 mfactCol(i) = Cmfact(i)
307 end do
308
309 #endif
310
311
312 ! We build the local atid's for both mpi and nonmpi
313 do i = 1, nLocal
314
315 me = getFirstMatchingElement(atypes, "c_ident", c_idents(i))
316 atid(i) = me
317
318 enddo
319
320 do i = 1, nExcludes_Local
321 excludesLocal(1,i) = CexcludesLocal(1,i)
322 excludesLocal(2,i) = CexcludesLocal(2,i)
323 enddo
324
325 maxSkipsForAtom = 0
326 #ifdef IS_MPI
327 do j = 1, nAtomsInRow
328 #else
329 do j = 1, nLocal
330 #endif
331 nSkipsForAtom(j) = 0
332 #ifdef IS_MPI
333 id1 = AtomRowToGlobal(j)
334 #else
335 id1 = j
336 #endif
337 do i = 1, nExcludes_Local
338 if (excludesLocal(1,i) .eq. id1 ) then
339 nSkipsForAtom(j) = nSkipsForAtom(j) + 1
340
341 if (nSkipsForAtom(j) .gt. maxSkipsForAtom) then
342 maxSkipsForAtom = nSkipsForAtom(j)
343 endif
344 endif
345 if (excludesLocal(2,i) .eq. id1 ) then
346 nSkipsForAtom(j) = nSkipsForAtom(j) + 1
347
348 if (nSkipsForAtom(j) .gt. maxSkipsForAtom) then
349 maxSkipsForAtom = nSkipsForAtom(j)
350 endif
351 endif
352 end do
353 enddo
354
355 #ifdef IS_MPI
356 allocate(skipsForAtom(nAtomsInRow, maxSkipsForAtom), stat=alloc_stat)
357 #else
358 allocate(skipsForAtom(nLocal, maxSkipsForAtom), stat=alloc_stat)
359 #endif
360 if (alloc_stat /= 0 ) then
361 write(*,*) 'Could not allocate skipsForAtom array'
362 return
363 endif
364
365 #ifdef IS_MPI
366 do j = 1, nAtomsInRow
367 #else
368 do j = 1, nLocal
369 #endif
370 nSkipsForAtom(j) = 0
371 #ifdef IS_MPI
372 id1 = AtomRowToGlobal(j)
373 #else
374 id1 = j
375 #endif
376 do i = 1, nExcludes_Local
377 if (excludesLocal(1,i) .eq. id1 ) then
378 nSkipsForAtom(j) = nSkipsForAtom(j) + 1
379 ! exclude lists have global ID's so this line is
380 ! the same in MPI and non-MPI
381 id2 = excludesLocal(2,i)
382 skipsForAtom(j, nSkipsForAtom(j)) = id2
383 endif
384 if (excludesLocal(2, i) .eq. id2 ) then
385 nSkipsForAtom(j) = nSkipsForAtom(j) + 1
386 ! exclude lists have global ID's so this line is
387 ! the same in MPI and non-MPI
388 id2 = excludesLocal(1,i)
389 skipsForAtom(j, nSkipsForAtom(j)) = id2
390 endif
391 end do
392 enddo
393
394 do i = 1, nExcludes_Global
395 excludesGlobal(i) = CexcludesGlobal(i)
396 enddo
397
398 do i = 1, nGlobal
399 molMemberShipList(i) = CmolMembership(i)
400 enddo
401
402 if (status == 0) simulation_setup_complete = .true.
403
404 end subroutine SimulationSetup
405
406 subroutine setBox(cHmat, cHmatInv, cBoxIsOrthorhombic)
407 real(kind=dp), dimension(3,3) :: cHmat, cHmatInv
408 integer :: cBoxIsOrthorhombic
409 integer :: smallest, status, i
410
411 Hmat = cHmat
412 HmatInv = cHmatInv
413 if (cBoxIsOrthorhombic .eq. 0 ) then
414 boxIsOrthorhombic = .false.
415 else
416 boxIsOrthorhombic = .true.
417 endif
418
419 return
420 end subroutine setBox
421
422 function getDielect() result(dielect)
423 real( kind = dp ) :: dielect
424 dielect = thisSim%dielect
425 end function getDielect
426
427 function SimUsesPBC() result(doesit)
428 logical :: doesit
429 doesit = thisSim%SIM_uses_PBC
430 end function SimUsesPBC
431
432 function SimUsesLJ() result(doesit)
433 logical :: doesit
434 doesit = thisSim%SIM_uses_LJ
435 end function SimUsesLJ
436
437 function SimUsesSticky() result(doesit)
438 logical :: doesit
439 doesit = thisSim%SIM_uses_sticky
440 end function SimUsesSticky
441
442 function SimUsesCharges() result(doesit)
443 logical :: doesit
444 doesit = thisSim%SIM_uses_charges
445 end function SimUsesCharges
446
447 function SimUsesDipoles() result(doesit)
448 logical :: doesit
449 doesit = thisSim%SIM_uses_dipoles
450 end function SimUsesDipoles
451
452 function SimUsesRF() result(doesit)
453 logical :: doesit
454 doesit = thisSim%SIM_uses_RF
455 end function SimUsesRF
456
457 function SimUsesGB() result(doesit)
458 logical :: doesit
459 doesit = thisSim%SIM_uses_GB
460 end function SimUsesGB
461
462 function SimUsesEAM() result(doesit)
463 logical :: doesit
464 doesit = thisSim%SIM_uses_EAM
465 end function SimUsesEAM
466
467 function SimUsesDirectionalAtoms() result(doesit)
468 logical :: doesit
469 doesit = thisSim%SIM_uses_dipoles .or. thisSim%SIM_uses_sticky .or. &
470 thisSim%SIM_uses_GB .or. thisSim%SIM_uses_RF
471 end function SimUsesDirectionalAtoms
472
473 function SimRequiresPrepairCalc() result(doesit)
474 logical :: doesit
475 doesit = thisSim%SIM_uses_EAM
476 end function SimRequiresPrepairCalc
477
478 function SimRequiresPostpairCalc() result(doesit)
479 logical :: doesit
480 doesit = thisSim%SIM_uses_RF
481 end function SimRequiresPostpairCalc
482
483 subroutine InitializeSimGlobals(thisStat)
484 integer, intent(out) :: thisStat
485 integer :: alloc_stat
486
487 thisStat = 0
488
489 call FreeSimGlobals()
490
491 allocate(nSkipsForAtom(nLocal), stat=alloc_stat)
492 if (alloc_stat /= 0 ) then
493 thisStat = -1
494 return
495 endif
496
497 allocate(excludesLocal(2,nExcludes_Local), stat=alloc_stat)
498 if (alloc_stat /= 0 ) then
499 thisStat = -1
500 return
501 endif
502
503 allocate(excludesGlobal(nExcludes_Global), stat=alloc_stat)
504 if (alloc_stat /= 0 ) then
505 thisStat = -1
506 return
507 endif
508
509 allocate(molMembershipList(nGlobal), stat=alloc_stat)
510 if (alloc_stat /= 0 ) then
511 thisStat = -1
512 return
513 endif
514
515 end subroutine InitializeSimGlobals
516
517 subroutine FreeSimGlobals()
518
519 !We free in the opposite order in which we allocate in.
520
521 if (allocated(skipsForAtom)) deallocate(skipsForAtom)
522 if (allocated(mfactLocal)) deallocate(mfactLocal)
523 if (allocated(mfactCol)) deallocate(mfactCol)
524 if (allocated(mfactRow)) deallocate(mfactRow)
525 if (allocated(groupListCol)) deallocate(groupListCol)
526 if (allocated(groupListRow)) deallocate(groupListRow)
527 if (allocated(groupStartCol)) deallocate(groupStartCol)
528 if (allocated(groupStartRow)) deallocate(groupStartRow)
529 if (allocated(molMembershipList)) deallocate(molMembershipList)
530 if (allocated(excludesGlobal)) deallocate(excludesGlobal)
531 if (allocated(excludesLocal)) deallocate(excludesLocal)
532
533 end subroutine FreeSimGlobals
534
535 pure function getNlocal() result(n)
536 integer :: n
537 n = nLocal
538 end function getNlocal
539
540
541 end module simulation