25 procedure,
nopass:: diagnostics
27 logical:: omp_init=.false.
36 SUBROUTINE init (self, label)
38 character(len=*),
optional:: label
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]
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, &
57 character(len=120):: ids = &
58 '$Id: e71d387b943008f46d0f441b4ecad422725030df $ components/cartesian_mod.f90' 60 call trace%begin (
'cartesian_t%init')
61 call io%header(
'begin cartesian_t%init: Cartesian patch arrangement')
62 call trace%print_id (ids)
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
69 per_rank = dims/mpi_dims
79 if (mpi%size == 1)
then 82 if (product(mpi_dims)==1)
then 83 call mpi_coords%init (dims=dims)
85 call mpi_coords%init (mpi_dims=mpi_dims)
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
95 rank%periodic = .true.
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
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
108 self%task_list%n_tasks = product(self%dims)
109 self%task_list%face_nbors = face_nbors
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
123 patch%rank = mpi_coords%coords_to_rank ([i,j,k]/patches_per_mpi)
124 if (patch%rank == mpi%rank)
then 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)
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)
149 call self%task_list%append_link (link)
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
164 link => self%task_list%head
165 do while (
associated(link))
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)
178 if (io%verbose > 0)
write(stdout,*)
'cartesian_t%init: count status' 179 call self%task_list%count_status
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
193 call init_exp (self, origin)
196 call init_exp (self, origin)
201 if (io%verbose > 0) &
202 write(stdout,*)
'cartesian_t%init: init boundaries' 203 call self%task_list%init_bdries
205 if (io_unit%master)
then 206 write (io_unit%nml, cartesian_params)
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' 222 SUBROUTINE init_exp (self, origin)
226 type(
link_t),
pointer:: link
227 class(
task_t),
pointer:: task
228 class(experiment_t),
pointer:: patch
232 link => self%task_list%head
233 do while (
associated(link))
235 if (.not.omp_init .or. mod(id,omp%nthreads)==omp%thread)
then 238 class is (experiment_t)
241 if (omp_init .and. omp%nthreads>1)
then 242 task%mem_thread = omp%thread
246 patch%mesh%origin = origin
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)
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' 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)
281 END SUBROUTINE init_exp
286 SUBROUTINE diagnostics
288 print
'(a,i8)',
' Patches per process:', np
290 END SUBROUTINE diagnostics
292 END MODULE cartesian_mod
Each thread uses a private timer data type, with arrays for start time and total time for each regist...
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...
Task list data type, with methods for startup and updates. Message handling is inherited from the tas...
Module with list handling for generic class task_t objects.
Template module for tasks.