Line data Source code
1 : #ifdef ncdf
2 : #define USE_NETCDF
3 : #endif
4 : !|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
5 :
6 : module ice_domain
7 :
8 : ! This module contains the model domain and routines for initializing
9 : ! the domain. It also initializes the decompositions and
10 : ! distributions across processors/threads by calling relevant
11 : ! routines in the block, distribution modules.
12 : !
13 : ! author: Phil Jones, LANL
14 : ! Oct. 2004: Adapted from POP by William H. Lipscomb, LANL
15 : ! Feb. 2007: E. Hunke removed NE and SW boundary options (they were buggy
16 : ! and not used anyhow).
17 :
18 : use ice_kinds_mod
19 : use ice_constants, only: shlat, nhlat
20 : use ice_communicate, only: my_task, master_task, get_num_procs, &
21 : add_mpi_barriers, ice_barrier
22 : use ice_broadcast, only: broadcast_scalar, broadcast_array
23 : use ice_blocks, only: block, get_block, create_blocks, nghost, &
24 : nblocks_x, nblocks_y, nblocks_tot, nx_block, ny_block, debug_blocks
25 : use ice_distribution, only: distrb
26 : use ice_boundary, only: ice_halo
27 : use ice_exit, only: abort_ice
28 : use ice_fileunits, only: nu_nml, nml_filename, nu_diag, &
29 : get_fileunit, release_fileunit, flush_fileunit
30 : use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted
31 : use icepack_intfc, only: icepack_query_parameters
32 :
33 : #ifdef USE_NETCDF
34 : use netcdf
35 : #endif
36 :
37 : implicit none
38 : private
39 :
40 : public :: init_domain_blocks ,&
41 : init_domain_distribution
42 :
43 : integer (int_kind), public :: &
44 : nblocks ! actual number of blocks on this processor
45 :
46 : logical (kind=log_kind), public :: &
47 : close_boundaries
48 :
49 : integer (int_kind), dimension(:), pointer, public :: &
50 : blocks_ice => null() ! block ids for local blocks
51 :
52 : type (distrb), public :: &
53 : distrb_info ! block distribution info
54 :
55 : type (ice_halo), public :: &
56 : halo_info ! ghost cell update info
57 :
58 : character (char_len), public :: &
59 : ew_boundary_type, &! type of domain bndy in each logical ! LCOV_EXCL_LINE
60 : ns_boundary_type ! direction (ew is i, ns is j)
61 :
62 : logical (kind=log_kind), public :: &
63 : maskhalo_dyn , & ! if true, use masked halo updates for dynamics ! LCOV_EXCL_LINE
64 : maskhalo_remap , & ! if true, use masked halo updates for transport ! LCOV_EXCL_LINE
65 : maskhalo_bound , & ! if true, use masked halo updates for bound_state ! LCOV_EXCL_LINE
66 : halo_dynbundle , & ! if true, bundle halo update in dynamics ! LCOV_EXCL_LINE
67 : landblockelim , & ! if true, land block elimination is on ! LCOV_EXCL_LINE
68 : orca_halogrid ! if true, input fields are haloed as defined by orca grid
69 :
70 : !-----------------------------------------------------------------------
71 : !
72 : ! module private variables - for the most part these appear as
73 : ! module variables to facilitate sharing info between init_domain1
74 : ! and init_domain2.
75 : !
76 : !-----------------------------------------------------------------------
77 :
78 : character (char_len) :: &
79 : distribution_type, &! method to use for distributing blocks ! LCOV_EXCL_LINE
80 : ! 'cartesian', 'roundrobin', 'sectrobin', 'sectcart'
81 : ! 'rake', 'spacecurve', etc
82 : distribution_wght ! method for weighting work per block
83 : ! 'block' = POP default configuration
84 : ! 'blockall' = no land block elimination
85 : ! 'latitude' = no. ocean points * |lat|
86 : ! 'file' = read distribution_wgth_file
87 : character (char_len_long) :: &
88 : distribution_wght_file ! file for distribution_wght=file
89 :
90 : integer (int_kind) :: &
91 : nprocs ! num of processors
92 :
93 : !***********************************************************************
94 :
95 : contains
96 :
97 : !***********************************************************************
98 :
99 37 : subroutine init_domain_blocks
100 :
101 : ! This routine reads in domain information and calls the routine
102 : ! to set up the block decomposition.
103 :
104 : use ice_distribution, only: processor_shape
105 : use ice_domain_size, only: ncat, nilyr, nslyr, max_blocks, &
106 : nx_global, ny_global, block_size_x, block_size_y
107 : use ice_fileunits, only: goto_nml
108 : !----------------------------------------------------------------------
109 : !
110 : ! local variables
111 : !
112 : !----------------------------------------------------------------------
113 :
114 : integer (int_kind) :: &
115 : nml_error ! namelist read error flag
116 :
117 : character(len=char_len) :: nml_name ! text namelist name
118 : character(len=char_len_long) :: tmpstr2 ! for namelist check
119 :
120 : character(len=*), parameter :: subname = '(init_domain_blocks)'
121 :
122 : !----------------------------------------------------------------------
123 : !
124 : ! input namelists
125 : !
126 : !----------------------------------------------------------------------
127 :
128 : namelist /domain_nml/ nprocs, &
129 : max_blocks, & ! LCOV_EXCL_LINE
130 : block_size_x, & ! LCOV_EXCL_LINE
131 : block_size_y, & ! LCOV_EXCL_LINE
132 : nx_global, & ! LCOV_EXCL_LINE
133 : ny_global, & ! LCOV_EXCL_LINE
134 : processor_shape, & ! LCOV_EXCL_LINE
135 : distribution_type, & ! LCOV_EXCL_LINE
136 : distribution_wght, & ! LCOV_EXCL_LINE
137 : distribution_wght_file, & ! LCOV_EXCL_LINE
138 : ew_boundary_type, & ! LCOV_EXCL_LINE
139 : ns_boundary_type, & ! LCOV_EXCL_LINE
140 : maskhalo_dyn, & ! LCOV_EXCL_LINE
141 : maskhalo_remap, & ! LCOV_EXCL_LINE
142 : maskhalo_bound, & ! LCOV_EXCL_LINE
143 : add_mpi_barriers, & ! LCOV_EXCL_LINE
144 : debug_blocks
145 :
146 : !----------------------------------------------------------------------
147 : !
148 : ! read domain information from namelist input
149 : !
150 : !----------------------------------------------------------------------
151 :
152 37 : nprocs = -1
153 37 : processor_shape = 'slenderX2'
154 37 : distribution_type = 'cartesian'
155 37 : distribution_wght = 'latitude'
156 37 : distribution_wght_file = 'unknown'
157 37 : ew_boundary_type = 'cyclic'
158 37 : ns_boundary_type = 'open'
159 37 : maskhalo_dyn = .false. ! if true, use masked halos for dynamics
160 37 : maskhalo_remap = .false. ! if true, use masked halos for transport
161 37 : maskhalo_bound = .false. ! if true, use masked halos for bound_state
162 37 : halo_dynbundle = .true. ! if true, bundle halo updates in dynamics
163 37 : add_mpi_barriers = .false. ! if true, throttle communication
164 37 : debug_blocks = .false. ! if true, print verbose block information
165 37 : max_blocks = -1 ! max number of blocks per processor
166 37 : block_size_x = -1 ! size of block in first horiz dimension
167 37 : block_size_y = -1 ! size of block in second horiz dimension
168 37 : nx_global = -1 ! NXGLOB, i-axis size
169 37 : ny_global = -1 ! NYGLOB, j-axis size
170 37 : landblockelim = .true. ! on by default
171 :
172 37 : if (my_task == master_task) then
173 7 : nml_name = 'domain_nml'
174 7 : write(nu_diag,*) subname,' Reading ', trim(nml_name)
175 :
176 7 : call get_fileunit(nu_nml)
177 7 : open (nu_nml, file=trim(nml_filename), status='old',iostat=nml_error)
178 7 : if (nml_error /= 0) then
179 : call abort_ice(subname//'ERROR: domain_nml open file '// &
180 : trim(nml_filename), & ! LCOV_EXCL_LINE
181 0 : file=__FILE__, line=__LINE__)
182 : endif
183 :
184 7 : call goto_nml(nu_nml,trim(nml_name),nml_error)
185 7 : if (nml_error /= 0) then
186 : call abort_ice(subname//'ERROR: searching for '// trim(nml_name), &
187 0 : file=__FILE__, line=__LINE__)
188 : endif
189 :
190 7 : nml_error = 1
191 14 : do while (nml_error > 0)
192 7 : read(nu_nml, nml=domain_nml,iostat=nml_error)
193 : ! check if error
194 7 : if (nml_error /= 0) then
195 : ! backspace and re-read erroneous line
196 0 : backspace(nu_nml)
197 0 : read(nu_nml,fmt='(A)') tmpstr2
198 : call abort_ice(subname//'ERROR: ' // trim(nml_name) // ' reading ' // &
199 0 : trim(tmpstr2), file=__FILE__, line=__LINE__)
200 : endif
201 : end do
202 :
203 7 : close(nu_nml)
204 7 : call release_fileunit(nu_nml)
205 :
206 : endif
207 :
208 37 : call broadcast_scalar(nprocs, master_task)
209 37 : call broadcast_scalar(processor_shape, master_task)
210 37 : call broadcast_scalar(distribution_type, master_task)
211 37 : call broadcast_scalar(distribution_wght, master_task)
212 37 : call broadcast_scalar(distribution_wght_file, master_task)
213 37 : call broadcast_scalar(ew_boundary_type, master_task)
214 37 : call broadcast_scalar(ns_boundary_type, master_task)
215 37 : call broadcast_scalar(maskhalo_dyn, master_task)
216 37 : call broadcast_scalar(maskhalo_remap, master_task)
217 37 : call broadcast_scalar(maskhalo_bound, master_task)
218 37 : call broadcast_scalar(add_mpi_barriers, master_task)
219 37 : call broadcast_scalar(debug_blocks, master_task)
220 37 : if (my_task == master_task) then
221 7 : if (max_blocks < 1) then
222 : max_blocks=( ((nx_global-1)/block_size_x + 1) * &
223 0 : ((ny_global-1)/block_size_y + 1) - 1) / nprocs + 1
224 0 : max_blocks=max(1,max_blocks)
225 : write(nu_diag,'(/,a52,i6,/)') &
226 0 : '(ice_domain): max_block < 1: max_block estimated to ',max_blocks
227 : endif
228 : endif
229 37 : call broadcast_scalar(max_blocks, master_task)
230 37 : call broadcast_scalar(block_size_x, master_task)
231 37 : call broadcast_scalar(block_size_y, master_task)
232 37 : call broadcast_scalar(nx_global, master_task)
233 37 : call broadcast_scalar(ny_global, master_task)
234 :
235 : !----------------------------------------------------------------------
236 : !
237 : ! perform some basic checks on domain
238 : !
239 : !----------------------------------------------------------------------
240 :
241 37 : if (nx_global < 1 .or. ny_global < 1 .or. ncat < 1) then
242 : !***
243 : !*** domain size zero or negative
244 : !***
245 0 : call abort_ice(subname//'ERROR: Invalid domain: size < 1') ! no domain
246 37 : else if (nprocs /= get_num_procs()) then
247 : !***
248 : !*** input nprocs does not match system (eg MPI) request
249 : !***
250 : #if (defined CESMCOUPLED)
251 : nprocs = get_num_procs()
252 : #else
253 0 : write(nu_diag,*) subname,'ERROR: nprocs, get_num_procs = ',nprocs,get_num_procs()
254 0 : call abort_ice(subname//'ERROR: Input nprocs not same as system request')
255 : #endif
256 : else if (nghost < 1) then
257 : !***
258 : !*** must have at least 1 layer of ghost cells
259 : !***
260 : call abort_ice(subname//'ERROR: Not enough ghost cells allocated')
261 : endif
262 :
263 : !----------------------------------------------------------------------
264 : !
265 : ! compute block decomposition and details
266 : !
267 : !----------------------------------------------------------------------
268 :
269 : call create_blocks(nx_global, ny_global, trim(ew_boundary_type), &
270 37 : trim(ns_boundary_type))
271 :
272 : !----------------------------------------------------------------------
273 : !
274 : ! Now we need grid info before proceeding further
275 : ! Print some domain information
276 : !
277 : !----------------------------------------------------------------------
278 :
279 37 : if (my_task == master_task) then
280 7 : write(nu_diag,'(/,a18,/)')'Domain Information'
281 7 : write(nu_diag,'(a,i6)') ' Horizontal domain: nx = ', nx_global
282 7 : write(nu_diag,'(a,i6)') ' ny = ', ny_global
283 7 : write(nu_diag,'(a,i6)') ' No. of categories: nc = ', ncat
284 7 : write(nu_diag,'(a,i6)') ' No. of ice layers: ni = ', nilyr
285 7 : write(nu_diag,'(a,i6)') ' No. of snow layers:ns = ', nslyr
286 7 : write(nu_diag,'(a,i6)') ' Processors: total = ', nprocs
287 7 : write(nu_diag,'(a,a)') ' Processor shape = ', trim(processor_shape)
288 7 : write(nu_diag,'(a,a)') ' Distribution type = ', trim(distribution_type)
289 7 : write(nu_diag,'(a,a)') ' Distribution weight = ', trim(distribution_wght)
290 7 : write(nu_diag,'(a,a)') ' Distribution wght file= ', trim(distribution_wght_file)
291 7 : write(nu_diag,'(a,a)') ' ew_boundary_type = ', trim(ew_boundary_type)
292 7 : write(nu_diag,'(a,a)') ' ns_boundary_type = ', trim(ns_boundary_type)
293 7 : write(nu_diag,'(a,l6)') ' maskhalo_dyn = ', maskhalo_dyn
294 7 : write(nu_diag,'(a,l6)') ' maskhalo_remap = ', maskhalo_remap
295 7 : write(nu_diag,'(a,l6)') ' maskhalo_bound = ', maskhalo_bound
296 7 : write(nu_diag,'(a,l6)') ' add_mpi_barriers = ', add_mpi_barriers
297 7 : write(nu_diag,'(a,l6)') ' debug_blocks = ', debug_blocks
298 7 : write(nu_diag,'(a,2i6)') ' block_size_x,_y = ', block_size_x, block_size_y
299 7 : write(nu_diag,'(a,i6)') ' max_blocks = ', max_blocks
300 7 : write(nu_diag,'(a,i6,/)')' Number of ghost cells = ', nghost
301 : endif
302 :
303 : !----------------------------------------------------------------------
304 :
305 37 : end subroutine init_domain_blocks
306 :
307 : !***********************************************************************
308 :
309 37 : subroutine init_domain_distribution(KMTG,ULATG,grid_ice)
310 :
311 : ! This routine calls appropriate setup routines to distribute blocks
312 : ! across processors and defines arrays with block ids for any local
313 : ! blocks. Information about ghost cell update routines is also
314 : ! initialized here through calls to the appropriate boundary routines.
315 :
316 : use ice_boundary, only: ice_HaloCreate
317 : use ice_distribution, only: create_distribution, create_local_block_ids, ice_distributionGet
318 : use ice_domain_size, only: max_blocks, nx_global, ny_global
319 :
320 : real (dbl_kind), dimension(nx_global,ny_global), intent(in) :: &
321 : KMTG ,&! global topography ! LCOV_EXCL_LINE
322 : ULATG ! global latitude field (radians)
323 :
324 : character(len=*), intent(in) :: &
325 : grid_ice ! grid_ice, B, C, CD, etc
326 :
327 : !----------------------------------------------------------------------
328 : !
329 : ! local variables
330 : !
331 : !----------------------------------------------------------------------
332 :
333 : integer (int_kind), dimension (nx_global, ny_global) :: &
334 74 : flat ! latitude-dependent scaling factor
335 :
336 : character (char_len) :: outstring
337 :
338 : integer (int_kind), parameter :: &
339 : max_work_unit=10 ! quantize the work into values from 1,max
340 :
341 : integer (int_kind) :: &
342 : i,j,n ,&! dummy loop indices ! LCOV_EXCL_LINE
343 : ig,jg ,&! global indices ! LCOV_EXCL_LINE
344 : igm1,igp1,jgm1,jgp1,&! global indices ! LCOV_EXCL_LINE
345 : ninfo ,&! ice_distributionGet check ! LCOV_EXCL_LINE
346 : np, nlb, m ,&! debug blocks temporaries ! LCOV_EXCL_LINE
347 : work_unit ,&! size of quantized work unit ! LCOV_EXCL_LINE
348 : #ifdef USE_NETCDF
349 : fid ,&! file id
350 : varid ,&! var id ! LCOV_EXCL_LINE
351 : status ,&! netcdf return code ! LCOV_EXCL_LINE
352 : #endif
353 : tblocks_tmp ,&! total number of blocks
354 : nblocks_tmp ,&! temporary value of nblocks ! LCOV_EXCL_LINE
355 : nblocks_max ! max blocks on proc
356 :
357 : real (dbl_kind) :: &
358 : puny, & ! puny limit ! LCOV_EXCL_LINE
359 8 : rad_to_deg ! radians to degrees
360 :
361 : integer (int_kind), dimension(:), allocatable :: &
362 : blkinfo ,&! ice_distributionGet check ! LCOV_EXCL_LINE
363 : nocn ,&! number of ocean points per block ! LCOV_EXCL_LINE
364 37 : work_per_block ! number of work units per block
365 :
366 : type (block) :: &
367 : this_block ! block information for current block
368 :
369 : real (dbl_kind), dimension(:,:), allocatable :: &
370 37 : wght ! wghts from file
371 :
372 : character(len=*), parameter :: subname = '(init_domain_distribution)'
373 :
374 : !----------------------------------------------------------------------
375 : !
376 : ! check that there are at least nghost+1 rows or columns of land cells
377 : ! for closed boundary conditions (otherwise grid lengths are zero in
378 : ! cells neighboring ocean points).
379 : !
380 : !----------------------------------------------------------------------
381 :
382 37 : call icepack_query_parameters(puny_out=puny, rad_to_deg_out=rad_to_deg)
383 37 : call icepack_warnings_flush(nu_diag)
384 37 : if (icepack_warnings_aborted()) call abort_ice(error_message=subname, &
385 0 : file=__FILE__, line=__LINE__)
386 :
387 37 : if (trim(ns_boundary_type) == 'closed') then
388 0 : call abort_ice(subname//'ERROR: ns_boundary_type = closed not supported')
389 0 : allocate(nocn(nblocks_tot))
390 0 : nocn = 0
391 0 : do n=1,nblocks_tot
392 0 : this_block = get_block(n,n)
393 0 : if (this_block%jblock == nblocks_y) then ! north edge
394 0 : do j = this_block%jhi-1, this_block%jhi
395 0 : if (this_block%j_glob(j) > 0) then
396 0 : do i = 1, nx_block
397 0 : if (this_block%i_glob(i) > 0) then
398 0 : ig = this_block%i_glob(i)
399 0 : jg = this_block%j_glob(j)
400 0 : if (KMTG(ig,jg) > puny) nocn(n) = nocn(n) + 1
401 : endif
402 : enddo
403 : endif
404 : enddo
405 : endif
406 0 : if (this_block%jblock == 1) then ! south edge
407 0 : do j = this_block%jlo, this_block%jlo+1
408 0 : if (this_block%j_glob(j) > 0) then
409 0 : do i = 1, nx_block
410 0 : if (this_block%i_glob(i) > 0) then
411 0 : ig = this_block%i_glob(i)
412 0 : jg = this_block%j_glob(j)
413 0 : if (KMTG(ig,jg) > puny) nocn(n) = nocn(n) + 1
414 : endif
415 : enddo
416 : endif
417 : enddo
418 : endif
419 0 : if (nocn(n) > 0) then
420 0 : write(nu_diag,*) subname,'ns closed, Not enough land cells along ns edge'
421 0 : call abort_ice(subname//'ERROR: Not enough land cells along ns edge for ns closed')
422 : endif
423 : enddo
424 0 : deallocate(nocn)
425 : endif
426 37 : if (trim(ew_boundary_type) == 'closed') then
427 0 : call abort_ice(subname//'ERROR: ew_boundary_type = closed not supported')
428 0 : allocate(nocn(nblocks_tot))
429 0 : nocn = 0
430 0 : do n=1,nblocks_tot
431 0 : this_block = get_block(n,n)
432 0 : if (this_block%iblock == nblocks_x) then ! east edge
433 0 : do j = 1, ny_block
434 0 : if (this_block%j_glob(j) > 0) then
435 0 : do i = this_block%ihi-1, this_block%ihi
436 0 : if (this_block%i_glob(i) > 0) then
437 0 : ig = this_block%i_glob(i)
438 0 : jg = this_block%j_glob(j)
439 0 : if (KMTG(ig,jg) > puny) nocn(n) = nocn(n) + 1
440 : endif
441 : enddo
442 : endif
443 : enddo
444 : endif
445 0 : if (this_block%iblock == 1) then ! west edge
446 0 : do j = 1, ny_block
447 0 : if (this_block%j_glob(j) > 0) then
448 0 : do i = this_block%ilo, this_block%ilo+1
449 0 : if (this_block%i_glob(i) > 0) then
450 0 : ig = this_block%i_glob(i)
451 0 : jg = this_block%j_glob(j)
452 0 : if (KMTG(ig,jg) > puny) nocn(n) = nocn(n) + 1
453 : endif
454 : enddo
455 : endif
456 : enddo
457 : endif
458 0 : if (nocn(n) > 0) then
459 0 : write(nu_diag,*) subname,'ew closed, Not enough land cells along ew edge'
460 0 : call abort_ice(subname//'ERROR: Not enough land cells along ew edge for ew closed')
461 : endif
462 : enddo
463 0 : deallocate(nocn)
464 : endif
465 :
466 : !----------------------------------------------------------------------
467 : !
468 : ! estimate the amount of work per processor using the topography
469 : ! and latitude
470 : !
471 : !----------------------------------------------------------------------
472 :
473 37 : if (distribution_wght == 'latitude') then
474 510265 : flat = max(NINT(abs(ULATG*rad_to_deg), int_kind),1) ! linear function
475 : else
476 0 : flat = 1
477 : endif
478 :
479 37 : if (distribution_wght == 'blockall') landblockelim = .false.
480 :
481 37 : allocate(nocn(nblocks_tot))
482 :
483 37 : if (distribution_wght == 'file') then
484 0 : allocate(wght(nx_global,ny_global))
485 0 : if (my_task == master_task) then
486 : ! cannot use ice_read_write due to circular dependency
487 : #ifdef USE_NETCDF
488 0 : status = nf90_open(distribution_wght_file, NF90_NOWRITE, fid)
489 0 : if (status /= nf90_noerr) then
490 0 : call abort_ice (subname//'ERROR: Cannot open '//trim(distribution_wght_file))
491 : endif
492 0 : status = nf90_inq_varid(fid, 'wght', varid)
493 0 : status = nf90_get_var(fid, varid, wght)
494 0 : status = nf90_close(fid)
495 0 : write(nu_diag,*) 'read ',trim(distribution_wght_file),minval(wght),maxval(wght)
496 : #else
497 : call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', &
498 : file=__FILE__, line=__LINE__)
499 : #endif
500 : endif
501 0 : call broadcast_array(wght, master_task)
502 0 : nocn = 0
503 0 : do n=1,nblocks_tot
504 0 : this_block = get_block(n,n)
505 0 : do j=this_block%jlo,this_block%jhi
506 0 : if (this_block%j_glob(j) > 0) then
507 0 : do i=this_block%ilo,this_block%ihi
508 0 : if (this_block%i_glob(i) > 0) then
509 0 : ig = this_block%i_glob(i)
510 0 : jg = this_block%j_glob(j)
511 : ! if (KMTG(ig,jg) > puny) &
512 : ! nocn(n) = max(nocn(n),nint(wght(ig,jg)+1.0_dbl_kind))
513 0 : if (KMTG(ig,jg) > puny) then
514 0 : if (wght(ig,jg) > 0.00001_dbl_kind) then
515 0 : nocn(n) = nocn(n)+nint(wght(ig,jg))
516 : else
517 0 : nocn(n) = max(nocn(n),1)
518 : endif
519 : endif
520 : endif
521 : end do
522 : endif
523 : end do
524 : enddo
525 0 : deallocate(wght)
526 : else
527 1126 : nocn = 0
528 1126 : do n=1,nblocks_tot
529 1089 : this_block = get_block(n,n)
530 33525 : do j=this_block%jlo,this_block%jhi
531 33525 : if (this_block%j_glob(j) > 0) then
532 538180 : do i=this_block%ilo,this_block%ihi
533 538180 : if (this_block%i_glob(i) > 0) then
534 505744 : ig = this_block%i_glob(i)
535 505744 : jg = this_block%j_glob(j)
536 505744 : if (grid_ice == 'C' .or. grid_ice == 'CD') then
537 : ! Have to be careful about block elimination with C/CD
538 : ! Use a bigger stencil
539 0 : igm1 = mod(ig-2+nx_global,nx_global)+1
540 0 : igp1 = mod(ig,nx_global)+1
541 0 : jgm1 = max(jg-1,1)
542 0 : jgp1 = min(jg+1,ny_global)
543 0 : if ((KMTG(ig ,jg ) > puny .or. &
544 : KMTG(igm1,jg ) > puny .or. KMTG(igp1,jg ) > puny .or. & ! LCOV_EXCL_LINE
545 : KMTG(ig ,jgp1) > puny .or. KMTG(ig ,jgm1) > puny) .and. & ! LCOV_EXCL_LINE
546 : (ULATG(ig,jg) < shlat/rad_to_deg .or. & ! LCOV_EXCL_LINE
547 : ULATG(ig,jg) > nhlat/rad_to_deg) ) & ! LCOV_EXCL_LINE
548 0 : nocn(n) = nocn(n) + flat(ig,jg)
549 : else
550 598544 : if (KMTG(ig,jg) > puny .and. &
551 : (ULATG(ig,jg) < shlat/rad_to_deg .or. & ! LCOV_EXCL_LINE
552 : ULATG(ig,jg) > nhlat/rad_to_deg) ) & ! LCOV_EXCL_LINE
553 430270 : nocn(n) = nocn(n) + flat(ig,jg)
554 : endif
555 : endif
556 : end do
557 : endif
558 : end do
559 :
560 : !*** with array syntax, we actually do work on non-ocean
561 : !*** points, so where the block is not completely land,
562 : !*** reset nocn to be the full size of the block
563 :
564 : ! use processor_shape = 'square-pop' and distribution_wght = 'block'
565 : ! to make CICE and POP decompositions/distributions identical.
566 :
567 : #ifdef CICE_IN_NEMO
568 : ! Keep all blocks even the ones only containing land points
569 : if (distribution_wght == 'block') nocn(n) = nx_block*ny_block
570 : #else
571 1089 : if (distribution_wght == 'block' .and. nocn(n) > 0) nocn(n) = nx_block*ny_block
572 1126 : if (.not. landblockelim) nocn(n) = max(nocn(n),1)
573 : #endif
574 : end do
575 : endif ! distribution_wght = file
576 :
577 1126 : work_unit = maxval(nocn)/max_work_unit + 1
578 :
579 : !*** find number of work units per block
580 :
581 37 : allocate(work_per_block(nblocks_tot))
582 :
583 5514 : where (nocn > 1)
584 8 : work_per_block = nocn/work_unit + 2
585 8 : elsewhere (nocn == 1)
586 8 : work_per_block = nocn/work_unit + 1
587 : elsewhere
588 8 : work_per_block = 0
589 : end where
590 37 : if (my_task == master_task) then
591 7 : write(nu_diag,*) 'ice_domain work_unit, max_work_unit = ',work_unit, max_work_unit
592 490 : write(nu_diag,*) 'ice_domain nocn = ',minval(nocn),maxval(nocn),sum(nocn)
593 490 : write(nu_diag,*) 'ice_domain work_per_block = ',minval(work_per_block),maxval(work_per_block),sum(work_per_block)
594 : endif
595 37 : deallocate(nocn)
596 :
597 :
598 : !----------------------------------------------------------------------
599 : !
600 : ! determine the distribution of blocks across processors
601 : !
602 : !----------------------------------------------------------------------
603 :
604 : distrb_info = create_distribution(distribution_type, &
605 37 : nprocs, work_per_block)
606 :
607 37 : deallocate(work_per_block)
608 :
609 : !----------------------------------------------------------------------
610 : !
611 : ! allocate and determine block id for any local blocks
612 : !
613 : !----------------------------------------------------------------------
614 :
615 37 : call create_local_block_ids(blocks_ice, distrb_info)
616 :
617 : ! write out block distribution
618 : ! internal check of icedistributionGet as part of verification process
619 37 : if (debug_blocks) then
620 :
621 0 : call flush_fileunit(nu_diag)
622 0 : call ice_barrier()
623 0 : if (my_task == master_task) then
624 0 : write(nu_diag,*) ' '
625 0 : write(nu_diag,'(2a)') subname, ' Blocks by Proc:'
626 : endif
627 0 : call ice_distributionGet(distrb_info, nprocs=np, numLocalBlocks=nlb)
628 0 : do m = 1, np
629 0 : if (m == my_task+1) then
630 0 : do n=1,nlb
631 : write(nu_diag,'(2a,3i8)') &
632 : subname,' my_task, local block ID, global block ID: ', & ! LCOV_EXCL_LINE
633 0 : my_task, n, distrb_info%blockGlobalID(n)
634 : enddo
635 0 : call flush_fileunit(nu_diag)
636 : endif
637 0 : call ice_barrier()
638 : enddo
639 :
640 0 : if (my_task == master_task) then
641 0 : write(nu_diag,*) ' '
642 0 : write(nu_diag,'(2a)') subname, ' Blocks by Global Block ID:'
643 0 : do m = 1, nblocks_tot
644 : write(nu_diag,'(2a,3i8)') &
645 : subname,' global block id, proc, local block ID: ', & ! LCOV_EXCL_LINE
646 0 : m, distrb_info%blockLocation(m), distrb_info%blockLocalID(m)
647 : enddo
648 0 : call flush_fileunit(nu_diag)
649 : endif
650 0 : call ice_barrier()
651 :
652 0 : call ice_distributionGet(distrb_info, nprocs=ninfo)
653 0 : if (ninfo /= distrb_info%nprocs) &
654 0 : call abort_ice(subname//' ice_distributionGet nprocs ERROR', file=__FILE__, line=__LINE__)
655 :
656 0 : call ice_distributionGet(distrb_info, communicator=ninfo)
657 0 : if (ninfo /= distrb_info%communicator) &
658 0 : call abort_ice(subname//' ice_distributionGet communicator ERROR', file=__FILE__, line=__LINE__)
659 :
660 0 : call ice_distributionGet(distrb_info, numLocalBlocks=ninfo)
661 0 : if (ninfo /= distrb_info%numLocalBlocks) &
662 0 : call abort_ice(subname//' ice_distributionGet numLocalBlocks ERROR', file=__FILE__, line=__LINE__)
663 :
664 0 : allocate(blkinfo(ninfo))
665 :
666 0 : call ice_distributionGet(distrb_info, blockGlobalID = blkinfo)
667 0 : do n = 1, ninfo
668 0 : if (blkinfo(n) /= distrb_info%blockGlobalID(n)) &
669 0 : call abort_ice(subname//' ice_distributionGet blockGlobalID ERROR', file=__FILE__, line=__LINE__)
670 : enddo
671 :
672 0 : deallocate(blkinfo)
673 0 : allocate(blkinfo(nblocks_tot))
674 :
675 0 : call ice_distributionGet(distrb_info, blockLocation = blkinfo)
676 0 : do n = 1, nblocks_tot
677 0 : if (blkinfo(n) /= distrb_info%blockLocation(n)) &
678 0 : call abort_ice(subname//' ice_distributionGet blockLocation ERROR', file=__FILE__, line=__LINE__)
679 : enddo
680 :
681 0 : call ice_distributionGet(distrb_info, blockLocalID = blkinfo)
682 0 : do n = 1, nblocks_tot
683 0 : if (blkinfo(n) /= distrb_info%blockLocalID(n)) &
684 0 : call abort_ice(subname//' ice_distributionGet blockLocalID ERROR', file=__FILE__, line=__LINE__)
685 : enddo
686 :
687 0 : deallocate(blkinfo)
688 :
689 0 : if (my_task == master_task) then
690 0 : write(nu_diag,*) ' '
691 0 : write(nu_diag,'(2a)') subname,' ice_distributionGet checks pass'
692 0 : write(nu_diag,*) ' '
693 : endif
694 : endif
695 :
696 37 : if (associated(blocks_ice)) then
697 37 : nblocks = size(blocks_ice)
698 : else
699 0 : nblocks = 0
700 : endif
701 37 : nblocks_max = 0
702 37 : tblocks_tmp = 0
703 278 : do n=0,distrb_info%nprocs - 1
704 241 : nblocks_tmp = nblocks
705 241 : call broadcast_scalar(nblocks_tmp, n)
706 241 : nblocks_max = max(nblocks_max,nblocks_tmp)
707 278 : tblocks_tmp = tblocks_tmp + nblocks_tmp
708 : end do
709 :
710 37 : if (my_task == master_task) then
711 : write(nu_diag,*) &
712 7 : 'ice: total number of blocks is', tblocks_tmp
713 : endif
714 :
715 37 : if (nblocks_max > max_blocks) then
716 : write(outstring,*) &
717 0 : 'ERROR: num blocks exceed max: increase max to', nblocks_max
718 : call abort_ice(subname//trim(outstring), &
719 0 : file=__FILE__, line=__LINE__)
720 37 : else if (nblocks_max < max_blocks) then
721 : write(outstring,*) &
722 0 : 'WARNING: ice no. blocks too large: decrease max to', nblocks_max
723 0 : if (my_task == master_task) then
724 0 : write(nu_diag,*) ' ********WARNING***********'
725 0 : write(nu_diag,*) subname,trim(outstring)
726 0 : write(nu_diag,*) ' **************************'
727 0 : write(nu_diag,*) ' '
728 : endif
729 : endif
730 :
731 : !----------------------------------------------------------------------
732 : !
733 : ! Set up ghost cell updates for each distribution.
734 : ! Boundary types are cyclic, closed, tripole or tripoleT.
735 : !
736 : !----------------------------------------------------------------------
737 :
738 : ! update ghost cells on all four boundaries
739 : halo_info = ice_HaloCreate(distrb_info, &
740 : trim(ns_boundary_type), & ! LCOV_EXCL_LINE
741 : trim(ew_boundary_type), & ! LCOV_EXCL_LINE
742 37 : nx_global)
743 :
744 : !----------------------------------------------------------------------
745 :
746 74 : end subroutine init_domain_distribution
747 :
748 : !***********************************************************************
749 :
750 : end module ice_domain
751 :
752 : !|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
|
