Line data Source code
1 : module phys_grid
2 :
3 : !------------------------------------------------------------------------------
4 : !
5 : ! The phys_grid module represents the CAM physics decomposition.
6 : !
7 : ! phys_grid_init receives the physics column info (area, weight, centers)
8 : ! from the dycore.
9 : ! The routine then creates the physics decomposition which
10 : ! is the arrangement of columns across the atmosphere model's
11 : ! MPI tasks as well as the arrangement into groups to
12 : ! facilitate efficient threading.
13 : ! The routine then creates a grid object to allow for data
14 : ! to be read into and written from this decomposition.
15 : ! The phys_grid module also provides interfaces for retrieving information
16 : ! about the decomposition
17 : !
18 : ! Note: This current implementation does not perform load balancing,
19 : ! physics columns ae always on the same task as the corresponding
20 : ! column received from the dycore.
21 : !
22 : !------------------------------------------------------------------------------
23 : use shr_kind_mod, only: r8 => shr_kind_r8
24 : use ppgrid, only: begchunk, endchunk, pver, pverp, pcols
25 : use physics_column_type, only: physics_column_t
26 : use perf_mod, only: t_adj_detailf, t_startf, t_stopf
27 :
28 : implicit none
29 : private
30 : save
31 :
32 : !!XXgoldyXX: v This needs to be removed to complete the weak scaling transition.
33 : public :: SCATTER_FIELD_TO_CHUNK
34 : !!XXgoldyXX: ^ This needs to be removed to complete the weak scaling transition.
35 :
36 : ! Physics grid management
37 : public :: phys_grid_init ! initialize the physics grid
38 : public :: phys_grid_readnl ! Read the phys_grid_nl namelist
39 : public :: phys_grid_initialized
40 : ! Local task interfaces
41 : public :: get_nlcols_p ! Number of local columns
42 : public :: get_area_p ! area of a physics column in radians squared
43 : public :: get_wght_p ! weight of a physics column in radians squared
44 : public :: get_rlat_p ! latitude of a physics column in radians
45 : public :: get_rlon_p ! longitude of a physics column in radians
46 : public :: get_rlat_all_p ! latitudes of physics cols in chunk (radians)
47 : public :: get_rlon_all_p ! longitudes of physics cols in chunk (radians)
48 : public :: get_lat_p ! latitude of a physics column in degrees
49 : public :: get_lon_p ! longitude of a physics column in degrees
50 : public :: get_lat_all_p ! latitudes of physics cols in chunk (degrees)
51 : public :: get_lon_all_p ! longitudes of physics cols in chunk (degrees)
52 : public :: get_area_all_p ! areas of physics cols in chunk
53 : public :: get_wght_all_p ! weights of physics cols in chunk
54 : public :: get_ncols_p ! number of columns in a chunk
55 : public :: get_gcol_p ! global column index of a physics column
56 : public :: get_gcol_all_p ! global col index of all phys cols in a chunk
57 : public :: get_dyn_col_p ! dynamics local blk number and blk offset(s)
58 : public :: get_chunk_info_p ! chunk index and col # of a physics column
59 : public :: get_grid_dims ! return grid dimensions
60 : ! Physics-dynamics coupling
61 : public :: phys_decomp_to_dyn ! Transfer physics data to dynamics decomp
62 : public :: dyn_decomp_to_phys ! Transfer dynamics data to physics decomp
63 :
64 : ! The identifier for the physics grid
65 : integer, parameter, public :: phys_decomp = 100
66 : integer, parameter, public :: phys_decomp_scm = 200
67 :
68 : !! PUBLIC TYPES
69 :
70 : ! Physics chunking (thread blocking) data
71 : ! Note that chunks cover local data
72 : type, public :: chunk
73 : integer, private :: ncols = 1 ! # of grid columns in this chunk
74 : integer, private :: chunk_index = -1 ! Local index of this chunk
75 : integer, private, allocatable :: phys_cols(:) ! phys column indices
76 : end type chunk
77 :
78 : !! PRIVATE DATA
79 :
80 : ! dynamics field grid information
81 : ! hdim1_d and hdim2_d are dimensions of rectangular horizontal grid
82 : ! data structure, If 1D data structure, then hdim2_d == 1.
83 : integer :: hdim1_d, hdim2_d
84 :
85 : ! Physics decomposition information
86 : type(physics_column_t), allocatable :: phys_columns(:)
87 :
88 : type(chunk), private, pointer :: chunks(:) => NULL() ! (begchunk:endchunk)
89 :
90 : logical :: phys_grid_set = .false.
91 :
92 : logical :: calc_memory_increase = .false.
93 :
94 : interface get_dyn_col_p
95 : module procedure :: get_dyn_col_p_chunk
96 : module procedure :: get_dyn_col_p_index
97 : end interface get_dyn_col_p
98 :
99 : ! Private interfaces
100 : private :: chunk_info_to_index_p
101 :
102 : !!XXgoldyXX: v temporary interface to allow old code to compile
103 : interface get_lat_all_p
104 : module procedure :: get_lat_all_p_r8 ! The new version
105 : module procedure :: get_lat_all_p_int ! calls endun
106 : end interface get_lat_all_p
107 :
108 : interface get_lon_all_p
109 : module procedure :: get_lon_all_p_r8 ! The new version
110 : module procedure :: get_lon_all_p_int ! calls endun
111 : end interface get_lon_all_p
112 : !!XXgoldyXX: ^ temporary interface to allow old code to compile
113 :
114 : integer, protected, public :: num_global_phys_cols = 0
115 : integer, protected, public :: columns_on_task = 0
116 : integer, protected, public :: index_top_layer = 0
117 : integer, protected, public :: index_bottom_layer = 0
118 : integer, protected, public :: index_top_interface = 1
119 : integer, protected, public :: index_bottom_interface = 0
120 : integer, public :: phys_columns_on_task = 0
121 :
122 : !==============================================================================
123 : CONTAINS
124 : !==============================================================================
125 :
126 1536 : subroutine phys_grid_readnl(nlfile)
127 : use cam_abortutils, only: endrun
128 : use namelist_utils, only: find_group_name
129 : use cam_logfile, only: iulog
130 : use spmd_utils, only: mpicom, mstrid=>masterprocid, masterproc
131 : use spmd_utils, only: mpi_integer
132 :
133 : character(len=*), intent(in) :: nlfile
134 :
135 : ! Local variables
136 : integer :: unitn, ierr
137 : character(len=*), parameter :: sub = 'phys_grid_readnl'
138 :
139 : integer :: phys_alltoall = -HUGE(1)
140 : integer :: phys_loadbalance = -HUGE(1)
141 : integer :: phys_twin_algorithm = -HUGE(1)
142 : integer :: phys_chnk_per_thd = -HUGE(1)
143 :
144 : namelist /phys_grid_nl/ phys_alltoall, phys_loadbalance, &
145 : phys_twin_algorithm, phys_chnk_per_thd
146 : !------------------------------------------------------------------------
147 :
148 : ! Read namelist
149 1536 : if (masterproc) then
150 2 : open(newunit=unitn, file=trim(nlfile), status='old')
151 2 : call find_group_name(unitn, 'phys_grid_nl', status=ierr)
152 2 : if (ierr == 0) then
153 0 : read(unitn, phys_grid_nl, iostat=ierr)
154 0 : if (ierr /= 0) then
155 0 : call endrun(sub//': FATAL: reading namelist')
156 : end if
157 : end if
158 2 : close(unitn)
159 : end if
160 :
161 1536 : call mpi_bcast(phys_alltoall, 1, mpi_integer, mstrid, mpicom, ierr)
162 1536 : call mpi_bcast(phys_loadbalance, 1, mpi_integer, mstrid, mpicom, ierr)
163 1536 : call mpi_bcast(phys_twin_algorithm, 1, mpi_integer, mstrid, mpicom, ierr)
164 1536 : call mpi_bcast(phys_chnk_per_thd, 1, mpi_integer, mstrid, mpicom, ierr)
165 :
166 1536 : if (masterproc) then
167 2 : write(iulog,*) 'PHYS_GRID options:'
168 2 : write(iulog,*) ' Using PCOLS =', pcols
169 2 : write(iulog,*) ' phys_loadbalance = (not used)'
170 2 : write(iulog,*) ' phys_twin_algorithm = (not used)'
171 2 : write(iulog,*) ' phys_alltoall = (not used)'
172 2 : write(iulog,*) ' chunks_per_thread = (not used)'
173 : end if
174 :
175 1536 : end subroutine phys_grid_readnl
176 :
177 : !========================================================================
178 :
179 1536 : subroutine phys_grid_init()
180 : use mpi, only: MPI_INTEGER, MPI_REAL8, MPI_MIN, MPI_MAX
181 : use shr_mem_mod, only: shr_mem_getusage
182 : use cam_abortutils, only: endrun
183 : use cam_logfile, only: iulog
184 : use spmd_utils, only: npes, mpicom, masterprocid, masterproc, iam
185 : use dyn_grid, only: get_dyn_grid_info, physgrid_copy_attributes_d
186 : use cam_grid_support, only: cam_grid_register, cam_grid_attribute_register
187 : use cam_grid_support, only: iMap, hclen => max_hcoordname_len
188 : use cam_grid_support, only: horiz_coord_t, horiz_coord_create
189 : use cam_grid_support, only: cam_grid_attribute_copy, cam_grid_attr_exists
190 : use shr_const_mod, only: PI => SHR_CONST_PI
191 : use scamMod, only: scmlon,scmlat,single_column,closeioplatidx,closeioplonidx
192 :
193 : ! Local variables
194 : integer :: index
195 : integer :: col_index, phys_col
196 : integer :: ichnk, icol, ncol, gcol
197 : integer :: num_chunks
198 1536 : type(physics_column_t), allocatable :: dyn_columns(:) ! Dyn decomp
199 : ! Maps and values for physics grid
200 1536 : real(r8), pointer :: lonvals(:)
201 1536 : real(r8), pointer :: latvals(:)
202 : real(r8) :: lonmin, latmin
203 1536 : integer(iMap), pointer :: grid_map(:,:)
204 1536 : integer(iMap), pointer :: grid_map_scm(:,:)
205 1536 : integer(iMap), allocatable :: coord_map(:)
206 : type(horiz_coord_t), pointer :: lat_coord
207 : type(horiz_coord_t), pointer :: lon_coord
208 1536 : real(r8), pointer :: area_d(:)
209 1536 : real(r8), pointer :: areawt_d(:)
210 : real(r8) :: mem_hw_beg, mem_hw_end
211 : real(r8) :: mem_beg, mem_end
212 : logical :: unstructured
213 : real(r8) :: temp ! For MPI
214 : integer :: ierr ! For MPI
215 1536 : character(len=hclen), pointer :: copy_attributes(:)
216 : character(len=hclen) :: copy_gridname
217 : character(len=*), parameter :: subname = 'phys_grid_init: '
218 : real(r8), parameter :: rarea_sphere = 1.0_r8 / (4.0_r8*PI)
219 1536 : real (r8), allocatable :: dynlats(:),dynlons(:),pos_dynlons(:)
220 : real (r8) :: pos_scmlon,minpoint,testpoint
221 : integer :: scm_col_index, i, num_lev
222 :
223 1536 : nullify(lonvals)
224 1536 : nullify(latvals)
225 1536 : nullify(grid_map)
226 0 : if (single_column) nullify(grid_map_scm)
227 1536 : nullify(lat_coord)
228 1536 : nullify(lon_coord)
229 1536 : nullify(area_d)
230 1536 : nullify(areawt_d)
231 1536 : nullify(copy_attributes)
232 :
233 1536 : if (calc_memory_increase) then
234 0 : call shr_mem_getusage(mem_hw_beg, mem_beg)
235 : end if
236 :
237 1536 : call t_adj_detailf(-2)
238 1536 : call t_startf("phys_grid_init")
239 :
240 : ! Gather info from the dycore
241 : call get_dyn_grid_info(hdim1_d, hdim2_d, num_lev, index_top_layer, &
242 1536 : index_bottom_layer, unstructured, dyn_columns)
243 :
244 : ! Set up the physics decomposition
245 1536 : columns_on_task = size(dyn_columns)
246 :
247 1536 : if (single_column) then
248 0 : allocate(dynlats(columns_on_task),dynlons(columns_on_task),pos_dynlons(columns_on_task))
249 0 : dynlats(:) = dyn_columns(:)%lat_deg
250 0 : dynlons(:) = dyn_columns(:)%lon_deg
251 :
252 0 : pos_dynlons(:)= mod(dynlons(:) + 360._r8,360._r8)
253 0 : pos_scmlon = mod(scmlon + 360._r8,360._r8)
254 :
255 0 : if (unstructured) then
256 : minpoint=1000.0_r8
257 0 : do i=1,columns_on_task
258 0 : testpoint=abs(pos_dynlons(i)-pos_scmlon)+abs(dynlats(i)-scmlat)
259 0 : if (testpoint < minpoint) then
260 0 : minpoint=testpoint
261 0 : scm_col_index=i
262 : endif
263 : enddo
264 : end if
265 0 : hdim1_d = 1
266 0 : hdim2_d = 1
267 0 : phys_columns_on_task = 1
268 0 : deallocate(dynlats,dynlons,pos_dynlons)
269 : else
270 1536 : phys_columns_on_task = columns_on_task
271 : end if
272 : ! hdim1_d * hdim2_d is the total number of columns
273 1536 : num_global_phys_cols = hdim1_d * hdim2_d
274 : !!XXgoldyXX: Can we enforce interface numbering separate from dycore?
275 : !!XXgoldyXX: This will work for both CAM and WRF/MPAS physics
276 : !!XXgoldyXX: This only has a 50% chance of working on a single level model
277 1536 : if (index_top_layer < index_bottom_layer) then
278 1536 : index_top_interface = index_top_layer
279 1536 : index_bottom_interface = index_bottom_layer + 1
280 : else
281 0 : index_bottom_interface = index_bottom_layer
282 0 : index_top_interface = index_top_layer + 1
283 : end if
284 :
285 1536 : if (allocated(phys_columns)) then
286 0 : deallocate(phys_columns)
287 : end if
288 104880 : allocate(phys_columns(phys_columns_on_task))
289 1536 : if (phys_columns_on_task > 0) then
290 1536 : col_index = phys_columns_on_task
291 1536 : num_chunks = col_index / pcols
292 1536 : if ((num_chunks * pcols) < col_index) then
293 1536 : num_chunks = num_chunks + 1
294 : end if
295 1536 : begchunk = 1
296 1536 : endchunk = begchunk + num_chunks - 1
297 : else
298 : ! We do not support tasks with no physics columns
299 0 : call endrun(subname//'No columns on task, use fewer tasks')
300 : end if
301 10800 : allocate(chunks(begchunk:endchunk))
302 1536 : col_index = 0
303 : ! Simple chunk assignment
304 7728 : do index = begchunk, endchunk
305 6192 : chunks(index)%ncols = MIN(pcols, (phys_columns_on_task - col_index))
306 6192 : chunks(index)%chunk_index = index
307 18576 : allocate(chunks(index)%phys_cols(chunks(index)%ncols))
308 104928 : do phys_col = 1, chunks(index)%ncols
309 97200 : col_index = col_index + 1
310 : ! Copy information supplied by the dycore
311 97200 : if (single_column) then
312 0 : phys_columns(col_index) = dyn_columns(scm_col_index)
313 : ! !scm physics only has 1 global column
314 0 : phys_columns(col_index)%global_col_num = 1
315 0 : phys_columns(col_index)%coord_indices(:)=scm_col_index
316 : else
317 97200 : phys_columns(col_index) = dyn_columns(col_index)
318 : end if
319 : ! Fill in physics decomp info
320 97200 : phys_columns(col_index)%phys_task = iam
321 97200 : phys_columns(col_index)%local_phys_chunk = index
322 97200 : phys_columns(col_index)%phys_chunk_index = phys_col
323 103392 : chunks(index)%phys_cols(phys_col) = col_index
324 : end do
325 : end do
326 :
327 98736 : deallocate(dyn_columns)
328 :
329 : ! Add physics-package grid to set of CAM grids
330 : ! physgrid always uses 'lat' and 'lon' as coordinate names; If dynamics
331 : ! grid is different, it will use different coordinate names
332 :
333 : ! First, create a map for the physics grid
334 : ! It's structure will depend on whether or not the physics grid is
335 : ! unstructured
336 1536 : if (unstructured) then
337 4608 : allocate(grid_map(3, pcols * (endchunk - begchunk + 1)))
338 1536 : if (single_column) allocate(grid_map_scm(3, pcols * (endchunk - begchunk + 1)))
339 : else
340 0 : allocate(grid_map(4, pcols * (endchunk - begchunk + 1)))
341 0 : if (single_column) allocate(grid_map_scm(4, pcols * (endchunk - begchunk + 1)))
342 : end if
343 397824 : grid_map = 0_iMap
344 1536 : if (single_column) grid_map_scm = 0_iMap
345 4608 : allocate(latvals(size(grid_map, 2)))
346 3072 : allocate(lonvals(size(grid_map, 2)))
347 :
348 1536 : lonmin = 1000.0_r8 ! Out of longitude range
349 1536 : latmin = 1000.0_r8 ! Out of latitude range
350 1536 : index = 0
351 7728 : do ichnk = begchunk, endchunk
352 6192 : ncol = chunks(ichnk)%ncols ! Too soon to call get_ncols_p
353 106800 : do icol = 1, pcols
354 99072 : index = index + 1
355 99072 : if (icol <= ncol) then
356 97200 : col_index = chunks(ichnk)%phys_cols(icol)
357 97200 : latvals(index) = phys_columns(col_index)%lat_deg
358 97200 : if (latvals(index) < latmin) then
359 9410 : latmin = latvals(index)
360 : end if
361 97200 : lonvals(index) = phys_columns(col_index)%lon_deg
362 97200 : if (lonvals(index) < lonmin) then
363 6592 : lonmin = lonvals(index)
364 : end if
365 : else
366 1872 : col_index = -1
367 1872 : latvals(index) = 1000.0_r8
368 1872 : lonvals(index) = 1000.0_r8
369 : end if
370 99072 : grid_map(1, index) = int(icol, iMap)
371 99072 : grid_map(2, index) = int(ichnk, iMap)
372 99072 : if (single_column) then
373 0 : grid_map_scm(1, index) = int(icol, iMap)
374 0 : grid_map_scm(2, index) = int(ichnk, iMap)
375 : end if
376 105264 : if (icol <= ncol) then
377 97200 : if (unstructured) then
378 97200 : gcol = phys_columns(col_index)%global_col_num
379 97200 : if (gcol > 0) then
380 97200 : grid_map(3, index) = int(gcol, iMap)
381 97200 : if (single_column) grid_map_scm(3, index) = closeioplonidx
382 : end if ! else entry remains 0
383 : else
384 : ! lon
385 0 : gcol = phys_columns(col_index)%coord_indices(1)
386 0 : if (gcol > 0) then
387 0 : grid_map(3, index) = int(gcol, iMap)
388 0 : if (single_column) grid_map_scm(3, index) = closeioplonidx
389 : end if ! else entry remains 0
390 : ! lat
391 0 : gcol = phys_columns(col_index)%coord_indices(2)
392 0 : if (gcol > 0) then
393 0 : grid_map(4, index) = gcol
394 0 : if (single_column) grid_map_scm(4, index) = closeioplatidx
395 : end if ! else entry remains 0
396 : end if
397 : end if ! Else entry remains 0
398 : end do
399 : end do
400 :
401 : ! Note that if the dycore is using the same points as the physics grid,
402 : ! it will have already set up 'lat' and 'lon' axes for
403 : ! the physics grid
404 : ! However, these will be in the dynamics decomposition
405 :
406 1536 : if (unstructured) then
407 : lon_coord => horiz_coord_create('lon', 'ncol', num_global_phys_cols, &
408 : 'longitude', 'degrees_east', 1, size(lonvals), lonvals, &
409 1536 : map=grid_map(3,:))
410 : lat_coord => horiz_coord_create('lat', 'ncol', num_global_phys_cols, &
411 : 'latitude', 'degrees_north', 1, size(latvals), latvals, &
412 1536 : map=grid_map(3,:))
413 : else
414 0 : allocate(coord_map(size(grid_map, 2)))
415 : ! We need a global minimum longitude and latitude
416 0 : if (npes > 1) then
417 0 : temp = lonmin
418 : call MPI_allreduce(temp, lonmin, 1, MPI_INTEGER, MPI_MIN, &
419 0 : mpicom, ierr)
420 0 : temp = latmin
421 : call MPI_allreduce(temp, latmin, 1, MPI_INTEGER, MPI_MIN, &
422 0 : mpicom, ierr)
423 : ! Create lon coord map which only writes from one of each unique lon
424 0 : where(latvals == latmin)
425 0 : coord_map(:) = grid_map(3, :)
426 : elsewhere
427 : coord_map(:) = 0_iMap
428 : end where
429 : lon_coord => horiz_coord_create('lon', 'lon', hdim1_d, &
430 : 'longitude', 'degrees_east', 1, size(lonvals), lonvals, &
431 0 : map=coord_map)
432 :
433 : ! Create lat coord map which only writes from one of each unique lat
434 0 : where(lonvals == lonmin)
435 0 : coord_map(:) = grid_map(4, :)
436 : elsewhere
437 : coord_map(:) = 0_iMap
438 : end where
439 : lat_coord => horiz_coord_create('lat', 'lat', hdim2_d, &
440 : 'latitude', 'degrees_north', 1, size(latvals), latvals, &
441 0 : map=coord_map)
442 0 : deallocate(coord_map)
443 : end if
444 : end if
445 : call cam_grid_register('physgrid', phys_decomp, lat_coord, lon_coord, &
446 1536 : grid_map, unstruct=unstructured, block_indexed=.true.)
447 1536 : if (single_column) call cam_grid_register('physgrid_scm', phys_decomp_scm, lat_coord, lon_coord, &
448 0 : grid_map_scm, unstruct=unstructured, block_indexed=.true.)
449 : ! Copy required attributes from the dynamics array
450 1536 : nullify(copy_attributes)
451 1536 : call physgrid_copy_attributes_d(copy_gridname, copy_attributes)
452 4608 : do index = 1, size(copy_attributes)
453 : call cam_grid_attribute_copy(copy_gridname, 'physgrid', &
454 4608 : copy_attributes(index))
455 : end do
456 :
457 1536 : if (.not. cam_grid_attr_exists('physgrid', 'area')) then
458 : ! Physgrid always needs an area attribute.
459 1536 : if (unstructured) then
460 : ! If we did not inherit one from the dycore (i.e., physics and
461 : ! dynamics are on different grids), create that attribute here
462 : ! (Note, a separate physics grid is only supported for
463 : ! unstructured grids).
464 4608 : allocate(area_d(size(grid_map, 2)))
465 98736 : do col_index = 1, phys_columns_on_task
466 98736 : area_d(col_index) = phys_columns(col_index)%area
467 : end do
468 : call cam_grid_attribute_register('physgrid', 'area', &
469 1536 : 'physics column areas', 'ncol', area_d, map=grid_map(3,:))
470 1536 : nullify(area_d) ! Belongs to attribute now
471 :
472 4608 : allocate(areawt_d(size(grid_map, 2)))
473 98736 : do col_index = 1, phys_columns_on_task
474 98736 : areawt_d(col_index) = phys_columns(col_index)%weight*rarea_sphere
475 : end do
476 : call cam_grid_attribute_register('physgrid', 'areawt', &
477 1536 : 'physics column area weight', 'ncol', areawt_d, map=grid_map(3,:))
478 1536 : nullify(areawt_d) ! Belongs to attribute now
479 : else
480 0 : call endrun(subname//"No 'area' attribute from dycore")
481 : end if
482 : end if
483 : ! Cleanup pointers (they belong to the grid now)
484 : ! Cleanup, we are responsible for copy attributes
485 1536 : if (associated(copy_attributes)) then
486 1536 : deallocate(copy_attributes)
487 : nullify(copy_attributes)
488 : end if
489 1536 : nullify(grid_map)
490 1536 : if (single_column) nullify(grid_map_scm)
491 1536 : deallocate(latvals)
492 : nullify(latvals)
493 1536 : deallocate(lonvals)
494 : nullify(lonvals)
495 :
496 : ! Set flag indicating physics grid is now set
497 1536 : phys_grid_set = .true.
498 :
499 1536 : call t_stopf("phys_grid_init")
500 1536 : call t_adj_detailf(+2)
501 :
502 1536 : if (calc_memory_increase) then
503 0 : call shr_mem_getusage(mem_hw_end, mem_end)
504 0 : temp = mem_end - mem_beg
505 : call MPI_reduce(temp, mem_end, 1, MPI_REAL8, MPI_MAX, masterprocid, &
506 0 : mpicom, ierr)
507 0 : if (masterproc) then
508 0 : write(iulog, *) 'phys_grid_init: Increase in memory usage = ', &
509 0 : mem_end, ' (MB)'
510 : end if
511 0 : temp = mem_hw_end - mem_hw_beg
512 : call MPI_reduce(temp, mem_hw_end, 1, MPI_REAL8, MPI_MAX, &
513 0 : masterprocid, mpicom, ierr)
514 0 : if (masterproc) then
515 0 : write(iulog, *) subname, 'Increase in memory highwater = ', &
516 0 : mem_end, ' (MB)'
517 : end if
518 : end if
519 :
520 3072 : end subroutine phys_grid_init
521 :
522 : !========================================================================
523 :
524 70324200 : integer function chunk_info_to_index_p(lcid, col, subname_in)
525 1536 : use cam_logfile, only: iulog
526 : use cam_abortutils, only: endrun
527 : ! Return the physics column index indicated by
528 : ! <lcid> (chunk) and <col> (column).
529 :
530 : ! Dummy arguments
531 : integer, intent(in) :: lcid ! local chunk id
532 : integer, intent(in) :: col ! Column index
533 : character(len=*), optional, intent(in) :: subname_in
534 : ! Local variables
535 : character(len=128) :: errmsg
536 : character(len=*), parameter :: subname = 'chunk_info_to_index_p: '
537 :
538 70324200 : if (.not. phys_grid_initialized()) then
539 0 : if (present(subname_in)) then
540 0 : call endrun(trim(subname_in)//'physics grid not initialized')
541 : else
542 0 : call endrun(subname//'physics grid not initialized')
543 : end if
544 70324200 : else if ((lcid < begchunk) .or. (lcid > endchunk)) then
545 0 : if (present(subname_in)) then
546 0 : write(errmsg, '(a,3(a,i0))') trim(subname_in), 'lcid (', lcid, &
547 0 : ') out of range (', begchunk, ' to ', endchunk
548 : else
549 0 : write(errmsg, '(a,3(a,i0))') subname, 'lcid (', lcid, &
550 0 : ') out of range (', begchunk, ' to ', endchunk
551 : end if
552 0 : write(iulog, *) trim(errmsg)
553 0 : call endrun(trim(errmsg))
554 70324200 : else if ((col < 1) .or. (col > get_ncols_p(lcid))) then
555 0 : if (present(subname_in)) then
556 0 : write(errmsg, '(a,2(a,i0))') trim(subname_in), 'col (', col, &
557 0 : ') out of range (1 to ', get_ncols_p(lcid)
558 : else
559 0 : write(errmsg, '(a,2(a,i0))') subname, 'col (', col, &
560 0 : ') out of range (1 to ', get_ncols_p(lcid)
561 : end if
562 0 : write(iulog, *) trim(errmsg)
563 0 : call endrun(trim(errmsg))
564 : end if
565 70324200 : chunk_info_to_index_p = chunks(lcid)%phys_cols(col)
566 70324200 : end function chunk_info_to_index_p
567 :
568 : !========================================================================
569 :
570 358128792 : logical function phys_grid_initialized()
571 : ! Return .true. if the physics grid is initialized, otherwise .false.
572 358128792 : phys_grid_initialized = phys_grid_set
573 358128792 : end function phys_grid_initialized
574 :
575 : !========================================================================
576 :
577 2233344 : integer function get_nlcols_p()
578 2233344 : get_nlcols_p = phys_columns_on_task
579 2233344 : end function get_nlcols_p
580 :
581 : !========================================================================
582 :
583 0 : real(r8) function get_rlat_p(lcid, col)
584 : !-----------------------------------------------------------------------
585 : !
586 : ! get_rlat_p: latitude of a physics column in radians
587 : !
588 : !-----------------------------------------------------------------------
589 :
590 : ! Dummy argument
591 : integer, intent(in) :: lcid
592 : integer, intent(in) :: col
593 : ! Local variables
594 : integer :: index
595 : character(len=*), parameter :: subname = 'get_rlat_p'
596 :
597 0 : index = chunk_info_to_index_p(lcid, col, subname_in=subname)
598 0 : get_rlat_p = phys_columns(index)%lat_rad
599 :
600 0 : end function get_rlat_p
601 :
602 : !========================================================================
603 :
604 0 : real(r8) function get_rlon_p(lcid, col)
605 : !-----------------------------------------------------------------------
606 : !
607 : ! get_rlon_p: longitude of a physics column in radians
608 : !
609 : !-----------------------------------------------------------------------
610 :
611 : ! Dummy argument
612 : integer, intent(in) :: lcid
613 : integer, intent(in) :: col
614 : ! Local variables
615 : integer :: index
616 : character(len=*), parameter :: subname = 'get_rlon_p'
617 :
618 0 : index = chunk_info_to_index_p(lcid, col, subname_in=subname)
619 0 : get_rlon_p = phys_columns(index)%lon_rad
620 :
621 0 : end function get_rlon_p
622 :
623 : !========================================================================
624 :
625 10904112 : subroutine get_rlat_all_p(lcid, rlatdim, rlats)
626 : use cam_abortutils, only: endrun
627 : !-----------------------------------------------------------------------
628 : !
629 : ! get_rlat_all_p: Return all latitudes (in radians) for chunk, <lcid>
630 : !
631 : !-----------------------------------------------------------------------
632 : ! Dummy Arguments
633 : integer, intent(in) :: lcid ! local chunk id
634 : integer, intent(in) :: rlatdim ! declared size of output array
635 : real(r8), intent(out) :: rlats(rlatdim) ! array of latitudes
636 :
637 : ! Local variables
638 : integer :: index ! loop index
639 : integer :: phys_ind
640 : character(len=*), parameter :: subname = 'get_rlat_all_p: '
641 :
642 : !-----------------------------------------------------------------------
643 10904112 : if ((lcid < begchunk) .or. (lcid > endchunk)) then
644 0 : call endrun(subname//'chunk index out of range')
645 : end if
646 182073312 : do index = 1, MIN(get_ncols_p(lcid, subname_in=subname), rlatdim)
647 171169200 : phys_ind = chunks(lcid)%phys_cols(index)
648 182073312 : rlats(index) = phys_columns(phys_ind)%lat_rad
649 : end do
650 :
651 10904112 : end subroutine get_rlat_all_p
652 :
653 : !========================================================================
654 :
655 9161064 : subroutine get_rlon_all_p(lcid, rlondim, rlons)
656 : use cam_abortutils, only: endrun
657 : !-----------------------------------------------------------------------
658 : !
659 : ! get_rlon_all_p:: Return all longitudes (in radians) for chunk, <lcid>
660 : !
661 : !-----------------------------------------------------------------------
662 : ! Dummy Arguments
663 : integer, intent(in) :: lcid ! local chunk id
664 : integer, intent(in) :: rlondim ! declared size of output array
665 : real(r8), intent(out) :: rlons(rlondim) ! array of longitudes
666 :
667 : ! Local variables
668 : integer :: index ! loop index
669 : integer :: phys_ind
670 : character(len=*), parameter :: subname = 'get_rlon_all_p: '
671 :
672 : !-----------------------------------------------------------------------
673 9161064 : if ((lcid < begchunk) .or. (lcid > endchunk)) then
674 0 : call endrun(subname//'chunk index out of range')
675 : end if
676 152968464 : do index = 1, MIN(get_ncols_p(lcid, subname_in=subname), rlondim)
677 143807400 : phys_ind = chunks(lcid)%phys_cols(index)
678 152968464 : rlons(index) = phys_columns(phys_ind)%lon_rad
679 : end do
680 :
681 9161064 : end subroutine get_rlon_all_p
682 :
683 : !========================================================================
684 :
685 0 : real(r8) function get_lat_p(lcid, col)
686 : !-----------------------------------------------------------------------
687 : !
688 : ! get_lat_p: latitude of a physics column in degrees
689 : !
690 : !-----------------------------------------------------------------------
691 :
692 : ! Dummy argument
693 : integer, intent(in) :: lcid
694 : integer, intent(in) :: col
695 : ! Local variables
696 : integer :: index
697 : character(len=*), parameter :: subname = 'get_lat_p'
698 :
699 0 : index = chunk_info_to_index_p(lcid, col, subname_in=subname)
700 0 : get_lat_p = phys_columns(index)%lat_deg
701 :
702 0 : end function get_lat_p
703 :
704 : !========================================================================
705 :
706 0 : real(r8) function get_lon_p(lcid, col)
707 : !-----------------------------------------------------------------------
708 : !
709 : ! get_lon_p: longitude of a physics column in degrees
710 : !
711 : !-----------------------------------------------------------------------
712 :
713 : ! Dummy argument
714 : integer, intent(in) :: lcid
715 : integer, intent(in) :: col
716 : ! Local variables
717 : integer :: index
718 : character(len=*), parameter :: subname = 'get_lon_p'
719 :
720 0 : index = chunk_info_to_index_p(lcid, col, subname_in=subname)
721 0 : get_lon_p = phys_columns(index)%lon_deg
722 :
723 0 : end function get_lon_p
724 :
725 : !========================================================================
726 :
727 0 : subroutine get_lat_all_p_r8(lcid, latdim, lats)
728 : use cam_abortutils, only: endrun
729 : !-----------------------------------------------------------------------
730 : !
731 : ! get_lat_all_p: Return all latitudes (in degrees) for chunk, <lcid>
732 : !
733 : !-----------------------------------------------------------------------
734 : ! Dummy Arguments
735 : integer, intent(in) :: lcid ! local chunk id
736 : integer, intent(in) :: latdim ! declared size of output array
737 : real(r8), intent(out) :: lats(latdim) ! array of latitudes
738 :
739 : ! Local variables
740 : integer :: index ! loop index
741 : integer :: phys_ind
742 : character(len=*), parameter :: subname = 'get_lat_all_p: '
743 :
744 : !-----------------------------------------------------------------------
745 0 : if ((lcid < begchunk) .or. (lcid > endchunk)) then
746 0 : call endrun(subname//'chunk index out of range')
747 : end if
748 0 : do index = 1, MIN(get_ncols_p(lcid, subname_in=subname), latdim)
749 0 : phys_ind = chunks(lcid)%phys_cols(index)
750 0 : lats(index) = phys_columns(phys_ind)%lat_deg
751 : end do
752 :
753 0 : end subroutine get_lat_all_p_r8
754 :
755 : !========================================================================
756 :
757 0 : subroutine get_lon_all_p_r8(lcid, londim, lons)
758 : use cam_abortutils, only: endrun
759 : !-----------------------------------------------------------------------
760 : !
761 : ! get_lon_all_p:: Return all longitudes (in degrees) for chunk, <lcid>
762 : !
763 : !-----------------------------------------------------------------------
764 : ! Dummy Arguments
765 : integer, intent(in) :: lcid ! local chunk id
766 : integer, intent(in) :: londim ! declared size of output array
767 : real(r8), intent(out) :: lons(londim) ! array of longitudes
768 :
769 : ! Local variables
770 : integer :: index ! loop index
771 : integer :: phys_ind
772 : character(len=*), parameter :: subname = 'get_lon_all_p: '
773 :
774 : !-----------------------------------------------------------------------
775 0 : if ((lcid < begchunk) .or. (lcid > endchunk)) then
776 0 : call endrun(subname//'chunk index out of range')
777 : end if
778 0 : do index = 1, MIN(get_ncols_p(lcid, subname_in=subname), londim)
779 0 : phys_ind = chunks(lcid)%phys_cols(index)
780 0 : lons(index) = phys_columns(phys_ind)%lon_deg
781 : end do
782 :
783 0 : end subroutine get_lon_all_p_r8
784 :
785 : !========================================================================
786 :
787 2978352 : subroutine get_area_all_p(lcid, areadim, areas)
788 : use cam_abortutils, only: endrun
789 : !-----------------------------------------------------------------------
790 : !
791 : ! get_area_all_p: Return all areas for chunk, <lcid>
792 : !
793 : !-----------------------------------------------------------------------
794 : ! Dummy Arguments
795 : integer, intent(in) :: lcid ! local chunk id
796 : integer, intent(in) :: areadim ! declared size of output array
797 : real(r8), intent(out) :: areas(areadim) ! array of areas
798 :
799 : ! Local variables
800 : integer :: index ! loop index
801 : integer :: phys_ind
802 : character(len=*), parameter :: subname = 'get_area_all_p: '
803 :
804 : !-----------------------------------------------------------------------
805 2978352 : if ((lcid < begchunk) .or. (lcid > endchunk)) then
806 0 : call endrun(subname//'chunk index out of range')
807 : end if
808 49731552 : do index = 1, MIN(get_ncols_p(lcid, subname_in=subname), areadim)
809 46753200 : phys_ind = chunks(lcid)%phys_cols(index)
810 49731552 : areas(index) = phys_columns(phys_ind)%area
811 : end do
812 :
813 2978352 : end subroutine get_area_all_p
814 :
815 : !========================================================================
816 :
817 16467624 : subroutine get_wght_all_p(lcid, wghtdim, wghts)
818 : use cam_abortutils, only: endrun
819 : !-----------------------------------------------------------------------
820 : !
821 : ! get_wght_all_p: Return all weights for chunk, <lcid>
822 : !
823 : !-----------------------------------------------------------------------
824 : ! Dummy Arguments
825 : integer, intent(in) :: lcid ! local chunk id
826 : integer, intent(in) :: wghtdim ! declared size of output array
827 : real(r8), intent(out) :: wghts(wghtdim) ! array of weights
828 :
829 : ! Local variables
830 : integer :: index ! loop index
831 : integer :: phys_ind
832 : character(len=*), parameter :: subname = 'get_wght_all_p: '
833 :
834 : !-----------------------------------------------------------------------
835 16467624 : if ((lcid < begchunk) .or. (lcid > endchunk)) then
836 0 : call endrun(subname//'chunk index out of range')
837 : end if
838 274971024 : do index = 1, MIN(get_ncols_p(lcid, subname_in=subname), wghtdim)
839 258503400 : phys_ind = chunks(lcid)%phys_cols(index)
840 274971024 : wghts(index) = phys_columns(phys_ind)%weight
841 : end do
842 :
843 16467624 : end subroutine get_wght_all_p
844 :
845 : !========================================================================
846 :
847 194092992 : integer function get_ncols_p(lcid, subname_in)
848 : use cam_abortutils, only: endrun
849 : !-----------------------------------------------------------------------
850 : !
851 : ! get_ncols_p: Return number of columns in chunk given the local chunk id.
852 : !
853 : !-----------------------------------------------------------------------
854 : ! Dummy arguments
855 : integer, intent(in) :: lcid ! local chunk id
856 : character(len=*), optional, intent(in) :: subname_in
857 :
858 194092992 : if (.not. phys_grid_initialized()) then
859 0 : if (present(subname_in)) then
860 0 : call endrun(trim(subname_in)//'physics grid not initialized')
861 : else
862 0 : call endrun('get_ncols_p: physics grid not initialized')
863 : end if
864 : else
865 194092992 : get_ncols_p = chunks(lcid)%ncols
866 : end if
867 :
868 194092992 : end function get_ncols_p
869 :
870 : !========================================================================
871 :
872 70129800 : real(r8) function get_area_p(lcid, col)
873 : ! area of a physics column in radians squared
874 :
875 : ! Dummy arguments
876 : integer, intent(in) :: lcid ! Chunk number
877 : integer, intent(in) :: col ! <lcid> column
878 : ! Local variables
879 : integer :: index
880 : character(len=*), parameter :: subname = 'get_area_p'
881 :
882 70129800 : index = chunk_info_to_index_p(lcid, col, subname_in=subname)
883 70129800 : get_area_p = phys_columns(index)%area
884 :
885 70129800 : end function get_area_p
886 :
887 : !========================================================================
888 :
889 0 : real(r8) function get_wght_p(lcid, col)
890 : ! weight of a physics column in radians squared
891 :
892 : ! Dummy arguments
893 : integer, intent(in) :: lcid ! Chunk number
894 : integer, intent(in) :: col ! <lcid> column
895 : ! Local variables
896 : integer :: index
897 : character(len=*), parameter :: subname = 'get_wght_p'
898 :
899 0 : index = chunk_info_to_index_p(lcid, col, subname_in=subname)
900 0 : get_wght_p = phys_columns(index)%weight
901 :
902 0 : end function get_wght_p
903 :
904 : !========================================================================
905 :
906 194400 : integer function get_gcol_p(lcid, col)
907 : ! global column index of a physics column
908 :
909 : ! Dummy arguments
910 : integer, intent(in) :: lcid ! local chunk id
911 : integer, intent(in) :: col ! column index
912 : ! Local variables
913 : integer :: index
914 : character(len=*), parameter :: subname = 'get_gcol_p: '
915 :
916 194400 : index = chunk_info_to_index_p(lcid, col, subname_in=subname)
917 194400 : get_gcol_p = phys_columns(index)%global_col_num
918 :
919 194400 : end function get_gcol_p
920 :
921 : !========================================================================
922 :
923 0 : subroutine get_dyn_col_p_chunk(lcid, col, blk_num, blk_ind, caller)
924 : use cam_abortutils, only: endrun
925 : ! Return the dynamics local block number and block offset(s) for
926 : ! the physics column indicated by <lcid> (chunk) and <col> (column).
927 :
928 : ! Dummy arguments
929 : integer, intent(in) :: lcid ! local chunk id
930 : integer, intent(in) :: col ! Column index
931 : integer, intent(out) :: blk_num ! Local dynamics block index
932 : integer, intent(out) :: blk_ind(:) ! Local dynamics block offset(s)
933 : character(len=*), optional, intent(in) :: caller ! Calling routine
934 : ! Local variables
935 : integer :: index
936 : integer :: off_size
937 : character(len=*), parameter :: subname = 'get_dyn_col_p_chunk: '
938 :
939 0 : index = chunk_info_to_index_p(lcid, col)
940 0 : off_size = SIZE(phys_columns(index)%dyn_block_index, 1)
941 0 : if (SIZE(blk_ind, 1) < off_size) then
942 0 : if (present(caller)) then
943 0 : call endrun(trim(caller)//': blk_ind too small')
944 : else
945 0 : call endrun(subname//'blk_ind too small')
946 : end if
947 : end if
948 0 : blk_num = phys_columns(index)%local_dyn_block
949 0 : blk_ind(1:off_size) = phys_columns(index)%dyn_block_index(1:off_size)
950 0 : if (SIZE(blk_ind, 1) > off_size) then
951 0 : blk_ind(off_size+1:) = -1
952 : end if
953 :
954 0 : end subroutine get_dyn_col_p_chunk
955 :
956 : !========================================================================
957 :
958 46850400 : subroutine get_dyn_col_p_index(index, blk_num, blk_ind)
959 : use cam_logfile, only: iulog
960 : use cam_abortutils, only: endrun
961 : ! Return the dynamics local block number and block offset(s) for
962 : ! the physics column indicated by <index>.
963 :
964 : ! Dummy arguments
965 : integer, intent(in) :: index ! index of local physics column
966 : integer, intent(out) :: blk_num ! Local dynamics block index
967 : integer, intent(out) :: blk_ind(:) ! Local dynamics block offset(s)
968 : ! Local variables
969 : integer :: off_size
970 : character(len=128) :: errmsg
971 : character(len=*), parameter :: subname = 'get_dyn_col_p_index: '
972 :
973 46850400 : if (.not. phys_grid_initialized()) then
974 0 : call endrun(subname//'physics grid not initialized')
975 46850400 : else if ((index < 1) .or. (index > columns_on_task)) then
976 0 : write(errmsg, '(a,2(a,i0))') subname, 'index (', index, &
977 0 : ') out of range (1 to ', columns_on_task
978 0 : write(iulog, *) trim(errmsg)
979 0 : call endrun(trim(errmsg))
980 : else
981 46850400 : off_size = SIZE(phys_columns(index)%dyn_block_index, 1)
982 46850400 : if (SIZE(blk_ind, 1) < off_size) then
983 0 : call endrun(subname//'blk_ind too small')
984 : end if
985 46850400 : blk_num = phys_columns(index)%local_dyn_block
986 93700800 : blk_ind(1:off_size) = phys_columns(index)%dyn_block_index(1:off_size)
987 46850400 : if (SIZE(blk_ind, 1) > off_size) then
988 0 : blk_ind(off_size+1:) = -1
989 : end if
990 : end if
991 :
992 46850400 : end subroutine get_dyn_col_p_index
993 :
994 : !========================================================================
995 :
996 6192 : subroutine get_gcol_all_p(lcid, gdim, gcols)
997 : use cam_logfile, only: iulog
998 : use cam_abortutils, only: endrun
999 : use spmd_utils, only: masterproc
1000 : ! collect global column indices of all physics columns in a chunk
1001 :
1002 : ! Dummy arguments
1003 : integer, intent(in) :: lcid ! local chunk id
1004 : integer, intent(in) :: gdim ! gcols dimension
1005 : integer, intent(out) :: gcols(:) ! global column indices
1006 : ! Local variables
1007 : integer :: ncol, col_ind
1008 : character(len=128) :: errmsg
1009 : character(len=*), parameter :: subname = 'get_gcol_all_p: '
1010 :
1011 6192 : if (.not. phys_grid_initialized()) then
1012 0 : call endrun(subname//'physics grid not initialized')
1013 6192 : else if ((lcid < begchunk) .or. (lcid > endchunk)) then
1014 0 : write(errmsg, '(a,3(a,i0))') subname, 'lcid (', lcid, &
1015 0 : ') out of range (', begchunk, ' to ', endchunk
1016 0 : write(iulog, *) trim(errmsg)
1017 0 : call endrun(trim(errmsg))
1018 : else
1019 6192 : ncol = chunks(lcid)%ncols
1020 6192 : if (gdim < ncol) then
1021 0 : if (masterproc) then
1022 0 : write(iulog, '(2a,2(i0,a))') subname, 'WARNING: gdim (', gdim, &
1023 0 : ') < ncol (', ncol,'), not all indices will be filled.'
1024 : end if
1025 0 : gcols(gdim+1:ncol) = -1
1026 : end if
1027 103392 : do col_ind = 1, MIN(ncol, gdim)
1028 103392 : gcols(col_ind) = get_gcol_p(lcid, col_ind)
1029 : end do
1030 : end if
1031 :
1032 6192 : end subroutine get_gcol_all_p
1033 :
1034 : !========================================================================
1035 :
1036 46850400 : subroutine get_chunk_info_p(index, lchnk, icol)
1037 : use cam_logfile, only: iulog
1038 : use cam_abortutils, only: endrun
1039 : ! local chunk index and column number of a physics column
1040 :
1041 : ! Dummy arguments
1042 : integer, intent(in) :: index
1043 : integer, intent(out) :: lchnk
1044 : integer, intent(out) :: icol
1045 : ! Local variables
1046 : character(len=128) :: errmsg
1047 : character(len=*), parameter :: subname = 'get_chunk_info_p: '
1048 :
1049 46850400 : if (.not. phys_grid_initialized()) then
1050 0 : call endrun(subname//': physics grid not initialized')
1051 46850400 : else if ((index < 1) .or. (index > columns_on_task)) then
1052 0 : write(errmsg, '(a,2(a,i0))') subname, 'index (', index, &
1053 0 : ') out of range (1 to ', columns_on_task
1054 0 : write(iulog, *) errmsg
1055 0 : call endrun(errmsg)
1056 : else
1057 46850400 : lchnk = phys_columns(index)%local_phys_chunk
1058 46850400 : icol = phys_columns(index)%phys_chunk_index
1059 : end if
1060 :
1061 46850400 : end subroutine get_chunk_info_p
1062 :
1063 : !========================================================================
1064 :
1065 0 : subroutine get_grid_dims(hdim1_d_out, hdim2_d_out)
1066 : use cam_abortutils, only: endrun
1067 : ! retrieve dynamics field grid information
1068 : ! hdim1_d and hdim2_d are dimensions of rectangular horizontal grid
1069 : ! data structure, If 1D data structure, then hdim2_d == 1.
1070 : integer, intent(out) :: hdim1_d_out
1071 : integer, intent(out) :: hdim2_d_out
1072 :
1073 0 : if (.not. phys_grid_initialized()) then
1074 0 : call endrun('get_grid_dims: physics grid not initialized')
1075 : end if
1076 0 : hdim1_d_out = hdim1_d
1077 0 : hdim2_d_out = hdim2_d
1078 :
1079 0 : end subroutine get_grid_dims
1080 :
1081 : !========================================================================
1082 :
1083 : ! Note: This routine is a stub for future load-balancing
1084 0 : subroutine phys_decomp_to_dyn()
1085 : !-----------------------------------------------------------------------
1086 : !
1087 : ! phys_decomp_to_dyn: Transfer physics data to dynamics decomp
1088 : !
1089 : !-----------------------------------------------------------------------
1090 0 : end subroutine phys_decomp_to_dyn
1091 :
1092 : !========================================================================
1093 :
1094 : ! Note: This routine is a stub for future load-balancing
1095 0 : subroutine dyn_decomp_to_phys()
1096 : !-----------------------------------------------------------------------
1097 : !
1098 : ! dyn_decomp_to_phys: Transfer dynamics data to physics decomp
1099 : !
1100 : !-----------------------------------------------------------------------
1101 :
1102 0 : end subroutine dyn_decomp_to_phys
1103 :
1104 : !========================================================================
1105 :
1106 : subroutine dump_grid_map(grid_map)
1107 : use spmd_utils, only: iam, npes, mpicom
1108 : use cam_grid_support, only: iMap
1109 :
1110 : integer(iMap), pointer :: grid_map(:,:)
1111 :
1112 : integer :: num_cols
1113 : integer :: penum, icol
1114 : logical :: unstruct
1115 : integer :: file
1116 : integer :: ierr
1117 :
1118 : unstruct = SIZE(grid_map, 1) == 3
1119 : num_cols = SIZE(grid_map, 2)
1120 : if (iam == 0) then
1121 : open(newunit=file, file='physgrid_map.csv', status='replace')
1122 : if (unstruct) then
1123 : write(file, *) '"iam","col","block","map pos"'
1124 : else
1125 : write(file, *) '"iam","col","block","lon","lat"'
1126 : end if
1127 : close(unit=file)
1128 : end if
1129 : do penum = 0, npes - 1
1130 : if (iam == penum) then
1131 : open(newunit=file, file='physgrid_map.csv', status='old', &
1132 : action='readwrite', position='append')
1133 : do icol = 1, num_cols
1134 : if (unstruct) then
1135 : write(file, '(3(i0,","),i0)') iam, int(grid_map(1,icol)), &
1136 : int(grid_map(2,icol)), int(grid_map(3,icol))
1137 : else
1138 : write(file, '(4(i0,","),i0)') iam, int(grid_map(1,icol)), &
1139 : int(grid_map(2,icol)), int(grid_map(3,icol)), &
1140 : int(grid_map(4,icol))
1141 : end if
1142 : end do
1143 : close(unit=file)
1144 : end if
1145 : call MPI_barrier(mpicom, ierr)
1146 : end do
1147 : end subroutine dump_grid_map
1148 :
1149 : !=============================================================================
1150 : !==
1151 : !!!!!! DUMMY INTERFACEs TO TEST WEAK SCALING INFRASTRUCTURE, SHOULD GO AWAY
1152 : !==
1153 : !=============================================================================
1154 :
1155 0 : subroutine scatter_field_to_chunk(fdim,mdim,ldim, &
1156 : hdim1d,globalfield,localchunks)
1157 : use cam_abortutils, only: endrun
1158 : !-----------------------------------------------------------------------
1159 : !
1160 : ! Purpose: DUMMY FOR WEAK SCALING TESTS
1161 : !
1162 : !------------------------------Arguments--------------------------------
1163 : integer, intent(in) :: fdim ! declared length of first dimension
1164 : integer, intent(in) :: mdim ! declared length of middle dimension
1165 : integer, intent(in) :: ldim ! declared length of last dimension
1166 : integer, intent(in) :: hdim1d ! declared first horizontal index
1167 : real(r8), intent(in) :: globalfield(fdim,hdim1d,mdim,hdim2_d,ldim)
1168 : real(r8), intent(out):: localchunks(fdim,pcols,mdim, &
1169 : begchunk:endchunk,ldim)
1170 :
1171 0 : call endrun('scatter_field_to_chunk: NOT SUPPORTED WITH WEAK SCALING')
1172 0 : end subroutine scatter_field_to_chunk
1173 :
1174 : !========================================================================
1175 :
1176 0 : subroutine get_lat_all_p_int(lcid, latdim, lats)
1177 : use cam_abortutils, only: endrun
1178 : !-----------------------------------------------------------------------
1179 : !
1180 : ! get_lat_all_p: Return all latitudes (in degrees) for chunk, <lcid>
1181 : !
1182 : !-----------------------------------------------------------------------
1183 : ! Dummy Arguments
1184 : integer, intent(in) :: lcid ! local chunk id
1185 : integer, intent(in) :: latdim ! declared size of output array
1186 : integer, intent(out) :: lats(latdim) ! array of latitudes
1187 :
1188 0 : call endrun('get_lat_all_p: deprecated interface')
1189 :
1190 0 : end subroutine get_lat_all_p_int
1191 :
1192 : !========================================================================
1193 :
1194 0 : subroutine get_lon_all_p_int(lcid, londim, lons)
1195 : use cam_abortutils, only: endrun
1196 : !-----------------------------------------------------------------------
1197 : !
1198 : ! get_lon_all_p:: Return all longitudes (in degrees) for chunk, <lcid>
1199 : !
1200 : !-----------------------------------------------------------------------
1201 : ! Dummy Arguments
1202 : integer, intent(in) :: lcid ! local chunk id
1203 : integer, intent(in) :: londim ! declared size of output array
1204 : integer, intent(out) :: lons(londim) ! array of longitudes
1205 :
1206 0 : call endrun('get_lon_all_p: deprecated interface')
1207 :
1208 0 : end subroutine get_lon_all_p_int
1209 :
1210 : !========================================================================
1211 :
1212 0 : end module phys_grid
|
