DISPATCH
cartesian_mod.f90
1 MODULE cartesian_mod
2  USE task_list_mod
3  USE experiment_mod
4  USE patch_mod
5  USE link_mod
6  USE task_mod
7  USE trace_mod
8  USE io_mod
9  USE timer_mod
10  USE mpi_coords_mod
11  USE mpi_mod
12  USE omp_mod
13  USE omp_timer_mod
14  USE bits_mod
15  implicit none
16  private
17  type, public, extends(task_t):: rank_t
18  end type
19  type, public:: cartesian_t
20  real(8):: size(3)
21  integer:: dims(3)
22  type(task_list_t), pointer:: task_list
23  contains
24  procedure init
25  procedure, nopass:: diagnostics
26  end type
27  logical:: omp_init=.false.
28  type(rank_t):: rank
29  integer, save:: np=0 ! patches per process
30  public task_list_t ! export, to avoid excessive USE
31 CONTAINS
32 
33 !===============================================================================
34 !> Distribute patches in a Cartesian arrangement in a box
35 !===============================================================================
36 SUBROUTINE init (self, label)
37  class(cartesian_t):: self
38  character(len=*), optional:: label
39  !.............................................................................
40  type(task_list_t), pointer:: patch_list
41  class(link_t), pointer:: link, next
42  class(experiment_t), pointer:: patch
43  class(task_t), pointer:: task
44  integer:: i, j, k, id, ip
45  integer:: dims(3) = [4,4,4]
46  integer:: patches_per_mpi(3)
47  integer:: mpi_dims(3) = [1,1,1]
48  integer:: per_rank(3) = [0,0,0]
49  real(8):: size(3) = [1.0,1.0,1.0]
50  real(8):: origin(3) = [-0.5,-0.5,-0.5]
51  real(8):: wc
52  logical:: face_nbors=.false.
53  logical:: periodic(3)=.true.
54  integer, save:: itimer=0
55  namelist /cartesian_params/ size, dims, mpi_dims, per_rank, origin, face_nbors, &
56  omp_init, periodic
57  character(len=120):: ids = &
58  '$Id: e71d387b943008f46d0f441b4ecad422725030df $ components/cartesian_mod.f90'
59  !-----------------------------------------------------------------------------
60  call trace%begin ('cartesian_t%init')
61  call io%header('begin cartesian_t%init: Cartesian patch arrangement')
62  call trace%print_id (ids)
63  !-----------------------------------------------------------------------------
64  rewind(io%input); read (io%input, cartesian_params)
65  write (io%output, cartesian_params)
66  if (any(per_rank/=0)) then
67  where (per_rank/=0) dims=per_rank*mpi_dims
68  end if
69  per_rank = dims/mpi_dims
70  self%dims = dims
71  self%size = size
72  io%dims = dims
73  if (mpi%size==1) &
74  mpi_dims = 1
75  !-----------------------------------------------------------------------------
76  ! Generate a (periodic) MPI geometry, with dims specified in the input file,
77  ! or assigned automatically by mpi_coords%init.
78  !-----------------------------------------------------------------------------
79  if (mpi%size == 1) then
80  mpi_coords%dims = 1
81  else
82  if (product(mpi_dims)==1) then
83  call mpi_coords%init (dims=dims)
84  else
85  call mpi_coords%init (mpi_dims=mpi_dims)
86  end if
87  end if
88  mpi_dims = mpi_coords%dims
89  patches_per_mpi = self%dims/mpi_dims
90  mpi_coords%npatch = patches_per_mpi
91  io%mpi_dims = mpi_dims
92  !-----------------------------------------------------------------------------
93  ! Set attritbutes of the rank_t data type -- just enough to use distance().
94  !-----------------------------------------------------------------------------
95  rank%periodic = .true.
96  rank%box = self%size
97  rank%size = rank%box/mpi_dims
98  rank%ds = rank%size/patches_per_mpi
99  rank%position = (mpi_coords%rank_to_coords(mpi%rank) + 0.5_8)*rank%size
100  !-----------------------------------------------------------------------------
101  ! Begin on task list
102  !-----------------------------------------------------------------------------
103  allocate (self%task_list)
104  call self%task_list%init ('tlist')
105  self%task_list%size = self%size
106  self%task_list%dims = self%dims
107  io%dims = self%dims
108  self%task_list%n_tasks = product(self%dims)
109  self%task_list%face_nbors = face_nbors
110  !-----------------------------------------------------------------------------
111  ! Allocate an array of links, pointing to patches, and give the patches each
112  ! id, rank, size, position, integer position, and status bits. Discard
113  ! external patches and add the rest to the task_list.
114  !-----------------------------------------------------------------------------
115  ip = 0
116  do k=0,self%dims(3)-1
117  do j=0,self%dims(2)-1
118  do i=0,self%dims(1)-1
119  allocate (link, patch); link%task => patch; patch%link => link
120  task => link%task
121  ! --- patch 3D and 1D coordinates ---
122  patch%ipos = [i,j,k]
123  patch%rank = mpi_coords%coords_to_rank ([i,j,k]/patches_per_mpi)
124  if (patch%rank == mpi%rank) then
125  ip = ip + 1
126  patch%ip = ip
127  end if
128  !---------------------------------------------------------------------------
129  ! Generate the same IDs on all ranks, pruning the external tasks below
130  !---------------------------------------------------------------------------
131  call patch%task_t%init_unique (same=.true.)
132  patch%box = self%size
133  patch%size = self%size / self%dims
134  patch%position = ([i,j,k]+0.5d0)*patch%size + origin
135  if (any(abs(rank%distance (patch)) > 0.5*(rank%size + 1.5*rank%ds))) then
136  deallocate (link, patch)
137  cycle
138  end if
139  call patch%set (bits%virtual)
140  patch%ds = patch%size*0.001
141  patch%origin = origin
142  patch%llc_cart = patch%position - 0.5 * patch%size
143  patch%centre_nat = patch%position
144  patch%llc_nat = patch%llc_cart
145  patch%periodic = periodic
146  call patch%set(bits%static)
147  if (all(self%dims==1)) call task%set(bits%root_grid)
148  ! -- initially append all tasks to the task list, to build nbor lists ------
149  call self%task_list%append_link (link)
150  end do
151  end do
152  end do
153  !-----------------------------------------------------------------------------
154  ! Generate nbor lists and set status bits for all tasks
155  !-----------------------------------------------------------------------------
156  if (io%verbose > 0) write(stdout,*) 'cartesian_t%init: init_all_nbors'
157  call self%task_list%init_all_nbors
158  if (io%verbose > 0) write(stdout,*) 'cartesian_t%init: reset_status'
159  call self%task_list%reset_status
160  !-----------------------------------------------------------------------------
161  ! Remove tasks that are external, and make sure to also remove them from the
162  ! nbor lists of virtual tasks
163  !-----------------------------------------------------------------------------
164  link => self%task_list%head
165  do while (associated(link))
166  next => link%next
167  if (link%task%is_set (bits%external)) then
168  call link%remove_nbor_list2 (link%nbor)
169  call self%task_list%remove (link)
170  deallocate (link%task)
171  deallocate (link)
172  end if
173  link => next
174  end do
175  !-----------------------------------------------------------------------------
176  ! This call is not valid until the patch meshes have been allocated
177  !-----------------------------------------------------------------------------
178  if (io%verbose > 0) write(stdout,*) 'cartesian_t%init: count status'
179  call self%task_list%count_status
180  !-----------------------------------------------------------------------------
181  ! These must be set before reading input snapshots
182  !-----------------------------------------------------------------------------
183  io%ntask = self%task_list%na
184  io%nwrite = self%task_list%na
185  io%ntotal = product(self%dims)
186  write (stdout,*) 'Number of tasks in task list:', self%task_list%n
187  write(stdout,*) 'ntask, nwrite, ntotal =', io%ntask, io%nwrite, io%ntotal
188  !-----------------------------------------------------------------------------
189  ! Initialize tasks
190  !-----------------------------------------------------------------------------
191  if (omp_init) then
192  !$omp parallel default(shared)
193  call init_exp (self, origin)
194  !$omp end parallel
195  else
196  call init_exp (self, origin)
197  end if
198  !-----------------------------------------------------------------------------
199  ! This call is not valid until the patch mem and meshes have been allocated
200  !-----------------------------------------------------------------------------
201  if (io%verbose > 0) &
202  write(stdout,*) 'cartesian_t%init: init boundaries'
203  call self%task_list%init_bdries
204  !-----------------------------------------------------------------------------
205  if (io_unit%master) then
206  write (io_unit%nml, cartesian_params)
207  flush (io_unit%nml)
208  end if
209  if (io%verbose > 0) &
210  write(stdout,*) 'cartesian_t%init: diagnostics'
211  call self%diagnostics()
212  if (io%verbose > 0) &
213  write(stdout,*) 'cartesian_t%init: print tasks'
214  call self%task_list%print_tasks
215  if (io%verbose > 0) &
216  write(stdout,*) 'cartesian_t%init: done'
217  flush (stdout)
218  !-----------------------------------------------------------------------------
219  call trace%end ()
220 END SUBROUTINE init
221 
222 SUBROUTINE init_exp (self, origin)
223  class(cartesian_t):: self
224  real(8):: origin(3)
225  !.............................................................................
226  type(link_t), pointer:: link
227  class(task_t), pointer:: task
228  class(experiment_t), pointer:: patch
229  integer:: id
230  !-----------------------------------------------------------------------------
231  id = 0
232  link => self%task_list%head
233  do while (associated(link))
234  id = id+1
235  if (.not.omp_init .or. mod(id,omp%nthreads)==omp%thread) then
236  task => link%task
237  select type (task)
238  class is (experiment_t)
239  patch => task
240  call patch%init
241  if (omp_init .and. omp%nthreads>1) then
242  task%mem_thread = omp%thread
243  else
244  task%mem_thread = -1
245  end if
246  patch%mesh%origin = origin
247  !$omp atomic
248  np = np + 1
249  ! Set physical boundary bits if required.
250  if (.not.patch%periodic(1).and.patch%ipos(1)==0) call patch%boundaries%set(bits%xl)
251  if (.not.patch%periodic(2).and.patch%ipos(2)==0) call patch%boundaries%set(bits%yl)
252  if (.not.patch%periodic(3).and.patch%ipos(3)==0) call patch%boundaries%set(bits%zl)
253  if (.not.patch%periodic(1).and.patch%ipos(1)==self%dims(1)-1) call patch%boundaries%set(bits%xu)
254  if (.not.patch%periodic(2).and.patch%ipos(2)==self%dims(2)-1) call patch%boundaries%set(bits%yu)
255  if (.not.patch%periodic(3).and.patch%ipos(3)==self%dims(3)-1) call patch%boundaries%set(bits%zu)
256  if (io%verbose>0) then
257  write (io_unit%log,1) &
258  'cartesian_t%init: id, rank, size, pos =', &
259  patch%id, patch%rank, patch%size, patch%position, &
260  patch%is_set(bits%boundary), patch%is_set(bits%virtual)
261  1 format(a,i8,i6,1p,2(2x,3e14.6),2x,2l1,2x,a)
262  flush (io_unit%log)
263  end if
264  if (patch%id == io%id_debug) then
265  write (io_unit%output,1) &
266  'cartesian_t%init: id, rank, size, pos =', &
267  patch%id, patch%rank, patch%size, patch%position, &
268  patch%is_set(bits%boundary), patch%is_set(bits%virtual), 'DBG'
269  flush (io_unit%log)
270  else if (io_unit%verbose>1 .and. io_unit%master) then
271  write (io_unit%output,1) &
272  'cartesian_t%init: id, rank, size, pos =', &
273  patch%id, patch%rank, patch%size, patch%position, &
274  patch%is_set(bits%boundary), patch%is_set(bits%virtual)
275  flush (io_unit%log)
276  end if
277  end select
278  end if
279  link => link%next
280  end do
281 END SUBROUTINE init_exp
282 
283 !===============================================================================
284 !> Diagnostics: Number of patches and GB of mem
285 !===============================================================================
286 SUBROUTINE diagnostics
287  if (mpi%master) then
288  print '(a,i8)', ' Patches per process:', np
289  end if
290 END SUBROUTINE diagnostics
291 
292 END MODULE cartesian_mod
Each thread uses a private timer data type, with arrays for start time and total time for each regist...
Definition: timer_mod.f90:11
Support tic/toc timing, as in MATLAB, and accurate wallclock() function. The timing is generally much...
Template module for patches, which adds pointers to memory and mesh, and number of dimensions and var...
Definition: patch_mod.f90:6
Task list data type, with methods for startup and updates. Message handling is inherited from the tas...
Definition: io_mod.f90:4
Template module for tasks.
Definition: task_mod.f90:4