ViewVC Help
View File | Revision Log | Show Annotations | View Changeset | Root Listing
root/group/trunk/OOPSE_old/src/mdtools/libmdCode/simulation_module.F90
(Generate patch)

Comparing trunk/OOPSE_old/src/mdtools/libmdCode/simulation_module.F90 (file contents):
Revision 270 by mmeineke, Fri Feb 14 17:08:46 2003 UTC vs.
Revision 295 by chuckv, Thu Mar 6 19:57:03 2003 UTC

# Line 1 | Line 1
1 + !! Fortran interface to C entry plug.
2 +
3   module simulation
4    use definitions, ONLY :dp
5   #ifdef IS_MPI
# Line 7 | Line 9 | module simulation
9    implicit none
10    PRIVATE
11  
12 + #define __FORTRAN90
13 + #include "../headers/fsimulation.h"
14  
11 –
12 –  type, public :: simtype
13 –     PRIVATE
14 – !     SEQUENCE
15 – !! Number of particles on this processor
16 –     integer :: nLRparticles
17 – !! Periodic Box    
18 –     real ( kind = dp ), dimension(3) :: box
19 – !! List Cutoff    
20 –     real ( kind = dp ) :: rlist = 0.0_dp
21 – !! Radial cutoff
22 –     real ( kind = dp ) :: rcut  = 0.0_dp
23 – !! List cutoff squared
24 –     real ( kind = dp ) :: rlistsq = 0.0_dp
25 – !! Radial Cutoff squared
26 –     real ( kind = dp ) :: rcutsq  = 0.0_dp
27 – !! Radial Cutoff^6
28 –     real ( kind = dp ) :: rcut6  = 0.0_dp
29 –
30 –  end type simtype
31 –
15    type (simtype), public :: thisSim
33 – !! Tag for MPI calculations  
34 –  integer, allocatable, dimension(:) :: tag
16  
36 – #ifdef IS_MPI
37 –  integer, allocatable, dimension(:) :: tag_row
38 –  integer, allocatable, dimension(:) :: tag_column
39 – #endif
40 –
41 – !! WARNING: use_pbc hardcoded, fixme
42 –  logical :: use_pbc = .true.
17    logical :: setSim = .false.
18  
45 – !! array for saving previous positions for neighbor lists.  
46 –  real( kind = dp ), allocatable,dimension(:,:),save :: q0
19  
20  
49 –  public :: check
50 –  public :: save_nlist
51 –  public :: wrap
21    public :: getBox
22    public :: getRcut
23    public :: getRlist
24    public :: getNlocal
25    public :: setSimulation
26 < !  public :: setRcut
26 >  public :: isEnsemble
27 >  public :: isPBC
28 >  public :: getStringLen
29 >  public :: returnMixingRules
30  
31 <  interface wrap
60 <     module procedure wrap_1d
61 <     module procedure wrap_3d
62 <  end interface
63 <
31 > !  public :: setRcut
32    interface getBox
33       module procedure getBox_3d
34       module procedure getBox_dim
# Line 69 | Line 37 | module simulation
37  
38  
39  
72 –
73 –
74 –
75 –
76 –
77 –
40   contains
41  
42 <  subroutine setSimulation(nLRParticles,box,rlist,rcut)
43 <    integer, intent(in) :: nLRParticles
44 <    real(kind = dp ), intent(in), dimension(3) :: box
83 <    real(kind = dp ), intent(in) :: rlist
84 <    real(kind = dp ), intent(in) :: rcut
42 >  subroutine setSimulation(setThisSim,error)
43 >    type (simtype) :: setThisSim
44 >    integer :: error
45      integer :: alloc_stat
46 <    if( setsim ) return  ! simulation is already initialized
46 >
47 >    error = 0
48      setSim = .true.
49  
50 <    thisSim%nLRParticles = nLRParticles
51 <    thisSim%box          = box
91 <    thisSim%rlist        = rlist
92 <    thisSIm%rlistsq      = rlist * rlist
93 <    thisSim%rcut         = rcut
94 <    thisSim%rcutsq       = rcut * rcut
95 <    thisSim%rcut6        = thisSim%rcutsq * thisSim%rcutsq * thisSim%rcutsq
96 <    
97 <    if (.not. allocated(q0)) then
98 <       allocate(q0(3,nLRParticles),stat=alloc_stat)
99 <    endif
50 > ! copy C struct into fortran type
51 >    thisSim = setThisSim
52    end subroutine setSimulation
53  
54    function getNparticles() result(nparticles)
# Line 124 | Line 76 | contains
76  
77      thisBox = thisSim%box(dim)
78    end function getBox_dim
127 –    
128 –  subroutine check(q,update_nlist)
129 –    real( kind = dp ), dimension(:,:)  :: q
130 –    integer :: i
131 –    real( kind = DP ) :: dispmx
132 –    logical, intent(out) :: update_nlist
133 –    real( kind = DP ) :: dispmx_tmp
134 –    real( kind = dp ) :: skin_thickness
135 –    integer :: natoms
136 –
137 –    natoms = thisSim%nLRparticles
138 –    skin_thickness = thisSim%rlist - thisSim%rcut
139 –    dispmx = 0.0E0_DP
140 –    !! calculate the largest displacement of any atom in any direction
141 –    
142 – #ifdef MPI
143 –    dispmx_tmp = 0.0E0_DP
144 –    do i = 1, thisSim%nLRparticles
145 –       dispmx_tmp = max( abs ( q(1,i) - q0(1,i) ), dispmx )
146 –       dispmx_tmp = max( abs ( q(2,i) - q0(2,i) ), dispmx )
147 –       dispmx_tmp = max( abs ( q(3,i) - q0(3,i) ), dispmx )
148 –    end do
149 –    call mpi_allreduce(dispmx_tmp,dispmx,1,mpi_double_precision, &
150 –       mpi_max,mpi_comm_world,mpi_err)
151 – #else
152 –
153 –    do i = 1, thisSim%nLRparticles
154 –       dispmx = max( abs ( q(1,i) - q0(1,i) ), dispmx )
155 –       dispmx = max( abs ( q(2,i) - q0(2,i) ), dispmx )
156 –       dispmx = max( abs ( q(3,i) - q0(3,i) ), dispmx )
157 –    end do
158 – #endif
79    
160 –    !! a conservative test of list skin crossings
161 –    dispmx = 2.0E0_DP * sqrt (3.0E0_DP * dispmx * dispmx)
162 –    
163 –    update_nlist = (dispmx.gt.(skin_thickness))
164 –    
165 –  end subroutine check
80    
167 –  subroutine save_nlist(q)
168 –    real(kind = dp ), dimension(:,:), intent(in)  :: q
169 –    integer :: list_size
170 –    
171 –
172 –    list_size = size(q)
173 –
174 –    if (.not. allocated(q0)) then
175 –       allocate(q0(3,list_size))
176 –    else if( list_size > size(q0)) then
177 –       deallocate(q0)
178 –       allocate(q0(3,list_size))
179 –    endif
180 –
181 –    q0 = q
182 –
183 –  end subroutine save_nlist
184 –  
185 –
186 –  function wrap_1d(r,dim) result(this_wrap)
187 –    
188 –    
189 –    real( kind = DP ) :: r
190 –    real( kind = DP ) :: this_wrap
191 –    integer           :: dim
192 –    
193 –    if (use_pbc) then
194 –       !     this_wrap = r - box(dim)*dsign(1.0E0_DP,r)*int(abs(r/box(dim)) + 0.5E0_DP)
195 –       this_wrap = r - thisSim%box(dim)*nint(r/thisSim%box(dim))
196 –    else
197 –       this_wrap = r
198 –    endif
199 –    
200 –    return
201 –  end function wrap_1d
202 –
203 –  function wrap_3d(r) result(this_wrap)
204 –    real( kind = dp ), dimension(3), intent(in) :: r
205 –    real( kind = dp ), dimension(3) :: this_wrap
206 –
207 –    
208 –    if (use_pbc) then
209 –       !     this_wrap = r - box(dim)*dsign(1.0E0_DP,r)*int(abs(r/box(dim)) + 0.5E0_DP)
210 –       this_wrap = r - thisSim%box*nint(r/thisSim%box)
211 –    else
212 –       this_wrap = r
213 –    endif
214 –  end function wrap_3d
215 –
216 –  
81  
82    subroutine getRcut(thisrcut,rcut2,rcut6,status)
83      real( kind = dp ), intent(out) :: thisrcut
# Line 264 | Line 128 | contains
128    end function getNlocal
129  
130  
131 +  function isEnsemble(this_ensemble) result(is_this_ensemble)
132 +    character(len = *) :: this_ensemble
133 +    logical :: is_this_enemble
134 +    is_this_ensemble = .false.
135 +    if (this_ensemble == thisSim%ensemble) is_this_ensemble = .true.
136 +  end function isEnsemble
137  
138 +  function returnEnsemble() result(thisEnsemble)
139 +    character (len = len(thisSim%ensemble)) :: thisEnsemble
140 +    thisEnsemble = thisSim%ensemble
141 +  end function returnEnsemble
142 +
143 +  function returnMixingRules() result(thisMixingRule)
144 +    character (len = len(thisSim%ensemble)) :: thisMixingRule
145 +    thisMixingRule = thisSim%MixingRule
146 +  end function returnMixingRules
147 +
148 +  function isPBC() result(PBCset)
149 +    logical :: PBCset
150 +    PBCset = .false.
151 +    if (thisSim%use_pbc) PBCset = .true.
152 +  end function isPBC
153 +
154 +  pure function getStringLen() result (thislen)
155 +    integer :: thislen    
156 +    thislen = string_len
157 +  end function setStringLen
158 +
159   end module simulation

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines