Line data Source code
1 : module cam_grid_support
2 : use shr_kind_mod, only: r8=>shr_kind_r8, r4=>shr_kind_r4, max_chars=>shr_kind_cl
3 : use shr_kind_mod, only: i8=>shr_kind_i8, i4=>shr_kind_i4
4 : use shr_sys_mod, only: shr_sys_flush
5 : use pio, only: iMap=>PIO_OFFSET_KIND, var_desc_t
6 : use cam_abortutils, only: endrun
7 : use cam_logfile, only: iulog
8 : use spmd_utils, only: masterproc
9 : use cam_pio_utils, only: cam_pio_handle_error
10 : use cam_map_utils, only: cam_filemap_t
11 :
12 : implicit none
13 : private
14 :
15 : public iMap
16 :
17 : integer, parameter, public :: max_hcoordname_len = 16
18 : integer, parameter, public :: maxsplitfiles = 2
19 :
20 : type, public :: vardesc_ptr_t
21 : type(var_desc_t), pointer :: p => NULL()
22 : end type vardesc_ptr_t
23 : !---------------------------------------------------------------------------
24 : !
25 : ! horiz_coord_t: Information for horizontal dimension attributes
26 : !
27 : !---------------------------------------------------------------------------
28 : type, public :: horiz_coord_t
29 : private
30 : character(len=max_hcoordname_len) :: name = '' ! coordinate name
31 : character(len=max_hcoordname_len) :: dimname = '' ! dimension name
32 : ! NB: If dimname is blank, it is assumed to be name
33 : integer :: dimsize = 0 ! global size of dimension
34 : character(len=max_chars) :: long_name = '' ! 'long_name' attribute
35 : character(len=max_chars) :: units = '' ! 'units' attribute
36 : real(r8), pointer :: values(:) => NULL() ! dim values (local if map)
37 : integer(iMap), pointer :: map(:) => NULL() ! map (dof) for dist. coord
38 : logical :: latitude ! .false. means longitude
39 : real(r8), pointer :: bnds(:,:) => NULL() ! bounds, if present
40 : type(vardesc_ptr_t) :: vardesc(maxsplitfiles) ! If we are to write coord
41 : type(vardesc_ptr_t) :: bndsvdesc(maxsplitfiles) ! If we are to write bounds
42 : contains
43 : procedure :: get_coord_len => horiz_coord_len
44 : procedure :: num_elem => horiz_coord_num_elem
45 : procedure :: global_size => horiz_coord_find_size
46 : procedure :: get_coord_name => horiz_coord_name
47 : procedure :: get_dim_name => horiz_coord_dim_name
48 : procedure :: get_long_name => horiz_coord_long_name
49 : procedure :: get_units => horiz_coord_units
50 : procedure :: write_attr => write_horiz_coord_attr
51 : procedure :: write_var => write_horiz_coord_var
52 : end type horiz_coord_t
53 :
54 : !---------------------------------------------------------------------------
55 : !
56 : ! cam_grid_attribute_t: Auxiliary quantity for a CAM grid
57 : !
58 : !---------------------------------------------------------------------------
59 : type, abstract :: cam_grid_attribute_t
60 : character(len=max_hcoordname_len) :: name = '' ! attribute name
61 : character(len=max_chars) :: long_name = '' ! attribute long_name
62 : type(vardesc_ptr_t) :: vardesc(maxsplitfiles)
63 : ! We aren't going to use this until we sort out PGI issues
64 : class(cam_grid_attribute_t), pointer :: next => NULL()
65 : contains
66 : procedure :: cam_grid_attr_init
67 : procedure(write_cam_grid_attr), deferred :: write_attr
68 : procedure(write_cam_grid_attr), deferred :: write_val
69 : procedure(print_attr_spec), deferred :: print_attr
70 : procedure :: print_attr_base
71 : end type cam_grid_attribute_t
72 :
73 : !---------------------------------------------------------------------------
74 : !
75 : ! cam_grid_attribute_0d_int_t: Global integral attribute
76 : !
77 : !---------------------------------------------------------------------------
78 : type, extends(cam_grid_attribute_t) :: cam_grid_attribute_0d_int_t
79 : integer :: ival
80 : contains
81 : procedure :: cam_grid_attr_init_0d_int
82 : procedure :: write_attr => write_cam_grid_attr_0d_int
83 : procedure :: write_val => write_cam_grid_val_0d_int
84 : procedure :: print_attr => print_attr_0d_int
85 : end type cam_grid_attribute_0d_int_t
86 :
87 : !---------------------------------------------------------------------------
88 : !
89 : ! cam_grid_attribute_0d_char_t: Global string attribute
90 : !
91 : !---------------------------------------------------------------------------
92 : type, extends(cam_grid_attribute_t) :: cam_grid_attribute_0d_char_t
93 : character(len=max_chars) :: val
94 : contains
95 : procedure :: cam_grid_attr_init_0d_char
96 : procedure :: write_attr => write_cam_grid_attr_0d_char
97 : procedure :: write_val => write_cam_grid_val_0d_char
98 : procedure :: print_attr => print_attr_0d_char
99 : end type cam_grid_attribute_0d_char_t
100 :
101 : !---------------------------------------------------------------------------
102 : !
103 : ! cam_grid_attribute_1d_int_t: 1-d integer attribute
104 : !
105 : !---------------------------------------------------------------------------
106 : type, extends(cam_grid_attribute_t) :: cam_grid_attribute_1d_int_t
107 : character(len=max_hcoordname_len) :: dimname ! attribute dimension
108 : integer :: dimsize ! Global array/map size
109 : integer, pointer :: values(:) => NULL()
110 : integer(iMap), pointer :: map(:) => NULL() ! map (dof) for I/O
111 : contains
112 : procedure :: cam_grid_attr_init_1d_int
113 : procedure :: write_attr => write_cam_grid_attr_1d_int
114 : procedure :: write_val => write_cam_grid_val_1d_int
115 : procedure :: print_attr => print_attr_1d_int
116 : end type cam_grid_attribute_1d_int_t
117 :
118 : !---------------------------------------------------------------------------
119 : !
120 : ! cam_grid_attribute_1d_r8_t: 1-d real*8 attribute
121 : !
122 : !---------------------------------------------------------------------------
123 : type, extends(cam_grid_attribute_t) :: cam_grid_attribute_1d_r8_t
124 : character(len=max_hcoordname_len) :: dimname ! attribute dimension
125 : integer :: dimsize ! Global array/map size
126 : real(r8), pointer :: values(:) => NULL()
127 : integer(iMap), pointer :: map(:) => NULL() ! map (dof) for I/O
128 : contains
129 : procedure :: cam_grid_attr_init_1d_r8
130 : procedure :: write_attr => write_cam_grid_attr_1d_r8
131 : procedure :: write_val => write_cam_grid_val_1d_r8
132 : procedure :: print_attr => print_attr_1d_r8
133 : end type cam_grid_attribute_1d_r8_t
134 :
135 : !---------------------------------------------------------------------------
136 : !
137 : ! cam_grid_attr_ptr_t: linked list of CAM grid attributes
138 : !
139 : !---------------------------------------------------------------------------
140 : type :: cam_grid_attr_ptr_t
141 : private
142 : class(cam_grid_attribute_t), pointer :: attr => NULL()
143 : type(cam_grid_attr_ptr_t), pointer :: next => NULL()
144 : contains
145 : private
146 : procedure, public :: initialize => initializeAttrPtr
147 : procedure, public :: getAttr => getAttrPtrAttr
148 : procedure, public :: getNext => getAttrPtrNext
149 : procedure, public :: setNext => setAttrPtrNext
150 : end type cam_grid_attr_ptr_t
151 :
152 : !---------------------------------------------------------------------------
153 : !
154 : ! cam_grid_t: Information for a CAM grid (defined by a dycore)
155 : !
156 : !---------------------------------------------------------------------------
157 : type :: cam_grid_t
158 : character(len=max_hcoordname_len) :: name = '' ! grid name
159 : integer :: id ! e.g., dyn_decomp
160 : type(horiz_coord_t), pointer :: lat_coord => NULL() ! Latitude coord
161 : type(horiz_coord_t), pointer :: lon_coord => NULL() ! Longitude coord
162 : logical :: unstructured ! Is this needed?
163 : logical :: block_indexed ! .false. for lon/lat
164 : logical :: attrs_defined(2) = .false.
165 : logical :: zonal_grid = .false.
166 : type(cam_filemap_t), pointer :: map => null() ! global dim map (dof)
167 : type(cam_grid_attr_ptr_t), pointer :: attributes => NULL()
168 : contains
169 : procedure :: print_cam_grid
170 : procedure :: is_unstructured => cam_grid_unstructured
171 : procedure :: is_block_indexed => cam_grid_block_indexed
172 : procedure :: is_zonal_grid => cam_grid_zonal_grid
173 : procedure :: coord_lengths => cam_grid_get_dims
174 : procedure :: coord_names => cam_grid_coord_names
175 : procedure :: dim_names => cam_grid_dim_names
176 : procedure :: num_elem => cam_grid_local_size
177 : procedure :: set_map => cam_grid_set_map
178 : procedure :: get_patch_mask => cam_grid_get_patch_mask
179 : procedure :: get_lon_lat => cam_grid_get_lon_lat
180 : procedure :: find_src_dims => cam_grid_find_src_dims
181 : procedure :: find_dest_dims => cam_grid_find_dest_dims
182 : procedure :: find_dimids => cam_grid_find_dimids
183 : procedure :: get_decomp => cam_grid_get_pio_decomp
184 : procedure :: read_darray_2d_int => cam_grid_read_darray_2d_int
185 : procedure :: read_darray_3d_int => cam_grid_read_darray_3d_int
186 : procedure :: read_darray_2d_double => cam_grid_read_darray_2d_double
187 : procedure :: read_darray_3d_double => cam_grid_read_darray_3d_double
188 : procedure :: read_darray_2d_real => cam_grid_read_darray_2d_real
189 : procedure :: read_darray_3d_real => cam_grid_read_darray_3d_real
190 : procedure :: write_darray_2d_int => cam_grid_write_darray_2d_int
191 : procedure :: write_darray_3d_int => cam_grid_write_darray_3d_int
192 : procedure :: write_darray_2d_double => cam_grid_write_darray_2d_double
193 : procedure :: write_darray_3d_double => cam_grid_write_darray_3d_double
194 : procedure :: write_darray_2d_real => cam_grid_write_darray_2d_real
195 : procedure :: write_darray_3d_real => cam_grid_write_darray_3d_real
196 : end type cam_grid_t
197 :
198 : !---------------------------------------------------------------------------
199 : !
200 : ! cam_grid_patch_t: Information for a patch of a CAM grid
201 : !
202 : !---------------------------------------------------------------------------
203 : type, public :: cam_grid_patch_t
204 : private
205 : integer :: grid_id = -1 ! grid containing patch points
206 : integer :: global_size = 0 ! var patch dim size
207 : integer :: global_lat_size = 0 ! lat patch dim size
208 : integer :: global_lon_size = 0 ! lon patch dim size
209 : integer :: num_points = 0 ! task-local size
210 : real(r8) :: lon_range(2)
211 : real(r8) :: lat_range(2)
212 : logical :: collected_columns ! Output unstructured
213 : type(cam_filemap_t), pointer :: mask => null() ! map for active pts
214 : integer(iMap), pointer :: latmap(:) => null() ! map for patch coords
215 : integer(iMap), pointer :: lonmap(:) => null() ! map for patch coords
216 : real(r8), pointer :: lonvals(:) => null() ! For collected output
217 : real(r8), pointer :: latvals(:) => null() ! For collected output
218 : contains
219 : procedure :: gridid => cam_grid_patch_get_id
220 : procedure :: get_axis_names => cam_grid_patch_get_axis_names
221 : procedure :: get_coord_long_name => cam_grid_patch_get_coord_long_name
222 : procedure :: get_coord_units => cam_grid_patch_get_coord_units
223 : procedure :: set_patch => cam_grid_patch_set_patch
224 : procedure :: get_decomp => cam_grid_patch_get_decomp
225 : procedure :: compact => cam_grid_patch_compact
226 : procedure :: active_cols => cam_grid_patch_get_active_cols
227 : procedure :: write_coord_vals => cam_grid_patch_write_vals
228 : procedure :: grid_index => cam_grid_patch_get_grid_index
229 : procedure :: deallocate => cam_grid_patch_deallocate
230 : !!XXgoldyXX: PGI workaround?
231 : ! COMPILER_BUG(goldy, 2014-11-28, pgi <= 14.9); Commented code should work
232 : ! procedure :: global_size_map => cam_grid_patch_get_global_size_map
233 : ! procedure :: global_size_axes => cam_grid_patch_get_global_size_axes
234 : ! generic :: get_global_size => global_size_map, global_size_axes
235 : procedure :: cam_grid_patch_get_global_size_map
236 : procedure :: cam_grid_patch_get_global_size_axes
237 : generic :: get_global_size => cam_grid_patch_get_global_size_map, cam_grid_patch_get_global_size_axes
238 : end type cam_grid_patch_t
239 :
240 : !---------------------------------------------------------------------------
241 : !
242 : ! cam_grid_header_info_t: Hold NetCDF dimension information for a CAM grid
243 : !
244 : !---------------------------------------------------------------------------
245 : type, public :: cam_grid_header_info_t
246 : private
247 : integer :: grid_id = -1 ! e.g., dyn_decomp
248 : integer, allocatable :: hdims(:) ! horizontal dimension ids
249 : type(var_desc_t), pointer :: lon_varid => NULL() ! lon coord variable
250 : type(var_desc_t), pointer :: lat_varid => NULL() ! lat coord variable
251 : contains
252 : procedure :: get_gridid => cam_grid_header_info_get_gridid
253 : procedure :: set_gridid => cam_grid_header_info_set_gridid
254 : procedure :: set_hdims => cam_grid_header_info_set_hdims
255 : procedure :: num_hdims => cam_grid_header_info_num_hdims
256 : procedure :: get_hdimid => cam_grid_header_info_hdim
257 : !!XXgoldyXX: Maybe replace this with horiz_coords for patches?
258 : procedure :: set_varids => cam_grid_header_info_set_varids
259 : procedure :: get_lon_varid => cam_grid_header_info_lon_varid
260 : procedure :: get_lat_varid => cam_grid_header_info_lat_varid
261 : procedure :: deallocate => cam_grid_header_info_deallocate
262 : end type cam_grid_header_info_t
263 :
264 : !---------------------------------------------------------------------------
265 : !
266 : ! END: types BEGIN: interfaces for types
267 : !
268 : !---------------------------------------------------------------------------
269 :
270 : ! Abstract interface for write_attr procedure of cam_grid_attribute_t class
271 : ! NB: This will not compile on some pre-13 Intel compilers
272 : ! (fails on 12.1.0.233 on Frankfurt, passes on 13.0.1.117 on Yellowstone)
273 : abstract interface
274 : subroutine write_cam_grid_attr(attr, File, file_index)
275 : use pio, only: file_desc_t
276 : import :: cam_grid_attribute_t
277 : ! Dummy arguments
278 : class(cam_grid_attribute_t), intent(inout) :: attr
279 : type(file_desc_t), intent(inout) :: File ! PIO file Handle
280 : integer, optional, intent(in) :: file_index
281 : end subroutine write_cam_grid_attr
282 : end interface
283 :
284 : ! Abstract interface for print_attr procedure of cam_grid_attribute_t class
285 : abstract interface
286 : subroutine print_attr_spec(this)
287 : import :: cam_grid_attribute_t
288 : ! Dummy arguments
289 : class(cam_grid_attribute_t), intent(in) :: this
290 : end subroutine print_attr_spec
291 : end interface
292 :
293 : !! Grid variables
294 : integer, parameter :: maxhgrids = 16 ! arbitrary limit
295 : integer, save :: registeredhgrids = 0
296 : type(cam_grid_t), save :: cam_grids(maxhgrids)
297 :
298 : public :: horiz_coord_create
299 :
300 : ! Setup and I/O functions for grids rely on the grid's ID, not its index.
301 : public :: cam_grid_register, cam_grid_attribute_register
302 : public :: cam_grid_attribute_copy
303 : public :: cam_grid_write_attr, cam_grid_write_var
304 : public :: cam_grid_read_dist_array, cam_grid_write_dist_array
305 : ! Access functions for grids rely on the grid's ID or name, not its index.
306 : public :: cam_grid_dimensions, cam_grid_num_grids
307 : public :: cam_grid_check ! T/F if grid ID exists
308 : public :: cam_grid_id ! Grid ID (decomp) or -1 if error
309 : public :: cam_grid_get_local_size
310 : public :: cam_grid_get_file_dimids
311 : public :: cam_grid_get_decomp
312 : public :: cam_grid_get_gcid
313 : public :: cam_grid_get_array_bounds
314 : public :: cam_grid_get_coord_names, cam_grid_get_dim_names
315 : public :: cam_grid_has_blocksize, cam_grid_get_block_count
316 : public :: cam_grid_get_latvals, cam_grid_get_lonvals
317 : public :: cam_grid_get_coords
318 : public :: cam_grid_is_unstructured, cam_grid_is_block_indexed
319 : public :: cam_grid_attr_exists
320 : public :: cam_grid_is_zonal
321 : ! Functions for dealing with patch masks
322 : public :: cam_grid_compute_patch
323 : ! Functions for dealing with grid areas
324 : public :: cam_grid_get_areawt
325 :
326 : interface cam_grid_attribute_register
327 : module procedure add_cam_grid_attribute_0d_int
328 : module procedure add_cam_grid_attribute_0d_char
329 : module procedure add_cam_grid_attribute_1d_int
330 : module procedure add_cam_grid_attribute_1d_r8
331 : end interface
332 :
333 : interface cam_grid_dimensions
334 : module procedure cam_grid_dimensions_id
335 : module procedure cam_grid_dimensions_name
336 : end interface
337 :
338 : interface cam_grid_get_dim_names
339 : module procedure cam_grid_get_dim_names_id
340 : module procedure cam_grid_get_dim_names_name
341 : end interface
342 :
343 : interface cam_grid_read_dist_array
344 : module procedure cam_grid_read_dist_array_2d_int
345 : module procedure cam_grid_read_dist_array_3d_int
346 : module procedure cam_grid_read_dist_array_2d_double
347 : module procedure cam_grid_read_dist_array_3d_double
348 : module procedure cam_grid_read_dist_array_2d_real
349 : module procedure cam_grid_read_dist_array_3d_real
350 : end interface
351 :
352 : interface cam_grid_write_dist_array
353 : module procedure cam_grid_write_dist_array_2d_int
354 : module procedure cam_grid_write_dist_array_3d_int
355 : module procedure cam_grid_write_dist_array_2d_double
356 : module procedure cam_grid_write_dist_array_3d_double
357 : module procedure cam_grid_write_dist_array_2d_real
358 : module procedure cam_grid_write_dist_array_3d_real
359 : end interface
360 :
361 : ! Private interfaces
362 : interface get_cam_grid_index
363 : module procedure get_cam_grid_index_char ! For lookup by name
364 : module procedure get_cam_grid_index_int ! For lookup by ID
365 : end interface
366 :
367 : contains
368 :
369 : !!#######################################################################
370 : !!
371 : !! Horizontal coordinate functions
372 : !!
373 : !!#######################################################################
374 :
375 13824 : integer function horiz_coord_find_size(this, dimname) result(dimsize)
376 : ! Dummy arguments
377 : class(horiz_coord_t), intent(in) :: this
378 : character(len=*), intent(in) :: dimname
379 :
380 13824 : dimsize = -1
381 13824 : if (len_trim(this%dimname) == 0) then
382 0 : if(trim(dimname) == trim(this%name)) then
383 0 : dimsize = this%dimsize
384 : end if
385 : else
386 13824 : if(trim(dimname) == trim(this%dimname)) then
387 13824 : dimsize = this%dimsize
388 : end if
389 : end if
390 :
391 13824 : end function horiz_coord_find_size
392 :
393 0 : integer function horiz_coord_num_elem(this)
394 : ! Dummy arguments
395 : class(horiz_coord_t), intent(in) :: this
396 :
397 0 : if (associated(this%values)) then
398 0 : horiz_coord_num_elem = size(this%values)
399 : else
400 : horiz_coord_num_elem = 0
401 : end if
402 :
403 0 : end function horiz_coord_num_elem
404 :
405 923904 : subroutine horiz_coord_len(this, clen)
406 : ! Dummy arguments
407 : class(horiz_coord_t), intent(in) :: this
408 : integer, intent(out) :: clen
409 :
410 923904 : clen = this%dimsize
411 923904 : end subroutine horiz_coord_len
412 :
413 0 : subroutine horiz_coord_name(this, name)
414 : ! Dummy arguments
415 : class(horiz_coord_t), intent(in) :: this
416 : character(len=*), intent(out) :: name
417 :
418 0 : if (len(name) < len_trim(this%name)) then
419 0 : call endrun('horiz_coord_name: input name too short')
420 : end if
421 0 : name = trim(this%name)
422 0 : end subroutine horiz_coord_name
423 :
424 2176512 : subroutine horiz_coord_dim_name(this, dimname)
425 : ! Dummy arguments
426 : class(horiz_coord_t), intent(in) :: this
427 : character(len=*), intent(out) :: dimname
428 :
429 2176512 : if (len_trim(this%dimname) > 0) then
430 : ! We have a separate dimension name (e.g., ncol)
431 2176512 : if (len(dimname) < len_trim(this%dimname)) then
432 0 : call endrun('horiz_coord_dimname: input name too short')
433 : end if
434 2176512 : dimname = trim(this%dimname)
435 : else
436 : ! No dimension name so we use the coordinate's name
437 : ! i.e., The dimension name is the same as the coordinate variable
438 0 : if (len(dimname) < len_trim(this%name)) then
439 0 : call endrun('horiz_coord_dimname: input name too short')
440 : end if
441 0 : dimname = trim(this%name)
442 : end if
443 2176512 : end subroutine horiz_coord_dim_name
444 :
445 0 : subroutine horiz_coord_long_name(this, name)
446 :
447 : ! Dummy arguments
448 : class(horiz_coord_t), intent(in) :: this
449 : character(len=*), intent(out) :: name
450 :
451 0 : if (len(name) < len_trim(this%long_name)) then
452 0 : call endrun('horiz_coord_long_name: input name too short')
453 : else
454 0 : name = trim(this%long_name)
455 : end if
456 :
457 0 : end subroutine horiz_coord_long_name
458 :
459 0 : subroutine horiz_coord_units(this, units)
460 :
461 : ! Dummy arguments
462 : class(horiz_coord_t), intent(in) :: this
463 : character(len=*), intent(out) :: units
464 :
465 0 : if (len(units) < len_trim(this%units)) then
466 0 : call endrun('horiz_coord_units: input units too short')
467 : else
468 0 : units = trim(this%units)
469 : end if
470 :
471 0 : end subroutine horiz_coord_units
472 :
473 13824 : function horiz_coord_create(name, dimname, dimsize, long_name, units, &
474 13824 : lbound, ubound, values, map, bnds) result(newcoord)
475 :
476 : ! Dummy arguments
477 : character(len=*), intent(in) :: name
478 : character(len=*), intent(in) :: dimname
479 : integer, intent(in) :: dimsize
480 : character(len=*), intent(in) :: long_name
481 : character(len=*), intent(in) :: units
482 : ! NB: Sure, pointers would have made sense but . . . PGI
483 : integer, intent(in) :: lbound
484 : integer, intent(in) :: ubound
485 : real(r8), intent(in) :: values(lbound:ubound)
486 : integer(iMap), intent(in), optional :: map(ubound-lbound+1)
487 : real(r8), intent(in), optional :: bnds(2,lbound:ubound)
488 : type(horiz_coord_t), pointer :: newcoord
489 :
490 69120 : allocate(newcoord)
491 :
492 13824 : newcoord%name = trim(name)
493 13824 : newcoord%dimname = trim(dimname)
494 13824 : newcoord%dimsize = dimsize
495 13824 : newcoord%long_name = trim(long_name)
496 13824 : newcoord%units = trim(units)
497 : ! Figure out if this is a latitude or a longitude using CF standard
498 : ! http://cfconventions.org/Data/cf-conventions/cf-conventions-1.6/build/cf-conventions.html#latitude-coordinate
499 : ! http://cfconventions.org/Data/cf-conventions/cf-conventions-1.6/build/cf-conventions.html#longitude-coordinate
500 : if ( (trim(units) == 'degrees_north') .or. &
501 : (trim(units) == 'degree_north') .or. &
502 : (trim(units) == 'degree_N') .or. &
503 : (trim(units) == 'degrees_N') .or. &
504 13824 : (trim(units) == 'degreeN') .or. &
505 : (trim(units) == 'degreesN')) then
506 6912 : newcoord%latitude = .true.
507 : else if ((trim(units) == 'degrees_east') .or. &
508 : (trim(units) == 'degree_east') .or. &
509 : (trim(units) == 'degree_E') .or. &
510 : (trim(units) == 'degrees_E') .or. &
511 6912 : (trim(units) == 'degreeE') .or. &
512 : (trim(units) == 'degreesE')) then
513 6912 : newcoord%latitude = .false.
514 : else
515 0 : call endrun("horiz_coord_create: unsupported units: '"//trim(units)//"'")
516 : end if
517 41472 : allocate(newcoord%values(lbound:ubound))
518 13824 : if (ubound >= lbound) then
519 1119168 : newcoord%values(:) = values(:)
520 : end if
521 :
522 13824 : if (present(map)) then
523 1119168 : if (ANY(map < 0)) then
524 0 : call endrun("horiz_coord_create "//trim(name)//": map vals < 0")
525 : end if
526 41472 : allocate(newcoord%map(ubound - lbound + 1))
527 13824 : if (ubound >= lbound) then
528 1119168 : newcoord%map(:) = map(:)
529 : end if
530 : else
531 0 : nullify(newcoord%map)
532 : end if
533 :
534 13824 : if (present(bnds)) then
535 0 : allocate(newcoord%bnds(2, lbound:ubound))
536 0 : if (ubound >= lbound) then
537 0 : newcoord%bnds = bnds
538 : end if
539 : else
540 13824 : nullify(newcoord%bnds)
541 : end if
542 :
543 27648 : end function horiz_coord_create
544 :
545 : !---------------------------------------------------------------------------
546 : !
547 : ! write_horiz_coord_attr
548 : !
549 : ! Write the dimension and coordinate attributes for a horizontal grid
550 : ! coordinate.
551 : !
552 : !---------------------------------------------------------------------------
553 :
554 24576 : subroutine write_horiz_coord_attr(this, File, dimid_out, file_index)
555 : use pio, only: file_desc_t, pio_put_att, pio_noerr, pio_double
556 : use pio, only: pio_bcast_error, pio_seterrorhandling, pio_inq_varid
557 : use cam_pio_utils, only: cam_pio_def_dim, cam_pio_def_var
558 :
559 : ! Dummy arguments
560 : class(horiz_coord_t), intent(inout) :: this
561 : type(file_desc_t), intent(inout) :: File ! PIO file Handle
562 : integer, optional, intent(out) :: dimid_out
563 : integer, optional, intent(in) :: file_index
564 :
565 : ! Local variables
566 : type(var_desc_t) :: vardesc
567 : character(len=max_hcoordname_len) :: dimname
568 : integer :: dimid ! PIO dimension ID
569 : integer :: bnds_dimid ! PIO dim ID for bounds
570 : integer :: err_handling
571 : integer :: ierr
572 : integer :: file_index_loc
573 :
574 : ! We will handle errors for this routine
575 24576 : call pio_seterrorhandling(File, PIO_BCAST_ERROR,err_handling)
576 :
577 24576 : if (present(file_index)) then
578 24576 : file_index_loc = file_index
579 : else
580 : file_index_loc = 1
581 : end if
582 :
583 : ! Make sure the dimension exists in the file
584 24576 : call this%get_dim_name(dimname)
585 : call cam_pio_def_dim(File, trim(dimname), this%dimsize, dimid, &
586 24576 : existOK=.true.)
587 : ! Should we define the variable?
588 24576 : ierr = pio_inq_varid(File, trim(this%name), vardesc)
589 24576 : if (ierr /= PIO_NOERR) then
590 : ! Variable not already defined, it is up to us to define the variable
591 24576 : if (associated(this%vardesc(file_index_loc)%p)) then
592 : ! This should not happen (i.e., internal error)
593 0 : call endrun('write_horiz_coord_attr: vardesc already allocated for '//trim(dimname))
594 : end if
595 24576 : allocate(this%vardesc(file_index_loc)%p)
596 : call cam_pio_def_var(File, trim(this%name), pio_double, &
597 49152 : (/ dimid /), this%vardesc(file_index_loc)%p, existOK=.false.)
598 : ! long_name
599 24576 : ierr=pio_put_att(File, this%vardesc(file_index_loc)%p, 'long_name', trim(this%long_name))
600 24576 : call cam_pio_handle_error(ierr, 'Error writing "long_name" attr in write_horiz_coord_attr')
601 : ! units
602 24576 : ierr=pio_put_att(File, this%vardesc(file_index_loc)%p, 'units', trim(this%units))
603 24576 : call cam_pio_handle_error(ierr, 'Error writing "units" attr in write_horiz_coord_attr')
604 : ! Take care of bounds if they exist
605 24576 : if (associated(this%bnds)) then
606 0 : allocate(this%bndsvdesc(file_index_loc)%p)
607 0 : ierr=pio_put_att(File, this%vardesc(file_index_loc)%p, 'bounds', trim(this%name)//'_bnds')
608 0 : call cam_pio_handle_error(ierr, 'Error writing "'//trim(this%name)//'_bnds" attr in write_horiz_coord_attr')
609 0 : call cam_pio_def_dim(File, 'nbnd', 2, bnds_dimid, existOK=.true.)
610 : call cam_pio_def_var(File, trim(this%name)//'_bnds', pio_double, &
611 0 : (/ bnds_dimid, dimid /), this%bndsvdesc(file_index_loc)%p, existOK=.false.)
612 0 : call cam_pio_handle_error(ierr, 'Error defining "'//trim(this%name)//'bnds" in write_horiz_coord_attr')
613 : ! long_name
614 0 : ierr=pio_put_att(File, this%bndsvdesc(file_index_loc)%p, 'long_name', trim(this%name)//' bounds')
615 0 : call cam_pio_handle_error(ierr, 'Error writing bounds "long_name" attr in write_horiz_coord_attr')
616 : ! units
617 0 : ierr=pio_put_att(File, this%bndsvdesc(file_index_loc)%p, 'units', trim(this%units))
618 0 : call cam_pio_handle_error(ierr, 'Error writing bounds "units" attr in write_horiz_coord_attr')
619 : end if ! There are bounds for this coordinate
620 : end if ! We define the variable
621 :
622 24576 : if (present(dimid_out)) then
623 24576 : dimid_out = dimid
624 : end if
625 :
626 : ! Back to old error handling
627 24576 : call pio_seterrorhandling(File, err_handling)
628 :
629 24576 : end subroutine write_horiz_coord_attr
630 :
631 : !---------------------------------------------------------------------------
632 : !
633 : ! write_horiz_coord_var
634 : !
635 : ! Write the coordinate values for this coordinate
636 : !
637 : !---------------------------------------------------------------------------
638 :
639 24576 : subroutine write_horiz_coord_var(this, File, file_index)
640 24576 : use cam_pio_utils, only: cam_pio_get_decomp
641 : use pio, only: file_desc_t, pio_double, iosystem_desc_t
642 : use pio, only: pio_put_var, pio_write_darray
643 : use pio, only: pio_bcast_error, pio_seterrorhandling
644 : !!XXgoldyXX: HACK to get around circular dependencies. Fix this!!
645 : !!XXgoldyXX: The issue is cam_pio_utils depending on stuff in this module
646 : use pio, only: pio_initdecomp, io_desc_t, pio_freedecomp, pio_syncfile
647 : use cam_instance, only: atm_id
648 : use shr_pio_mod, only: shr_pio_getiosys
649 : !!XXgoldyXX: End of this part of the hack
650 :
651 : ! Dummy arguments
652 : class(horiz_coord_t), intent(inout) :: this
653 : type(file_desc_t), intent(inout) :: File ! PIO file Handle
654 : integer, optional, intent(in) :: file_index
655 :
656 : ! Local variables
657 : character(len=120) :: errormsg
658 : integer :: ierr
659 : integer :: ldims(1)
660 : integer :: fdims(1)
661 : integer :: err_handling
662 : type(io_desc_t) :: iodesc
663 : integer :: file_index_loc
664 : !!XXgoldyXX: HACK to get around circular dependencies. Fix this!!
665 : type(iosystem_desc_t), pointer :: piosys
666 : !!XXgoldyXX: End of this part of the hack
667 :
668 24576 : if (present(file_index)) then
669 18432 : file_index_loc = file_index
670 : else
671 : file_index_loc = 1
672 : end if
673 :
674 : ! Check to make sure we are supposed to write this var
675 24576 : if (associated(this%vardesc(file_index_loc)%p)) then
676 : ! We will handle errors for this routine
677 24576 : call pio_seterrorhandling(File, PIO_BCAST_ERROR,err_handling)
678 :
679 : ! Write out the values for this dimension variable
680 24576 : if (associated(this%map)) then
681 : ! This is a distributed variable, use pio_write_darray
682 : #if 0
683 : ldims(1) = this%num_elem()
684 : call this%get_coord_len(fdims(1))
685 : allocate(iodesc)
686 : call cam_pio_get_decomp(iodesc, ldims, fdims, PIO_DOUBLE, this%map)
687 : call pio_write_darray(File, this%vardesc(file_index_loc)%p, iodesc, this%values, ierr)
688 : nullify(iodesc) ! CAM PIO system takes over memory management of iodesc
689 : #else
690 : !!XXgoldyXX: HACK to get around circular dependencies. Fix this!!
691 24576 : piosys => shr_pio_getiosys(atm_id)
692 : call pio_initdecomp(piosys, pio_double, (/this%dimsize/), this%map, &
693 49152 : iodesc)
694 24576 : call pio_write_darray(File, this%vardesc(file_index_loc)%p, iodesc, this%values, ierr)
695 :
696 24576 : call pio_syncfile(File)
697 24576 : call pio_freedecomp(File, iodesc)
698 : ! Take care of bounds if they exist
699 24576 : if (associated(this%bnds) .and. associated(this%bndsvdesc(file_index_loc)%p)) then
700 : call pio_initdecomp(piosys, pio_double, (/2, this%dimsize/), &
701 0 : this%map, iodesc)
702 0 : call pio_write_darray(File, this%bndsvdesc(file_index_loc)%p, iodesc, this%bnds, ierr)
703 0 : call pio_syncfile(File)
704 0 : call pio_freedecomp(File, iodesc)
705 : end if
706 : #endif
707 : !!XXgoldyXX: End of this part of the hack
708 : else
709 : ! This is a local variable, pio_put_var should work fine
710 0 : ierr = pio_put_var(File, this%vardesc(file_index_loc)%p, this%values)
711 : ! Take care of bounds if they exist
712 0 : if (associated(this%bnds) .and. associated(this%bndsvdesc(file_index_loc)%p)) then
713 0 : ierr = pio_put_var(File, this%bndsvdesc(file_index_loc)%p, this%bnds)
714 : end if
715 : end if
716 24576 : write(errormsg, *) 'Error writing variable values for ',trim(this%name),&
717 49152 : ' in write_horiz_coord_var'
718 24576 : call cam_pio_handle_error(ierr, errormsg)
719 :
720 : ! Back to old error handling
721 24576 : call pio_seterrorhandling(File, err_handling)
722 :
723 : ! We are done with this variable descriptor, reset for next file
724 24576 : deallocate(this%vardesc(file_index_loc)%p)
725 24576 : nullify(this%vardesc(file_index_loc)%p)
726 : ! Same with the bounds descriptor
727 24576 : if (associated(this%bndsvdesc(file_index_loc)%p)) then
728 0 : deallocate(this%bndsvdesc(file_index_loc)%p)
729 0 : nullify(this%bndsvdesc(file_index_loc)%p)
730 : end if
731 : end if ! Do we write the variable?
732 :
733 24576 : end subroutine write_horiz_coord_var
734 :
735 : !!#######################################################################
736 : !!
737 : !! CAM grid functions
738 : !!
739 : !!#######################################################################
740 :
741 213319008 : integer function get_cam_grid_index_char(gridname)
742 : ! Dummy arguments
743 : character(len=*), intent(in) :: gridname
744 : ! Local variables
745 : integer :: i
746 :
747 213319008 : get_cam_grid_index_char = -1
748 952919136 : do i = 1, registeredhgrids
749 952919136 : if(trim(gridname) == trim(cam_grids(i)%name)) then
750 213312096 : get_cam_grid_index_char = i
751 213312096 : exit
752 : end if
753 : end do
754 :
755 24576 : end function get_cam_grid_index_char
756 :
757 72772272 : integer function get_cam_grid_index_int(gridid)
758 : ! Dummy arguments
759 : integer, intent(in) :: gridid
760 : ! Local variables
761 : integer :: i
762 :
763 72772272 : get_cam_grid_index_int = -1
764 323436216 : do i = 1, registeredhgrids
765 323436216 : if(gridid == cam_grids(i)%id) then
766 : get_cam_grid_index_int = i
767 : exit
768 : end if
769 : end do
770 :
771 72772272 : end function get_cam_grid_index_int
772 :
773 30720 : subroutine find_cam_grid_attr(gridind, name, attr)
774 : ! Dummy arguments
775 : integer, intent(in) :: gridind
776 : character(len=*), intent(in) :: name
777 : class(cam_grid_attribute_t), pointer, intent(out) :: attr
778 : ! Local variable
779 : type(cam_grid_attr_ptr_t), pointer :: attrPtr
780 :
781 30720 : nullify(attr)
782 30720 : attrPtr => cam_grids(gridind)%attributes
783 72960 : do while (associated(attrPtr))
784 : !!XXgoldyXX: Is this not working in PGI?
785 : ! attr => attrPtr%getAttr()
786 45312 : attr => attrPtr%attr
787 72960 : if (trim(name) == trim(attr%name)) then
788 : exit
789 : else
790 : !!XXgoldyXX: Is this not working in PGI?
791 : ! attrPtr => attrPtr%getNext()
792 42240 : attrPtr => attrPtr%next
793 42240 : nullify(attr)
794 : end if
795 : end do
796 30720 : return ! attr should be NULL if not found
797 : end subroutine find_cam_grid_attr
798 :
799 1536 : logical function cam_grid_attr_exists(gridname, name)
800 : ! Dummy arguments
801 : character(len=*), intent(in) :: gridname
802 : character(len=*), intent(in) :: name
803 : ! Local variables
804 : class(cam_grid_attribute_t), pointer :: attr
805 : integer :: gridind
806 :
807 1536 : gridind = get_cam_grid_index(trim(gridname))
808 1536 : if (gridind > 0) then
809 1536 : call find_cam_grid_attr(gridind, name, attr)
810 1536 : cam_grid_attr_exists = associated(attr)
811 1536 : nullify(attr)
812 : else
813 0 : call endrun('cam_grid_attr_exists: Bad grid name, "'//trim(gridname)//'"')
814 : end if
815 1536 : end function cam_grid_attr_exists
816 :
817 : integer function num_cam_grid_attrs(gridind)
818 : ! Dummy arguments
819 : integer, intent(in) :: gridind
820 :
821 : ! Local variables
822 : class(cam_grid_attr_ptr_t), pointer :: attrPtr
823 :
824 : num_cam_grid_attrs = 0
825 : attrPtr => cam_grids(gridind)%attributes
826 : do while (associated(attrPtr))
827 : num_cam_grid_attrs = num_cam_grid_attrs + 1
828 : !!XXgoldyXX: Is this not working in PGI?
829 : ! attrPtr => attrPtr%getNext()
830 : attrPtr => attrPtr%next
831 : end do
832 : end function num_cam_grid_attrs
833 :
834 6912 : subroutine cam_grid_register(name, id, lat_coord, lon_coord, map, &
835 : unstruct, block_indexed, zonal_grid, src_in, dest_in)
836 : ! Dummy arguments
837 : character(len=*), intent(in) :: name
838 : integer, intent(in) :: id
839 : type(horiz_coord_t), pointer, intent(in) :: lat_coord
840 : type(horiz_coord_t), pointer, intent(in) :: lon_coord
841 : integer(iMap), pointer, intent(in) :: map(:,:)
842 : logical, optional, intent(in) :: unstruct
843 : logical, optional, intent(in) :: block_indexed
844 : logical, optional, intent(in) :: zonal_grid
845 : integer, optional, intent(in) :: src_in(2)
846 : integer, optional, intent(in) :: dest_in(2)
847 :
848 : ! Local variables
849 : character(len=max_hcoordname_len) :: latdimname, londimname
850 : character(len=120) :: errormsg
851 : integer :: i
852 : integer :: src(2), dest(2)
853 : character(len=*), parameter :: subname = 'CAM_GRID_REGISTER'
854 :
855 : ! For a values grid, we do not allow multiple calls
856 6912 : if (get_cam_grid_index(trim(name)) > 0) then
857 0 : call endrun(trim(subname)//': Grid, '//trim(name)//', already exists')
858 6912 : else if (get_cam_grid_index(id) > 0) then
859 0 : i = get_cam_grid_index(id)
860 0 : write(errormsg, '(4a,i5,3a)') trim(subname), ': Attempt to add grid, ', &
861 0 : trim(name), ' with id = ', id, ', however, grid ', &
862 0 : trim(cam_grids(i)%name), ' already has that ID'
863 0 : call endrun(trim(errormsg))
864 6912 : else if (registeredhgrids >= maxhgrids) then
865 0 : call endrun(trim(subname)//": Too many grids")
866 : else
867 6912 : registeredhgrids = registeredhgrids + 1
868 6912 : cam_grids(registeredhgrids)%name = trim(name)
869 6912 : cam_grids(registeredhgrids)%id = id
870 : ! Quick sanity checks to make sure these aren't mixed up
871 6912 : if (.not. lat_coord%latitude) then
872 0 : call endrun(subname//': lat_coord is not a latitude coordinate')
873 : end if
874 6912 : if (lon_coord%latitude) then
875 0 : call endrun(subname//': lon_coord is not a longitude coordinate')
876 : end if
877 6912 : cam_grids(registeredhgrids)%lat_coord => lat_coord
878 6912 : cam_grids(registeredhgrids)%lon_coord => lon_coord
879 6912 : call lat_coord%get_dim_name(latdimname)
880 6912 : call lon_coord%get_dim_name(londimname)
881 6912 : if (present(unstruct)) then
882 6912 : cam_grids(registeredhgrids)%unstructured = unstruct
883 : else
884 0 : if (trim(latdimname) == trim(londimname)) then
885 0 : cam_grids(registeredhgrids)%unstructured = .true.
886 : else
887 0 : cam_grids(registeredhgrids)%unstructured = .false.
888 : end if
889 : end if
890 6912 : if (present(block_indexed)) then
891 6912 : cam_grids(registeredhgrids)%block_indexed = block_indexed
892 : else
893 0 : cam_grids(registeredhgrids)%block_indexed = cam_grids(registeredhgrids)%unstructured
894 : end if
895 6912 : if (present(zonal_grid)) then
896 : ! Check the size of the longitude coordinate
897 0 : call lon_coord%get_coord_len(i)
898 0 : if (i /= 1) then
899 0 : call endrun(subname//': lon_coord is not of size 1 for a zonal grid')
900 : end if
901 0 : cam_grids(registeredhgrids)%zonal_grid = zonal_grid
902 : else
903 6912 : cam_grids(registeredhgrids)%zonal_grid = .false.
904 : end if
905 6912 : if (associated(cam_grids(registeredhgrids)%map)) then
906 0 : call endrun(trim(subname)//": new grid map should not be associated")
907 : end if
908 6912 : if (present(src_in)) then
909 0 : src = src_in
910 : else
911 6912 : src(1) = 1
912 6912 : src(2) = -1
913 : end if
914 6912 : if (present(dest_in)) then
915 0 : dest = dest_in
916 : else
917 6912 : dest(1) = 1
918 6912 : if (cam_grids(registeredhgrids)%unstructured) then
919 6912 : dest(2) = 0
920 : else
921 0 : dest(2) = 2
922 : end if
923 : end if
924 76032 : allocate(cam_grids(registeredhgrids)%map)
925 : call cam_grids(registeredhgrids)%map%init(map, &
926 6912 : cam_grids(registeredhgrids)%unstructured, src, dest)
927 6912 : call cam_grids(registeredhgrids)%print_cam_grid()
928 : end if
929 :
930 6912 : end subroutine cam_grid_register
931 :
932 6912 : subroutine print_cam_grid(this)
933 : class(cam_grid_t) :: this
934 :
935 : type(cam_grid_attr_ptr_t), pointer :: attrPtr
936 : class(cam_grid_attribute_t), pointer :: attr
937 6912 : if (masterproc) then
938 9 : write(iulog, '(3a,i4,4a,3(a,l2))') 'Grid: ', trim(this%name), &
939 9 : ', ID = ', this%id, &
940 9 : ', lat coord = ', trim(this%lat_coord%name), &
941 9 : ', lon coord = ', trim(this%lon_coord%name), &
942 9 : ', unstruct = ', this%unstructured, &
943 9 : ', block_ind = ', this%block_indexed, &
944 18 : ', zonal_grid = ', this%zonal_grid
945 9 : attrPtr => this%attributes
946 9 : do while (associated(attrPtr))
947 : !!XXgoldyXX: Is this not working in PGI?
948 : ! attr => attrPtr%getAttr()
949 0 : attr => attrPtr%attr
950 0 : call attr%print_attr()
951 : !!XXgoldyXX: Is this not working in PGI?
952 : ! attrPtr => attrPtr%getNext()
953 0 : attrPtr => attrPtr%next
954 : end do
955 : end if
956 6912 : end subroutine print_cam_grid
957 :
958 464640 : integer function cam_grid_num_grids()
959 464640 : cam_grid_num_grids = registeredhgrids
960 464640 : end function cam_grid_num_grids
961 :
962 : ! Return .true. iff id represents a valid CAM grid
963 458496 : logical function cam_grid_check(id)
964 : ! Dummy argument
965 : integer, intent(in) :: id
966 :
967 : cam_grid_check = ((get_cam_grid_index(id) > 0) .and. &
968 458496 : (get_cam_grid_index(id) <= cam_grid_num_grids()))
969 458496 : end function cam_grid_check
970 :
971 213279072 : integer function cam_grid_id(name)
972 : ! Dummy argument
973 : character(len=*), intent(in) :: name
974 :
975 : ! Local variable
976 : integer :: index
977 :
978 213279072 : index = get_cam_grid_index(name)
979 213279072 : if (index > 0) then
980 213279072 : cam_grid_id = cam_grids(index)%id
981 : else
982 : cam_grid_id = -1
983 : end if
984 :
985 213279072 : end function cam_grid_id
986 :
987 : ! Return the size of a local array for grid, ID.
988 : ! With no optional argument, return the basic 2D array size
989 : ! nlev represents levels or the total column size (product(mdims))
990 0 : integer function cam_grid_get_local_size(id, nlev)
991 :
992 : ! Dummy arguments
993 : integer, intent(in) :: id
994 : integer, optional, intent(in) :: nlev
995 :
996 : ! Local variables
997 : integer :: gridid
998 : character(len=128) :: errormsg
999 :
1000 0 : gridid = get_cam_grid_index(id)
1001 0 : if (gridid > 0) then
1002 0 : cam_grid_get_local_size = cam_grids(gridid)%num_elem()
1003 0 : if (present(nlev)) then
1004 0 : cam_grid_get_local_size = cam_grid_get_local_size * nlev
1005 : end if
1006 : else
1007 0 : write(errormsg, *) 'cam_grid_get_local_size: Bad grid ID, ', id
1008 0 : call endrun(errormsg)
1009 : end if
1010 :
1011 0 : end function cam_grid_get_local_size
1012 :
1013 : ! Given some array information, find the dimension NetCDF IDs on <File> for this grid
1014 1536 : subroutine cam_grid_get_file_dimids(id, File, dimids)
1015 : use pio, only: file_desc_t
1016 :
1017 : ! Dummy arguments
1018 : integer, intent(in) :: id
1019 : type(file_desc_t), intent(inout) :: File ! PIO file handle
1020 : integer, intent(out) :: dimids(:)
1021 :
1022 : ! Local variables
1023 : integer :: gridid
1024 : character(len=128) :: errormsg
1025 :
1026 1536 : gridid = get_cam_grid_index(id)
1027 1536 : if (gridid > 0) then
1028 1536 : call cam_grids(gridid)%find_dimids(File, dimids)
1029 : else
1030 0 : write(errormsg, *) 'cam_grid_get_file_dimids: Bad grid ID, ', id
1031 0 : call endrun(errormsg)
1032 : end if
1033 :
1034 1536 : end subroutine cam_grid_get_file_dimids
1035 :
1036 : ! Given some array information, find or compute a PIO decomposition
1037 272640 : subroutine cam_grid_get_decomp(id, field_lens, file_lens, dtype, iodesc, &
1038 272640 : field_dnames, file_dnames)
1039 : use pio, only: io_desc_t
1040 :
1041 : ! Dummy arguments
1042 : integer, intent(in) :: id
1043 : integer, intent(in) :: field_lens(:) ! Array dim sizes
1044 : integer, intent(in) :: file_lens(:) ! File dim sizes
1045 : integer, intent(in) :: dtype
1046 : type(io_desc_t), pointer, intent(out) :: iodesc
1047 : character(len=*), optional, intent(in) :: field_dnames(:)
1048 : character(len=*), optional, intent(in) :: file_dnames(:)
1049 :
1050 : ! Local variables
1051 : integer :: gridid
1052 : character(len=128) :: errormsg
1053 :
1054 272640 : gridid = get_cam_grid_index(id)
1055 272640 : if (gridid > 0) then
1056 0 : call cam_grids(gridid)%get_decomp(field_lens, file_lens, dtype, iodesc, &
1057 575232 : field_dnames, file_dnames)
1058 : else
1059 0 : write(errormsg, *) 'cam_grid_get_decomp: Bad grid ID, ', id
1060 0 : call endrun(errormsg)
1061 : end if
1062 :
1063 272640 : end subroutine cam_grid_get_decomp
1064 :
1065 : !---------------------------------------------------------------------------
1066 : !
1067 : ! cam_grid_read_dist_array_2d_int
1068 : !
1069 : ! Interface function for the grid%read_darray_2d_int method
1070 : !
1071 : !---------------------------------------------------------------------------
1072 768 : subroutine cam_grid_read_dist_array_2d_int(File, id, adims, fdims, hbuf, varid)
1073 : use pio, only: file_desc_t
1074 :
1075 : ! Dummy arguments
1076 : type(file_desc_t), intent(inout) :: File ! PIO file handle
1077 : integer, intent(in) :: id
1078 : integer, intent(in) :: adims(:)
1079 : integer, intent(in) :: fdims(:)
1080 : integer, intent(out) :: hbuf(:,:)
1081 : type(var_desc_t), intent(inout) :: varid
1082 :
1083 : ! Local variable
1084 : integer :: gridid
1085 : character(len=120) :: errormsg
1086 :
1087 768 : gridid = get_cam_grid_index(id)
1088 768 : if (gridid > 0) then
1089 768 : call cam_grids(gridid)%read_darray_2d_int(File, adims, fdims, hbuf, varid)
1090 : else
1091 0 : write(errormsg, *) 'cam_grid_read_dist_array_2d_int: Bad grid ID, ', id
1092 0 : call endrun(errormsg)
1093 : end if
1094 :
1095 768 : end subroutine cam_grid_read_dist_array_2d_int
1096 :
1097 : !---------------------------------------------------------------------------
1098 : !
1099 : ! cam_grid_read_dist_array_3d_int
1100 : !
1101 : ! Interface function for the grid%read_darray_2d_ method
1102 : !
1103 : !---------------------------------------------------------------------------
1104 0 : subroutine cam_grid_read_dist_array_3d_int(File, id, adims, fdims, hbuf, varid)
1105 : use pio, only: file_desc_t
1106 :
1107 : ! Dummy arguments
1108 : type(file_desc_t), intent(inout) :: File ! PIO file handle
1109 : integer, intent(in) :: id
1110 : integer, intent(in) :: adims(:)
1111 : integer, intent(in) :: fdims(:)
1112 : integer, intent(out) :: hbuf(:,:,:)
1113 : type(var_desc_t), intent(inout) :: varid
1114 :
1115 : ! Local variable
1116 : integer :: gridid
1117 : character(len=120) :: errormsg
1118 :
1119 0 : gridid = get_cam_grid_index(id)
1120 0 : if (gridid > 0) then
1121 0 : call cam_grids(gridid)%read_darray_3d_int(File, adims, fdims, hbuf, varid)
1122 : else
1123 0 : write(errormsg, *) 'cam_grid_read_dist_array_3d_int: Bad grid ID, ', id
1124 0 : call endrun(errormsg)
1125 : end if
1126 :
1127 0 : end subroutine cam_grid_read_dist_array_3d_int
1128 :
1129 : !---------------------------------------------------------------------------
1130 : !
1131 : ! cam_grid_read_dist_array_2d_double
1132 : !
1133 : ! Interface function for the grid%read_darray_2d_double method
1134 : !
1135 : !---------------------------------------------------------------------------
1136 19968 : subroutine cam_grid_read_dist_array_2d_double(File, id, adims, fdims, hbuf, varid)
1137 : use pio, only: file_desc_t
1138 :
1139 : ! Dummy arguments
1140 : type(file_desc_t), intent(inout) :: File ! PIO file handle
1141 : integer, intent(in) :: id
1142 : integer, intent(in) :: adims(:)
1143 : integer, intent(in) :: fdims(:)
1144 : real(r8), intent(out) :: hbuf(:,:)
1145 : type(var_desc_t), intent(inout) :: varid
1146 :
1147 : ! Local variable
1148 : integer :: gridid
1149 : character(len=120) :: errormsg
1150 :
1151 19968 : gridid = get_cam_grid_index(id)
1152 19968 : if (gridid > 0) then
1153 19968 : call cam_grids(gridid)%read_darray_2d_double(File, adims, fdims, hbuf, varid)
1154 : else
1155 0 : write(errormsg, *) 'cam_grid_read_dist_array_2d_double: Bad grid ID, ', id
1156 0 : call endrun(errormsg)
1157 : end if
1158 :
1159 19968 : end subroutine cam_grid_read_dist_array_2d_double
1160 :
1161 : !---------------------------------------------------------------------------
1162 : !
1163 : ! cam_grid_read_dist_array_3d_double
1164 : !
1165 : ! Interface function for the grid%read_darray_3d_double method
1166 : !
1167 : !---------------------------------------------------------------------------
1168 83712 : subroutine cam_grid_read_dist_array_3d_double(File, id, adims, fdims, hbuf, varid)
1169 : use pio, only: file_desc_t
1170 :
1171 : ! Dummy arguments
1172 : type(file_desc_t), intent(inout) :: File ! PIO file handle
1173 : integer, intent(in) :: id
1174 : integer, intent(in) :: adims(:)
1175 : integer, intent(in) :: fdims(:)
1176 : real(r8), intent(out) :: hbuf(:,:,:)
1177 : type(var_desc_t), intent(inout) :: varid
1178 :
1179 : ! Local variable
1180 : integer :: gridid
1181 : character(len=120) :: errormsg
1182 :
1183 83712 : gridid = get_cam_grid_index(id)
1184 83712 : if (gridid > 0) then
1185 83712 : call cam_grids(gridid)%read_darray_3d_double(File, adims, fdims, hbuf, varid)
1186 : else
1187 0 : write(errormsg, *) 'cam_grid_read_dist_array_3d_double: Bad grid ID, ', id
1188 0 : call endrun(errormsg)
1189 : end if
1190 :
1191 83712 : end subroutine cam_grid_read_dist_array_3d_double
1192 :
1193 : !---------------------------------------------------------------------------
1194 : !
1195 : ! cam_grid_read_dist_array_2d_real
1196 : !
1197 : ! Interface function for the grid%read_darray_2d_real method
1198 : !
1199 : !---------------------------------------------------------------------------
1200 0 : subroutine cam_grid_read_dist_array_2d_real(File, id, adims, fdims, hbuf, varid)
1201 : use pio, only: file_desc_t
1202 :
1203 : ! Dummy arguments
1204 : type(file_desc_t), intent(inout) :: File ! PIO file handle
1205 : integer, intent(in) :: id
1206 : integer, intent(in) :: adims(:)
1207 : integer, intent(in) :: fdims(:)
1208 : real(r4), intent(out) :: hbuf(:,:)
1209 : type(var_desc_t), intent(inout) :: varid
1210 :
1211 : ! Local variable
1212 : integer :: gridid
1213 : character(len=120) :: errormsg
1214 :
1215 0 : gridid = get_cam_grid_index(id)
1216 0 : if (gridid > 0) then
1217 0 : call cam_grids(gridid)%read_darray_2d_real(File, adims, fdims, hbuf, varid)
1218 : else
1219 0 : write(errormsg, *) 'cam_grid_read_dist_array_2d_real: Bad grid ID, ', id
1220 0 : call endrun(errormsg)
1221 : end if
1222 :
1223 0 : end subroutine cam_grid_read_dist_array_2d_real
1224 :
1225 : !---------------------------------------------------------------------------
1226 : !
1227 : ! cam_grid_read_dist_array_3d_real
1228 : !
1229 : ! Interface function for the grid%read_darray_3d_real method
1230 : !
1231 : !---------------------------------------------------------------------------
1232 0 : subroutine cam_grid_read_dist_array_3d_real(File, id, adims, fdims, hbuf, varid)
1233 : use pio, only: file_desc_t
1234 :
1235 : ! Dummy arguments
1236 : type(file_desc_t), intent(inout) :: File ! PIO file handle
1237 : integer, intent(in) :: id
1238 : integer, intent(in) :: adims(:)
1239 : integer, intent(in) :: fdims(:)
1240 : real(r4), intent(out) :: hbuf(:,:,:)
1241 : type(var_desc_t), intent(inout) :: varid
1242 :
1243 : ! Local variable
1244 : integer :: gridid
1245 : character(len=120) :: errormsg
1246 :
1247 0 : gridid = get_cam_grid_index(id)
1248 0 : if (gridid > 0) then
1249 0 : call cam_grids(gridid)%read_darray_3d_real(File, adims, fdims, hbuf, varid)
1250 : else
1251 0 : write(errormsg, *) 'cam_grid_read_dist_array_3d_real: Bad grid ID, ', id
1252 0 : call endrun(errormsg)
1253 : end if
1254 :
1255 0 : end subroutine cam_grid_read_dist_array_3d_real
1256 :
1257 : !---------------------------------------------------------------------------
1258 : !
1259 : ! cam_grid_write_dist_array_2d_int
1260 : !
1261 : ! Interface function for the grid%write_darray_2d_int method
1262 : !
1263 : !---------------------------------------------------------------------------
1264 1536 : subroutine cam_grid_write_dist_array_2d_int(File, id, adims, fdims, hbuf, varid)
1265 : use pio, only: file_desc_t
1266 :
1267 : ! Dummy arguments
1268 : type(file_desc_t), intent(inout) :: File ! PIO file handle
1269 : integer, intent(in) :: id
1270 : integer, intent(in) :: adims(:)
1271 : integer, intent(in) :: fdims(:)
1272 : integer, intent(in) :: hbuf(:,:)
1273 : type(var_desc_t), intent(inout) :: varid
1274 :
1275 : ! Local variable
1276 : integer :: gridid
1277 : character(len=120) :: errormsg
1278 :
1279 1536 : gridid = get_cam_grid_index(id)
1280 1536 : if (gridid > 0) then
1281 1536 : call cam_grids(gridid)%write_darray_2d_int(File, adims, fdims, hbuf, varid)
1282 : else
1283 0 : write(errormsg, *) 'cam_grid_write_dist_array_2d_int: Bad grid ID, ', id
1284 0 : call endrun(errormsg)
1285 : end if
1286 :
1287 1536 : end subroutine cam_grid_write_dist_array_2d_int
1288 :
1289 : !---------------------------------------------------------------------------
1290 : !
1291 : ! cam_grid_write_dist_array_3d_int
1292 : !
1293 : ! Interface function for the grid%write_darray_3d_int method
1294 : !
1295 : !---------------------------------------------------------------------------
1296 0 : subroutine cam_grid_write_dist_array_3d_int(File, id, adims, fdims, hbuf, varid)
1297 : use pio, only: file_desc_t
1298 :
1299 : ! Dummy arguments
1300 : type(file_desc_t), intent(inout) :: File ! PIO file handle
1301 : integer, intent(in) :: id
1302 : integer, intent(in) :: adims(:)
1303 : integer, intent(in) :: fdims(:)
1304 : integer, intent(in) :: hbuf(:,:,:)
1305 : type(var_desc_t), intent(inout) :: varid
1306 :
1307 : ! Local variable
1308 : integer :: gridid
1309 : character(len=120) :: errormsg
1310 :
1311 0 : gridid = get_cam_grid_index(id)
1312 0 : if (gridid > 0) then
1313 0 : call cam_grids(gridid)%write_darray_3d_int(File, adims, fdims, hbuf, varid)
1314 : else
1315 0 : write(errormsg, *) 'cam_grid_write_dist_array_3d_int: Bad grid ID, ', id
1316 0 : call endrun(errormsg)
1317 : end if
1318 :
1319 0 : end subroutine cam_grid_write_dist_array_3d_int
1320 :
1321 : !---------------------------------------------------------------------------
1322 : !
1323 : ! cam_grid_write_dist_array_2d_double
1324 : !
1325 : ! Interface function for the grid%write_darray_2d_double method
1326 : !
1327 : !---------------------------------------------------------------------------
1328 39936 : subroutine cam_grid_write_dist_array_2d_double(File, id, adims, fdims, hbuf, varid)
1329 : use pio, only: file_desc_t
1330 :
1331 : ! Dummy arguments
1332 : type(file_desc_t), intent(inout) :: File ! PIO file handle
1333 : integer, intent(in) :: id
1334 : integer, intent(in) :: adims(:)
1335 : integer, intent(in) :: fdims(:)
1336 : real(r8), intent(in) :: hbuf(:,:)
1337 : type(var_desc_t), intent(inout) :: varid
1338 :
1339 : ! Local variable
1340 : integer :: gridid
1341 : character(len=120) :: errormsg
1342 :
1343 39936 : gridid = get_cam_grid_index(id)
1344 39936 : if (gridid > 0) then
1345 39936 : call cam_grids(gridid)%write_darray_2d_double(File, adims, fdims, hbuf, varid)
1346 : else
1347 0 : write(errormsg, *) 'cam_grid_write_dist_array_2d_double: Bad grid ID, ', id
1348 0 : call endrun(errormsg)
1349 : end if
1350 :
1351 39936 : end subroutine cam_grid_write_dist_array_2d_double
1352 :
1353 : !---------------------------------------------------------------------------
1354 : !
1355 : ! cam_grid_write_dist_array_3d_double
1356 : !
1357 : ! Interface function for the grid%write_darray_3d_double method
1358 : !
1359 : !---------------------------------------------------------------------------
1360 167424 : subroutine cam_grid_write_dist_array_3d_double(File, id, adims, fdims, hbuf, varid)
1361 : use pio, only: file_desc_t
1362 :
1363 : ! Dummy arguments
1364 : type(file_desc_t), intent(inout) :: File ! PIO file handle
1365 : integer, intent(in) :: id
1366 : integer, intent(in) :: adims(:)
1367 : integer, intent(in) :: fdims(:)
1368 : real(r8), intent(in) :: hbuf(:,:,:)
1369 : type(var_desc_t), intent(inout) :: varid
1370 :
1371 : ! Local variable
1372 : integer :: gridid
1373 : character(len=120) :: errormsg
1374 :
1375 167424 : gridid = get_cam_grid_index(id)
1376 167424 : if (gridid > 0) then
1377 167424 : call cam_grids(gridid)%write_darray_3d_double(File, adims, fdims, hbuf, varid)
1378 : else
1379 0 : write(errormsg, *) 'cam_grid_write_dist_array_3d_double: Bad grid ID, ', id
1380 0 : call endrun(errormsg)
1381 : end if
1382 :
1383 167424 : end subroutine cam_grid_write_dist_array_3d_double
1384 :
1385 : !---------------------------------------------------------------------------
1386 : !
1387 : ! cam_grid_write_dist_array_2d_real
1388 : !
1389 : ! Interface function for the grid%write_darray_2d_real method
1390 : !
1391 : !---------------------------------------------------------------------------
1392 1211904 : subroutine cam_grid_write_dist_array_2d_real(File, id, adims, fdims, hbuf, varid)
1393 : use pio, only: file_desc_t
1394 :
1395 : ! Dummy arguments
1396 : type(file_desc_t), intent(inout) :: File ! PIO file handle
1397 : integer, intent(in) :: id
1398 : integer, intent(in) :: adims(:)
1399 : integer, intent(in) :: fdims(:)
1400 : real(r4), intent(in) :: hbuf(:,:)
1401 : type(var_desc_t), intent(inout) :: varid
1402 :
1403 : ! Local variable
1404 : integer :: gridid
1405 : character(len=120) :: errormsg
1406 :
1407 1211904 : gridid = get_cam_grid_index(id)
1408 1211904 : if (gridid > 0) then
1409 1211904 : call cam_grids(gridid)%write_darray_2d_real(File, adims, fdims, hbuf, varid)
1410 : else
1411 0 : write(errormsg, *) 'cam_grid_write_dist_array_2d_real: Bad grid ID, ', id
1412 0 : call endrun(errormsg)
1413 : end if
1414 :
1415 1211904 : end subroutine cam_grid_write_dist_array_2d_real
1416 :
1417 : !---------------------------------------------------------------------------
1418 : !
1419 : ! cam_grid_write_dist_array_3d_real
1420 : !
1421 : ! Interface function for the grid%write_darray_3d_real method
1422 : !
1423 : !---------------------------------------------------------------------------
1424 695808 : subroutine cam_grid_write_dist_array_3d_real(File, id, adims, fdims, hbuf, varid)
1425 : use pio, only: file_desc_t
1426 :
1427 : ! Dummy arguments
1428 : type(file_desc_t), intent(inout) :: File ! PIO file handle
1429 : integer, intent(in) :: id
1430 : integer, intent(in) :: adims(:)
1431 : integer, intent(in) :: fdims(:)
1432 : real(r4), intent(in) :: hbuf(:,:,:)
1433 : type(var_desc_t), intent(inout) :: varid
1434 :
1435 : ! Local variable
1436 : integer :: gridid
1437 : character(len=120) :: errormsg
1438 :
1439 695808 : gridid = get_cam_grid_index(id)
1440 695808 : if (gridid > 0) then
1441 695808 : call cam_grids(gridid)%write_darray_3d_real(File, adims, fdims, hbuf, varid)
1442 : else
1443 0 : write(errormsg, *) 'cam_grid_write_dist_array_3d_real: Bad grid ID, ', id
1444 0 : call endrun(errormsg)
1445 : end if
1446 :
1447 695808 : end subroutine cam_grid_write_dist_array_3d_real
1448 :
1449 2304 : subroutine cam_grid_get_gcid(id, gcid)
1450 :
1451 : ! Dummy arguments
1452 : integer, intent(in) :: id
1453 : integer(iMap), pointer :: gcid(:)
1454 :
1455 : ! Local variables
1456 : integer :: gridid
1457 : integer :: fieldbounds(2,2)
1458 : integer :: fieldlens(2)
1459 : integer :: filelens(2)
1460 : type(cam_filemap_t), pointer :: map
1461 :
1462 2304 : gridid = get_cam_grid_index(id)
1463 2304 : if (gridid > 0) then
1464 2304 : map => cam_grids(gridid)%map
1465 2304 : call cam_grids(gridid)%coord_lengths(filelens)
1466 2304 : call map%array_bounds(fieldbounds)
1467 6912 : fieldlens(:) = fieldbounds(:,2) - fieldbounds(:,1) + 1
1468 2304 : call map%get_filemap(fieldlens, filelens, gcid)
1469 : else
1470 0 : call endrun('cam_grid_get_gcid: Bad grid ID')
1471 : end if
1472 2304 : end subroutine cam_grid_get_gcid
1473 :
1474 5372160 : subroutine cam_grid_get_array_bounds(id, dims)
1475 :
1476 : ! Dummy arguments
1477 : integer, intent(in) :: id
1478 : integer, intent(inout) :: dims(:,:)
1479 :
1480 : ! Local variables
1481 : integer :: gridid
1482 5372160 : gridid = get_cam_grid_index(id)
1483 5372160 : if (gridid > 0) then
1484 5372160 : if (.not. associated(cam_grids(gridid)%map)) then
1485 0 : call endrun('cam_grid_get_array_bounds: Grid, '//trim(cam_grids(gridid)%name)//', has no map')
1486 : else
1487 5372160 : call cam_grids(gridid)%map%array_bounds(dims)
1488 : end if
1489 : else
1490 0 : call endrun('cam_grid_get_array_bounds: Bad grid ID')
1491 : end if
1492 :
1493 5372160 : end subroutine cam_grid_get_array_bounds
1494 :
1495 : !---------------------------------------------------------------------------
1496 : !
1497 : ! cam_grid_get_coord_names: Return the names of the grid axes
1498 : !
1499 : !---------------------------------------------------------------------------
1500 0 : subroutine cam_grid_get_coord_names(id, lon_name, lat_name)
1501 :
1502 : ! Dummy arguments
1503 : integer, intent(in) :: id
1504 : character(len=*), intent(out) :: lon_name
1505 : character(len=*), intent(out) :: lat_name
1506 :
1507 : ! Local variables
1508 : integer :: gridid
1509 0 : gridid = get_cam_grid_index(id)
1510 0 : if (gridid > 0) then
1511 0 : call cam_grids(gridid)%coord_names(lon_name, lat_name)
1512 : else
1513 0 : call endrun('cam_grid_get_coord_names: Bad grid ID')
1514 : end if
1515 :
1516 0 : end subroutine cam_grid_get_coord_names
1517 :
1518 : !---------------------------------------------------------------------------
1519 : !
1520 : ! cam_grid_get_dim_names: Return the names of the grid axes dimensions.
1521 : ! Note that these may be the same
1522 : !
1523 : !---------------------------------------------------------------------------
1524 183552 : subroutine cam_grid_get_dim_names_id(id, name1, name2)
1525 :
1526 : ! Dummy arguments
1527 : integer, intent(in) :: id
1528 : character(len=*), intent(out) :: name1
1529 : character(len=*), intent(out) :: name2
1530 :
1531 : ! Local variables
1532 : integer :: gridid
1533 183552 : gridid = get_cam_grid_index(id)
1534 183552 : if (gridid > 0) then
1535 183552 : call cam_grids(gridid)%dim_names(name1, name2)
1536 : else
1537 0 : call endrun('cam_grid_get_dim_names_id: Bad grid ID')
1538 : end if
1539 :
1540 183552 : end subroutine cam_grid_get_dim_names_id
1541 :
1542 0 : subroutine cam_grid_get_dim_names_name(gridname, name1, name2)
1543 :
1544 : ! Dummy arguments
1545 : character(len=*), intent(in) :: gridname
1546 : character(len=*), intent(out) :: name1
1547 : character(len=*), intent(out) :: name2
1548 :
1549 : ! Local variables
1550 : integer :: gridind
1551 : character(len=120) :: errormsg
1552 :
1553 0 : gridind = get_cam_grid_index(trim(gridname))
1554 0 : if (gridind < 0) then
1555 0 : write(errormsg, *) 'No CAM grid with name = ', trim(gridname)
1556 0 : call endrun('cam_grid_get_dim_names_name: '//errormsg)
1557 : else
1558 0 : call cam_grids(gridind)%dim_names(name1, name2)
1559 : end if
1560 :
1561 0 : end subroutine cam_grid_get_dim_names_name
1562 :
1563 0 : logical function cam_grid_has_blocksize(id)
1564 :
1565 : ! Dummy arguments
1566 : integer, intent(in) :: id
1567 :
1568 : ! Local variables
1569 : integer :: gridid
1570 0 : gridid = get_cam_grid_index(id)
1571 0 : if (gridid > 0) then
1572 0 : if (.not. associated(cam_grids(gridid)%map)) then
1573 0 : call endrun('cam_grid_has_blocksize: Grid, '//trim(cam_grids(gridid)%name)//', has no map')
1574 : else
1575 0 : cam_grid_has_blocksize = cam_grids(gridid)%map%has_blocksize()
1576 : end if
1577 : else
1578 0 : call endrun('cam_grid_has_blocksize: Bad grid ID')
1579 : end if
1580 0 : end function cam_grid_has_blocksize
1581 :
1582 : ! Return the number of active columns in the block specified by block_id
1583 52563888 : integer function cam_grid_get_block_count(id, block_id) result(ncol)
1584 :
1585 : ! Dummy arguments
1586 : integer, intent(in) :: id
1587 : integer, intent(in) :: block_id
1588 :
1589 : ! Local variables
1590 : integer :: gridid
1591 52563888 : gridid = get_cam_grid_index(id)
1592 52563888 : if (gridid > 0) then
1593 52563888 : if (.not. associated(cam_grids(gridid)%map)) then
1594 0 : call endrun('cam_grid_get_block_count: Grid, '//trim(cam_grids(gridid)%name)//', has no map')
1595 : else
1596 52563888 : ncol = cam_grids(gridid)%map%blocksize(block_id)
1597 : end if
1598 : else
1599 0 : call endrun('cam_grid_get_block_count: Bad grid ID')
1600 : end if
1601 52563888 : end function cam_grid_get_block_count
1602 :
1603 768 : function cam_grid_get_latvals(id) result(latvals)
1604 :
1605 : ! Dummy argument
1606 : integer, intent(in) :: id
1607 : real(r8), pointer :: latvals(:)
1608 :
1609 : ! Local variables
1610 : integer :: gridid
1611 768 : gridid = get_cam_grid_index(id)
1612 768 : if (gridid > 0) then
1613 768 : if (.not. associated(cam_grids(gridid)%lat_coord%values)) then
1614 0 : nullify(latvals)
1615 : else
1616 768 : latvals => cam_grids(gridid)%lat_coord%values
1617 : end if
1618 : else
1619 0 : call endrun('cam_grid_get_latvals: Bad grid ID')
1620 : end if
1621 768 : end function cam_grid_get_latvals
1622 :
1623 768 : function cam_grid_get_lonvals(id) result(lonvals)
1624 :
1625 : ! Dummy arguments
1626 : integer, intent(in) :: id
1627 : real(r8), pointer :: lonvals(:)
1628 :
1629 : ! Local variables
1630 : integer :: gridid
1631 768 : gridid = get_cam_grid_index(id)
1632 768 : if (gridid > 0) then
1633 768 : if (.not. associated(cam_grids(gridid)%lon_coord%values)) then
1634 0 : nullify(lonvals)
1635 : else
1636 768 : lonvals => cam_grids(gridid)%lon_coord%values
1637 : end if
1638 : else
1639 0 : call endrun('cam_grid_get_lonvals: Bad grid ID')
1640 : end if
1641 768 : end function cam_grid_get_lonvals
1642 :
1643 0 : function cam_grid_get_areawt(id) result(wtvals)
1644 :
1645 : ! Dummy argument
1646 : integer, intent(in) :: id
1647 : real(r8), pointer :: wtvals(:)
1648 :
1649 : ! Local variables
1650 : character(len=max_chars) :: wtname
1651 : integer :: gridind
1652 : class(cam_grid_attribute_t), pointer :: attrptr
1653 : character(len=120) :: errormsg
1654 :
1655 0 : nullify(attrptr)
1656 0 : gridind = get_cam_grid_index(id)
1657 0 : if (gridind > 0) then
1658 0 : select case(trim(cam_grids(gridind)%name))
1659 : case('GLL')
1660 0 : wtname='area_weight_gll'
1661 : case('FV')
1662 0 : wtname='gw'
1663 : case('INI')
1664 0 : wtname='area_weight_ini'
1665 : case('physgrid')
1666 0 : wtname='areawt'
1667 : case('FVM')
1668 0 : wtname='area_weight_fvm'
1669 : case('mpas_cell')
1670 0 : wtname='area_weight_mpas'
1671 : case default
1672 0 : call endrun('cam_grid_get_areawt: Invalid gridname:'//trim(cam_grids(gridind)%name))
1673 : end select
1674 :
1675 0 : call find_cam_grid_attr(gridind, trim(wtname), attrptr)
1676 0 : if (.not.associated(attrptr)) then
1677 : write(errormsg, '(4a)') &
1678 0 : 'cam_grid_get_areawt: error retrieving weight attribute ', trim(wtname), &
1679 0 : ' for cam grid ', cam_grids(gridind)%name
1680 0 : call endrun(errormsg)
1681 : else
1682 0 : call attrptr%print_attr()
1683 : select type(attrptr)
1684 : type is (cam_grid_attribute_1d_r8_t)
1685 0 : wtvals => attrptr%values
1686 : class default
1687 0 : call endrun('cam_grid_get_areawt: wt attribute is not a real datatype')
1688 : end select
1689 : end if
1690 : end if
1691 :
1692 0 : end function cam_grid_get_areawt
1693 :
1694 : ! Find the longitude and latitude of a range of map entries
1695 : ! beg and end are the range of the first source index. blk is a block or chunk index
1696 0 : subroutine cam_grid_get_coords(id, beg, end, blk, lon, lat)
1697 :
1698 : ! Dummy arguments
1699 : integer, intent(in) :: id
1700 : integer, intent(in) :: beg
1701 : integer, intent(in) :: end
1702 : integer, intent(in) :: blk
1703 : real(r8), intent(inout) :: lon(:)
1704 : real(r8), intent(inout) :: lat(:)
1705 :
1706 : ! Local variables
1707 : integer :: gridid
1708 : integer :: i
1709 0 : gridid = get_cam_grid_index(id)
1710 0 : if (gridid > 0) then
1711 0 : do i = beg, end
1712 0 : if (cam_grids(gridid)%is_unstructured()) then
1713 0 : call endrun('cam_grid_get_coords: Not implemented')
1714 : else
1715 0 : call endrun('cam_grid_get_coords: Not implemented')
1716 : end if
1717 : end do
1718 : else
1719 0 : call endrun('cam_grid_get_coords: Bad grid ID')
1720 : end if
1721 0 : end subroutine cam_grid_get_coords
1722 :
1723 0 : logical function cam_grid_is_unstructured(id) result(unstruct)
1724 :
1725 : ! Dummy arguments
1726 : integer, intent(in) :: id
1727 :
1728 : ! Local variables
1729 : integer :: gridid
1730 0 : gridid = get_cam_grid_index(id)
1731 0 : if (gridid > 0) then
1732 0 : unstruct = cam_grids(gridid)%is_unstructured()
1733 : else
1734 0 : call endrun('cam_grid_is_unstructured: Bad grid ID')
1735 : end if
1736 0 : end function cam_grid_is_unstructured
1737 :
1738 5372160 : logical function cam_grid_is_block_indexed(id) result(block_indexed)
1739 :
1740 : ! Dummy arguments
1741 : integer, intent(in) :: id
1742 :
1743 : ! Local variables
1744 : integer :: gridid
1745 5372160 : gridid = get_cam_grid_index(id)
1746 5372160 : if (gridid > 0) then
1747 5372160 : block_indexed = cam_grids(gridid)%is_block_indexed()
1748 : else
1749 0 : call endrun('s: Bad grid ID')
1750 : end if
1751 5372160 : end function cam_grid_is_block_indexed
1752 :
1753 5372160 : logical function cam_grid_is_zonal(id) result(zonal)
1754 :
1755 : ! Dummy arguments
1756 : integer, intent(in) :: id
1757 :
1758 : ! Local variables
1759 : integer :: gridid
1760 5372160 : gridid = get_cam_grid_index(id)
1761 5372160 : if (gridid > 0) then
1762 5372160 : zonal = cam_grids(gridid)%is_zonal_grid()
1763 : else
1764 0 : call endrun('s: Bad grid ID')
1765 : end if
1766 5372160 : end function cam_grid_is_zonal
1767 :
1768 : ! Compute or update a grid patch mask
1769 0 : subroutine cam_grid_compute_patch(id, patch, lonl, lonu, latl, latu, cco)
1770 :
1771 : ! Dummy arguments
1772 : integer, intent(in) :: id
1773 : type(cam_grid_patch_t), intent(inout) :: patch
1774 : real(r8), intent(in) :: lonl
1775 : real(r8), intent(in) :: lonu
1776 : real(r8), intent(in) :: latl
1777 : real(r8), intent(in) :: latu
1778 : logical, intent(in) :: cco ! Collect columns?
1779 :
1780 : ! Local variables
1781 : integer :: gridid
1782 :
1783 0 : gridid = get_cam_grid_index(id)
1784 0 : if (gridid > 0) then
1785 0 : call cam_grids(gridid)%get_patch_mask(lonl, lonu, latl, latu, patch, cco)
1786 : else
1787 0 : call endrun('cam_grid_compute_patch: Bad grid ID')
1788 : end if
1789 :
1790 0 : end subroutine cam_grid_compute_patch
1791 :
1792 : !!#######################################################################
1793 : !!
1794 : !! CAM grid attribute functions
1795 : !!
1796 : !!#######################################################################
1797 :
1798 0 : subroutine cam_grid_attr_init(this, name, long_name, next)
1799 : ! Dummy arguments
1800 : class(cam_grid_attribute_t) :: this
1801 : character(len=*), intent(in) :: name
1802 : character(len=*), intent(in) :: long_name
1803 : class(cam_grid_attribute_t), pointer :: next
1804 :
1805 0 : this%name = trim(name)
1806 0 : this%long_name = trim(long_name)
1807 0 : this%next => next
1808 0 : end subroutine cam_grid_attr_init
1809 :
1810 26112 : subroutine print_attr_base(this)
1811 : ! Dummy arguments
1812 : class(cam_grid_attribute_t), intent(in) :: this
1813 26112 : if (masterproc) then
1814 34 : write(iulog, '(5a)') 'Attribute: ', trim(this%name), ", long name = '", &
1815 68 : trim(this%long_name), "'"
1816 : end if
1817 26112 : end subroutine print_attr_base
1818 :
1819 9216 : subroutine cam_grid_attr_init_0d_int(this, name, long_name, val)
1820 : ! Dummy arguments
1821 : class(cam_grid_attribute_0d_int_t) :: this
1822 : character(len=*), intent(in) :: name
1823 : character(len=*), intent(in) :: long_name
1824 : integer, intent(in) :: val
1825 :
1826 : ! call this%cam_grid_attr_init(name, '')
1827 9216 : this%name = trim(name)
1828 9216 : this%long_name = trim(long_name)
1829 9216 : this%ival = val
1830 9216 : end subroutine cam_grid_attr_init_0d_int
1831 :
1832 12288 : subroutine print_attr_0d_int(this)
1833 : ! Dummy arguments
1834 : class(cam_grid_attribute_0d_int_t), intent(in) :: this
1835 :
1836 12288 : call this%print_attr_base()
1837 12288 : if (masterproc) then
1838 16 : write(iulog, *) ' value = ', this%ival
1839 : end if
1840 12288 : end subroutine print_attr_0d_int
1841 :
1842 0 : subroutine cam_grid_attr_init_0d_char(this, name, long_name, val)
1843 : ! Dummy arguments
1844 : class(cam_grid_attribute_0d_char_t) :: this
1845 : character(len=*), intent(in) :: name
1846 : character(len=*), intent(in) :: long_name
1847 : character(len=*), intent(in) :: val
1848 :
1849 : ! call this%cam_grid_attr_init(name, '')
1850 0 : this%name = trim(name)
1851 0 : this%long_name = trim(long_name)
1852 0 : this%val = trim(val)
1853 0 : end subroutine cam_grid_attr_init_0d_char
1854 :
1855 0 : subroutine print_attr_0d_char(this)
1856 : ! Dummy arguments
1857 : class(cam_grid_attribute_0d_char_t), intent(in) :: this
1858 :
1859 0 : call this%print_attr_base()
1860 0 : if (masterproc) then
1861 0 : write(iulog, *) ' value = ', trim(this%val)
1862 : end if
1863 0 : end subroutine print_attr_0d_char
1864 :
1865 0 : subroutine cam_grid_attr_init_1d_int(this, name, long_name, dimname, &
1866 0 : dimsize, values, map)
1867 : ! Dummy arguments
1868 : class(cam_grid_attribute_1d_int_t) :: this
1869 : character(len=*), intent(in) :: name
1870 : character(len=*), intent(in) :: long_name
1871 : character(len=*), intent(in) :: dimname
1872 : integer, intent(in) :: dimsize
1873 : integer, target, intent(in) :: values(:)
1874 : integer(iMap), optional, target, intent(in) :: map(:)
1875 :
1876 : ! call this%cam_grid_attr_init(trim(name), trim(long_name))
1877 0 : if (len_trim(name) > max_hcoordname_len) then
1878 0 : call endrun('cam_grid_attr_1d_int: name too long')
1879 : end if
1880 0 : this%name = trim(name)
1881 0 : if (len_trim(long_name) > max_chars) then
1882 0 : call endrun('cam_grid_attr_1d_int: long_name too long')
1883 : end if
1884 0 : this%long_name = trim(long_name)
1885 :
1886 0 : if (len_trim(dimname) > max_hcoordname_len) then
1887 0 : call endrun('cam_grid_attr_1d_int: dimname too long')
1888 : end if
1889 0 : this%dimname = trim(dimname)
1890 0 : this%dimsize = dimsize
1891 0 : this%values => values
1892 : ! Fill in the optional map
1893 0 : if (present(map)) then
1894 0 : allocate(this%map(size(map)))
1895 0 : this%map(:) = map(:)
1896 : else
1897 0 : nullify(this%map)
1898 : end if
1899 0 : end subroutine cam_grid_attr_init_1d_int
1900 :
1901 13824 : subroutine cam_grid_attr_init_1d_r8(this, name, long_name, dimname, &
1902 13824 : dimsize, values, map)
1903 : ! Dummy arguments
1904 : class(cam_grid_attribute_1d_r8_t) :: this
1905 : character(len=*), intent(in) :: name
1906 : character(len=*), intent(in) :: long_name
1907 : character(len=*), intent(in) :: dimname
1908 : integer, intent(in) :: dimsize
1909 : real(r8), target, intent(in) :: values(:)
1910 : integer(iMap), optional, target, intent(in) :: map(:)
1911 :
1912 : ! call this%cam_grid_attr_init(trim(name), trim(long_name), next)
1913 13824 : this%name = trim(name)
1914 13824 : this%long_name = trim(long_name)
1915 :
1916 13824 : this%dimname = trim(dimname)
1917 13824 : this%dimsize = dimsize
1918 13824 : this%values => values
1919 : ! Fill in the optional map
1920 13824 : if (present(map)) then
1921 41472 : allocate(this%map(size(map)))
1922 1119168 : this%map(:) = map(:)
1923 : else
1924 0 : nullify(this%map)
1925 : end if
1926 13824 : end subroutine cam_grid_attr_init_1d_r8
1927 :
1928 0 : subroutine print_attr_1d_int(this)
1929 : ! Dummy arguments
1930 : class(cam_grid_attribute_1d_int_t), intent(in) :: this
1931 0 : call this%print_attr_base()
1932 0 : if (masterproc) then
1933 0 : write(iulog, *) ' dimname = ', trim(this%dimname)
1934 : end if
1935 0 : end subroutine print_attr_1d_int
1936 :
1937 13824 : subroutine print_attr_1d_r8(this)
1938 : ! Dummy arguments
1939 : class(cam_grid_attribute_1d_r8_t), intent(in) :: this
1940 13824 : call this%print_attr_base()
1941 13824 : if (masterproc) then
1942 18 : write(iulog, *) ' dimname = ', trim(this%dimname)
1943 : end if
1944 13824 : end subroutine print_attr_1d_r8
1945 :
1946 26112 : subroutine insert_grid_attribute(gridind, attr)
1947 : integer, intent(in) :: gridind
1948 : class(cam_grid_attribute_t), pointer :: attr
1949 :
1950 : ! Push a new attribute onto the grid
1951 : type(cam_grid_attr_ptr_t), pointer :: attrPtr
1952 :
1953 26112 : allocate(attrPtr)
1954 26112 : call attrPtr%initialize(attr)
1955 26112 : call attrPtr%setNext(cam_grids(gridind)%attributes)
1956 26112 : cam_grids(gridind)%attributes => attrPtr
1957 26112 : call attrPtr%attr%print_attr()
1958 26112 : end subroutine insert_grid_attribute
1959 :
1960 9216 : subroutine add_cam_grid_attribute_0d_int(gridname, name, long_name, val)
1961 : ! Dummy arguments
1962 : character(len=*), intent(in) :: gridname
1963 : character(len=*), intent(in) :: name
1964 : character(len=*), intent(in) :: long_name
1965 : integer, intent(in) :: val
1966 :
1967 : ! Local variables
1968 : type(cam_grid_attribute_0d_int_t), pointer :: attr
1969 : class(cam_grid_attribute_t), pointer :: attptr
1970 : character(len=120) :: errormsg
1971 : integer :: gridind
1972 :
1973 9216 : gridind = get_cam_grid_index(trim(gridname))
1974 9216 : if (gridind > 0) then
1975 9216 : call find_cam_grid_attr(gridind, trim(name), attptr)
1976 9216 : if (associated(attptr)) then
1977 : ! Attribute found, can't add it again!
1978 : write(errormsg, '(4a)') &
1979 0 : 'add_cam_grid_attribute_0d_int: attribute ', trim(name), &
1980 0 : ' already exists for ', cam_grids(gridind)%name
1981 0 : call endrun(errormsg)
1982 : else
1983 : ! Need a new attribute.
1984 27648 : allocate(attr)
1985 9216 : call attr%cam_grid_attr_init_0d_int(trim(name), trim(long_name), val)
1986 9216 : attptr => attr
1987 9216 : call insert_grid_attribute(gridind, attptr)
1988 : end if
1989 : else
1990 0 : write(errormsg, '(3a)') 'add_cam_grid_attribute_0d_int: grid ', &
1991 0 : trim(gridname), ' was not found'
1992 0 : call endrun(errormsg)
1993 : end if
1994 : ! call cam_grids(gridind)%print_cam_grid()
1995 9216 : end subroutine add_cam_grid_attribute_0d_int
1996 :
1997 0 : subroutine add_cam_grid_attribute_0d_char(gridname, name, val)
1998 : ! Dummy arguments
1999 : character(len=*), intent(in) :: gridname
2000 : character(len=*), intent(in) :: name
2001 : character(len=*), intent(in) :: val
2002 :
2003 : ! Local variables
2004 : type(cam_grid_attribute_0d_char_t), pointer :: attr
2005 : class(cam_grid_attribute_t), pointer :: attptr
2006 : character(len=120) :: errormsg
2007 : integer :: gridind
2008 :
2009 0 : gridind = get_cam_grid_index(trim(gridname))
2010 0 : if (gridind > 0) then
2011 0 : call find_cam_grid_attr(gridind, trim(name), attptr)
2012 0 : if (associated(attptr)) then
2013 : ! Attribute found, can't add it again!
2014 : write(errormsg, '(4a)') &
2015 0 : 'add_cam_grid_attribute_0d_char: attribute ', trim(name), &
2016 0 : ' already exists for ', cam_grids(gridind)%name
2017 0 : call endrun(errormsg)
2018 : else
2019 : ! Need a new attribute.
2020 0 : allocate(attr)
2021 0 : call attr%cam_grid_attr_init_0d_char(trim(name), '', val)
2022 0 : attptr => attr
2023 0 : call insert_grid_attribute(gridind, attptr)
2024 : end if
2025 : else
2026 0 : write(errormsg, '(3a)') 'add_cam_grid_attribute_0d_char: grid ', &
2027 0 : trim(gridname), ' was not found'
2028 0 : call endrun(errormsg)
2029 : end if
2030 : ! call cam_grids(gridind)%print_cam_grid()
2031 0 : end subroutine add_cam_grid_attribute_0d_char
2032 :
2033 0 : subroutine add_cam_grid_attribute_1d_int(gridname, name, long_name, &
2034 0 : dimname, values, map)
2035 : ! Dummy arguments
2036 : character(len=*), intent(in) :: gridname
2037 : character(len=*), intent(in) :: name
2038 : character(len=*), intent(in) :: long_name
2039 : character(len=*), intent(in) :: dimname
2040 : integer, intent(in), target :: values(:)
2041 : integer(iMap), intent(in), target, optional :: map(:)
2042 :
2043 : ! Local variables
2044 : type(cam_grid_attribute_1d_int_t), pointer :: attr
2045 : class(cam_grid_attribute_t), pointer :: attptr
2046 : character(len=120) :: errormsg
2047 : integer :: gridind
2048 : integer :: dimsize
2049 :
2050 0 : nullify(attr)
2051 0 : nullify(attptr)
2052 0 : gridind = get_cam_grid_index(trim(gridname))
2053 0 : if (gridind > 0) then
2054 0 : call find_cam_grid_attr(gridind, trim(name), attptr)
2055 0 : if (associated(attptr)) then
2056 : ! Attribute found, can't add it again!
2057 : write(errormsg, '(4a)') &
2058 0 : 'add_cam_grid_attribute_1d_int: attribute ', trim(name), &
2059 0 : ' already exists for ', cam_grids(gridind)%name
2060 0 : call endrun(errormsg)
2061 : else
2062 : ! Need a new attribute.
2063 0 : dimsize = cam_grids(gridind)%lat_coord%global_size(trim(dimname))
2064 0 : if (dimsize < 1) then
2065 0 : dimsize = cam_grids(gridind)%lon_coord%global_size(trim(dimname))
2066 : end if
2067 0 : if (dimsize < 1) then
2068 0 : write(errormsg, *) 'add_cam_grid_attribute_1d_int: attribute ', &
2069 0 : 'dimension ', trim(dimname), ' for ', trim(name), ', not found'
2070 0 : call endrun(errormsg)
2071 : end if
2072 0 : allocate(attr)
2073 : call attr%cam_grid_attr_init_1d_int(trim(name), trim(long_name), &
2074 0 : trim(dimname), dimsize, values, map)
2075 0 : attptr => attr
2076 0 : call insert_grid_attribute(gridind, attptr)
2077 : end if
2078 : else
2079 0 : write(errormsg, '(3a)') 'add_cam_grid_attribute_1d_int: grid ', &
2080 0 : trim(gridname), ' was not found'
2081 0 : call endrun(errormsg)
2082 : end if
2083 : ! call cam_grids(gridind)%print_cam_grid()
2084 0 : end subroutine add_cam_grid_attribute_1d_int
2085 :
2086 13824 : subroutine add_cam_grid_attribute_1d_r8(gridname, name, long_name, &
2087 13824 : dimname, values, map)
2088 : ! Dummy arguments
2089 : character(len=*), intent(in) :: gridname
2090 : character(len=*), intent(in) :: name
2091 : character(len=*), intent(in) :: long_name
2092 : character(len=*), intent(in) :: dimname
2093 : real(r8), intent(in), target :: values(:)
2094 : integer(iMap), intent(in), target, optional :: map(:)
2095 :
2096 : ! Local variables
2097 : type(cam_grid_attribute_1d_r8_t), pointer :: attr
2098 : class(cam_grid_attribute_t), pointer :: attptr
2099 : character(len=120) :: errormsg
2100 : integer :: gridind
2101 : integer :: dimsize
2102 :
2103 13824 : gridind = get_cam_grid_index(trim(gridname))
2104 13824 : if (gridind > 0) then
2105 13824 : call find_cam_grid_attr(gridind, trim(name), attptr)
2106 13824 : if (associated(attptr)) then
2107 : ! Attribute found, can't add it again!
2108 : write(errormsg, '(4a)') &
2109 0 : 'add_cam_grid_attribute_1d_r8: attribute ', trim(name), &
2110 0 : ' already exists for ', cam_grids(gridind)%name
2111 0 : call endrun(errormsg)
2112 : else
2113 : ! Need a new attribute.
2114 13824 : dimsize = cam_grids(gridind)%lat_coord%global_size(trim(dimname))
2115 13824 : if (dimsize < 1) then
2116 0 : dimsize = cam_grids(gridind)%lon_coord%global_size(trim(dimname))
2117 : end if
2118 13824 : if (dimsize < 1) then
2119 0 : write(errormsg, *) 'add_cam_grid_attribute_1d_r8: attribute ', &
2120 0 : 'dimension ', trim(dimname), ' for ', trim(name), ', not found'
2121 0 : call endrun(errormsg)
2122 : end if
2123 41472 : allocate(attr)
2124 : call attr%cam_grid_attr_init_1d_r8(trim(name), trim(long_name), &
2125 13824 : trim(dimname), dimsize, values, map)
2126 13824 : attptr => attr
2127 13824 : call insert_grid_attribute(gridind, attptr)
2128 : end if
2129 : else
2130 0 : write(errormsg, '(3a)') 'add_cam_grid_attribute_1d_r8: grid ', &
2131 0 : trim(gridname), ' was not found'
2132 0 : call endrun(errormsg)
2133 : end if
2134 : ! call cam_grids(gridind)%print_cam_grid()
2135 13824 : end subroutine add_cam_grid_attribute_1d_r8
2136 :
2137 : !!#######################################################################
2138 : !!
2139 : !! CAM grid attribute pointer (list node) functions
2140 : !!
2141 : !!#######################################################################
2142 :
2143 26112 : subroutine initializeAttrPtr(this, attr)
2144 : ! Dummy arguments
2145 : class(cam_grid_attr_ptr_t) :: this
2146 : class(cam_grid_attribute_t), target :: attr
2147 :
2148 26112 : if (associated(this%next)) then
2149 0 : if (masterproc) then
2150 0 : write(iulog, *) 'WARNING: Overwriting attr pointer for cam_grid_attr_ptr_t'
2151 : end if
2152 : end if
2153 26112 : this%attr => attr
2154 26112 : end subroutine initializeAttrPtr
2155 :
2156 0 : function getAttrPtrAttr(this)
2157 : ! Dummy variable
2158 : class(cam_grid_attr_ptr_t) :: this
2159 : class(cam_grid_attribute_t), pointer :: getAttrPtrAttr
2160 :
2161 0 : getAttrPtrAttr => this%attr
2162 0 : end function getAttrPtrAttr
2163 :
2164 0 : function getAttrPtrNext(this)
2165 : ! Dummy arguments
2166 : class(cam_grid_attr_ptr_t) :: this
2167 : type(cam_grid_attr_ptr_t), pointer :: getAttrPtrNext
2168 :
2169 0 : getAttrPtrNext => this%next
2170 0 : end function getAttrPtrNext
2171 :
2172 26112 : subroutine setAttrPtrNext(this, next)
2173 : ! Dummy arguments
2174 : class(cam_grid_attr_ptr_t) :: this
2175 : type(cam_grid_attr_ptr_t), pointer :: next
2176 :
2177 26112 : if (associated(this%next)) then
2178 0 : if (masterproc) then
2179 0 : write(iulog, *) 'WARNING: Overwriting next pointer for cam_grid_attr_ptr_t'
2180 : end if
2181 : end if
2182 26112 : this%next => next
2183 26112 : end subroutine setAttrPtrNext
2184 :
2185 : !---------------------------------------------------------------------------
2186 : !
2187 : ! write_cam_grid_attr_0d_int
2188 : !
2189 : ! Write a grid attribute
2190 : !
2191 : !---------------------------------------------------------------------------
2192 :
2193 24576 : subroutine write_cam_grid_attr_0d_int(attr, File, file_index)
2194 : use pio, only: file_desc_t, pio_put_att, pio_noerr, pio_int, &
2195 : pio_inq_att, PIO_GLOBAL
2196 : use cam_pio_utils, only: cam_pio_def_var
2197 :
2198 : ! Dummy arguments
2199 : class(cam_grid_attribute_0d_int_t), intent(inout) :: attr
2200 : type(file_desc_t), intent(inout) :: File ! PIO file Handle
2201 : integer, optional, intent(in) :: file_index
2202 :
2203 : ! Local variables
2204 : integer :: attrtype
2205 : integer(imap) :: attrlen
2206 : integer :: ierr
2207 : integer :: file_index_loc
2208 :
2209 24576 : if (present(file_index)) then
2210 24576 : file_index_loc = file_index
2211 : else
2212 : file_index_loc = 1
2213 : end if
2214 :
2215 : ! Since more than one grid can share an attribute, assume that if the
2216 : ! vardesc is associated, that grid defined the attribute
2217 24576 : if (.not. associated(attr%vardesc(file_index_loc)%p)) then
2218 24576 : if (len_trim(attr%long_name) > 0) then
2219 : ! This 0d attribute is a scalar variable with a long_name attribute
2220 : ! First, define the variable
2221 0 : allocate(attr%vardesc(file_index_loc)%p)
2222 : call cam_pio_def_var(File, trim(attr%name), pio_int, attr%vardesc(file_index_loc)%p, &
2223 0 : existOK=.false.)
2224 0 : ierr=pio_put_att(File, attr%vardesc(file_index_loc)%p, 'long_name', trim(attr%long_name))
2225 0 : call cam_pio_handle_error(ierr, 'Error writing "long_name" attr in write_cam_grid_attr_0d_int')
2226 : else
2227 : ! This 0d attribute is a global attribute
2228 : ! Check to see if the attribute already exists in the file
2229 24576 : ierr = pio_inq_att(File, PIO_GLOBAL, attr%name, attrtype, attrlen)
2230 24576 : if (ierr /= PIO_NOERR) then
2231 : ! Time to define the attribute
2232 21504 : ierr = pio_put_att(File, PIO_GLOBAL, trim(attr%name), attr%ival)
2233 21504 : call cam_pio_handle_error(ierr, 'Unable to define attribute in write_cam_grid_attr_0d_int')
2234 : end if
2235 : end if
2236 : end if
2237 :
2238 24576 : end subroutine write_cam_grid_attr_0d_int
2239 :
2240 : !---------------------------------------------------------------------------
2241 : !
2242 : ! write_cam_grid_attr_0d_char
2243 : !
2244 : ! Write a grid attribute
2245 : !
2246 : !---------------------------------------------------------------------------
2247 :
2248 0 : subroutine write_cam_grid_attr_0d_char(attr, File, file_index)
2249 24576 : use pio, only: file_desc_t, pio_put_att, pio_noerr, &
2250 : pio_inq_att, PIO_GLOBAL
2251 :
2252 : ! Dummy arguments
2253 : class(cam_grid_attribute_0d_char_t), intent(inout) :: attr
2254 : type(file_desc_t), intent(inout) :: File ! PIO file Handle
2255 : integer, optional, intent(in) :: file_index
2256 :
2257 : ! Local variables
2258 : integer :: attrtype
2259 : integer(imap) :: attrlen
2260 : integer :: ierr
2261 : integer :: file_index_loc
2262 :
2263 0 : if (present(file_index)) then
2264 0 : file_index_loc = file_index
2265 : else
2266 : file_index_loc = 1
2267 : end if
2268 :
2269 : ! Since more than one grid can share an attribute, assume that if the
2270 : ! vardesc is associated, that grid defined the attribute
2271 0 : if (.not. associated(attr%vardesc(file_index_loc)%p)) then
2272 : ! The 0d char attributes are global attribues
2273 : ! Check to see if the attribute already exists in the file
2274 0 : ierr = pio_inq_att(File, PIO_GLOBAL, attr%name, attrtype, attrlen)
2275 0 : if (ierr /= PIO_NOERR) then
2276 : ! Time to define the variable
2277 0 : ierr = pio_put_att(File, PIO_GLOBAL, trim(attr%name), attr%val)
2278 0 : call cam_pio_handle_error(ierr, 'Unable to define attribute in write_cam_grid_attr_0d_char')
2279 : end if
2280 : end if
2281 :
2282 0 : end subroutine write_cam_grid_attr_0d_char
2283 :
2284 : !---------------------------------------------------------------------------
2285 : !
2286 : ! write_cam_grid_attr_1d_int
2287 : !
2288 : ! Write a grid attribute
2289 : !
2290 : !---------------------------------------------------------------------------
2291 :
2292 0 : subroutine write_cam_grid_attr_1d_int(attr, File, file_index)
2293 : use pio, only: file_desc_t, pio_put_att, pio_noerr
2294 : use pio, only: pio_inq_dimid, pio_int
2295 : use cam_pio_utils, only: cam_pio_def_var, cam_pio_closefile
2296 :
2297 : ! Dummy arguments
2298 : class(cam_grid_attribute_1d_int_t), intent(inout) :: attr
2299 : type(file_desc_t), intent(inout) :: File ! PIO file Handle
2300 : integer, optional, intent(in) :: file_index
2301 :
2302 : ! Local variables
2303 : integer :: dimid ! PIO dimension ID
2304 : character(len=120) :: errormsg
2305 : integer :: ierr
2306 : integer :: file_index_loc
2307 :
2308 0 : if (present(file_index)) then
2309 0 : file_index_loc = file_index
2310 : else
2311 : file_index_loc = 1
2312 : end if
2313 :
2314 : ! Since more than one grid can share an attribute, assume that if the
2315 : ! vardesc is associated, that grid defined the attribute
2316 0 : if (.not. associated(attr%vardesc(file_index_loc)%p)) then
2317 : ! Check to see if the dimension already exists in the file
2318 0 : ierr = pio_inq_dimid(File, trim(attr%dimname), dimid)
2319 0 : if (ierr /= PIO_NOERR) then
2320 : ! The dimension has not yet been defined. This is an error
2321 : ! NB: It should have been defined as part of a coordinate
2322 0 : write(errormsg, *) 'write_cam_grid_attr_1d_int: dimension, ', &
2323 0 : trim(attr%dimname), ', does not exist'
2324 0 : call cam_pio_closefile(File)
2325 0 : call endrun(errormsg)
2326 : end if
2327 : ! Time to define the variable
2328 0 : allocate(attr%vardesc(file_index_loc)%p)
2329 : call cam_pio_def_var(File, trim(attr%name), pio_int, (/dimid/), &
2330 0 : attr%vardesc(file_index_loc)%p, existOK=.false.)
2331 0 : ierr = pio_put_att(File, attr%vardesc(file_index_loc)%p, 'long_name', trim(attr%long_name))
2332 0 : call cam_pio_handle_error(ierr, 'Error writing "long_name" attr in write_cam_grid_attr_1d_int')
2333 : end if
2334 :
2335 0 : end subroutine write_cam_grid_attr_1d_int
2336 :
2337 : !---------------------------------------------------------------------------
2338 : !
2339 : ! write_cam_grid_attr_1d_r8
2340 : !
2341 : ! Write a grid attribute
2342 : !
2343 : !---------------------------------------------------------------------------
2344 :
2345 24576 : subroutine write_cam_grid_attr_1d_r8(attr, File, file_index)
2346 0 : use pio, only: file_desc_t, pio_put_att, pio_noerr, pio_double, &
2347 : pio_inq_dimid
2348 : use cam_pio_utils, only: cam_pio_def_var, cam_pio_closefile
2349 :
2350 : ! Dummy arguments
2351 : class(cam_grid_attribute_1d_r8_t), intent(inout) :: attr
2352 : type(file_desc_t), intent(inout) :: File ! PIO file Handle
2353 : integer, optional, intent(in) :: file_index
2354 :
2355 : ! Local variables
2356 : integer :: dimid ! PIO dimension ID
2357 : character(len=120) :: errormsg
2358 : integer :: ierr
2359 : integer :: file_index_loc
2360 :
2361 24576 : if (present(file_index)) then
2362 24576 : file_index_loc = file_index
2363 : else
2364 : file_index_loc = 1
2365 : end if
2366 :
2367 : ! Since more than one grid can share an attribute, assume that if the
2368 : ! vardesc is associated, that grid defined the attribute
2369 24576 : if (.not. associated(attr%vardesc(file_index_loc)%p)) then
2370 : ! Check to see if the dimension already exists in the file
2371 24576 : ierr = pio_inq_dimid(File, trim(attr%dimname), dimid)
2372 24576 : if (ierr /= PIO_NOERR) then
2373 : ! The dimension has not yet been defined. This is an error
2374 : ! NB: It should have been defined as part of a coordinate
2375 0 : write(errormsg, *) 'write_cam_grid_attr_1d_r8: dimension, ', &
2376 0 : trim(attr%dimname), ', does not exist'
2377 0 : call cam_pio_closefile(File)
2378 0 : call endrun(errormsg)
2379 : end if
2380 : ! Time to define the variable
2381 24576 : allocate(attr%vardesc(file_index_loc)%p)
2382 : call cam_pio_def_var(File, trim(attr%name), pio_double, (/dimid/), &
2383 49152 : attr%vardesc(file_index_loc)%p, existOK=.false.)
2384 : ! long_name
2385 24576 : ierr = pio_put_att(File, attr%vardesc(file_index_loc)%p, 'long_name', trim(attr%long_name))
2386 24576 : call cam_pio_handle_error(ierr, 'Error writing "long_name" attr in write_cam_grid_attr_1d_r8')
2387 : end if
2388 :
2389 24576 : end subroutine write_cam_grid_attr_1d_r8
2390 :
2391 : !---------------------------------------------------------------------------
2392 : !
2393 : ! cam_grid_attribute_copy
2394 : !
2395 : ! Copy an attribute from a source grid to a destination grid
2396 : !
2397 : !---------------------------------------------------------------------------
2398 3072 : subroutine cam_grid_attribute_copy(src_grid, dest_grid, attribute_name)
2399 : ! Dummy arguments
2400 : character(len=*), intent(in) :: src_grid
2401 : character(len=*), intent(in) :: dest_grid
2402 : character(len=*), intent(in) :: attribute_name
2403 :
2404 : ! Local variables
2405 : character(len=120) :: errormsg
2406 : integer :: src_ind, dest_ind
2407 : class(cam_grid_attribute_t), pointer :: attr
2408 :
2409 : ! Find the source and destination grid indices
2410 3072 : src_ind = get_cam_grid_index(trim(src_grid))
2411 3072 : dest_ind = get_cam_grid_index(trim(dest_grid))
2412 :
2413 3072 : call find_cam_grid_attr(dest_ind, trim(attribute_name), attr)
2414 3072 : if (associated(attr)) then
2415 : ! Attribute found, can't add it again!
2416 0 : write(errormsg, '(4a)') 'CAM_GRID_ATTRIBUTE_COPY: attribute ', &
2417 0 : trim(attribute_name),' already exists for ',cam_grids(dest_ind)%name
2418 0 : call endrun(errormsg)
2419 : else
2420 3072 : call find_cam_grid_attr(src_ind, trim(attribute_name), attr)
2421 3072 : if (associated(attr)) then
2422 : ! Copy the attribute
2423 3072 : call insert_grid_attribute(dest_ind, attr)
2424 : else
2425 0 : write(errormsg, '(4a)') ": Did not find attribute, '", &
2426 0 : trim(attribute_name), "' in ", cam_grids(src_ind)%name
2427 0 : call endrun("CAM_GRID_ATTRIBUTE_COPY"//errormsg)
2428 : end if
2429 : end if
2430 :
2431 24576 : end subroutine cam_grid_attribute_copy
2432 :
2433 : !---------------------------------------------------------------------------
2434 : !
2435 : ! cam_grid_write_attr
2436 : !
2437 : ! Write the dimension and coordinate attributes for the horizontal history
2438 : ! coordinates.
2439 : !
2440 : !---------------------------------------------------------------------------
2441 12288 : subroutine cam_grid_write_attr(File, grid_id, header_info, file_index)
2442 : use pio, only: file_desc_t, PIO_BCAST_ERROR, pio_seterrorhandling
2443 :
2444 : ! Dummy arguments
2445 : type(file_desc_t), intent(inout) :: File ! PIO file Handle
2446 : integer, intent(in) :: grid_id
2447 : type(cam_grid_header_info_t), intent(inout) :: header_info
2448 : integer, optional, intent(in) :: file_index
2449 :
2450 : ! Local variables
2451 : integer :: gridind
2452 : class(cam_grid_attribute_t), pointer :: attr
2453 : type(cam_grid_attr_ptr_t), pointer :: attrPtr
2454 : integer :: dimids(2)
2455 : integer :: err_handling
2456 : integer :: file_index_loc
2457 :
2458 12288 : if (present(file_index)) then
2459 9216 : file_index_loc = file_index
2460 : else
2461 3072 : file_index_loc = 1
2462 : end if
2463 :
2464 12288 : gridind = get_cam_grid_index(grid_id)
2465 : !! Fill this in to make sure history finds grid
2466 12288 : header_info%grid_id = grid_id
2467 :
2468 12288 : if (allocated(header_info%hdims)) then
2469 4608 : deallocate(header_info%hdims)
2470 : end if
2471 :
2472 12288 : if (associated(header_info%lon_varid)) then
2473 : ! This could be a sign of bad memory management
2474 0 : call endrun('CAM_GRID_WRITE_ATTR: lon_varid should be NULL')
2475 : end if
2476 12288 : if (associated(header_info%lat_varid)) then
2477 : ! This could be a sign of bad memory management
2478 0 : call endrun('CAM_GRID_WRITE_ATTR: lat_varid should be NULL')
2479 : end if
2480 :
2481 : ! Only write this grid if not already defined
2482 12288 : if (cam_grids(gridind)%attrs_defined(file_index_loc)) then
2483 : ! We need to fill out the hdims info for this grid
2484 0 : call cam_grids(gridind)%find_dimids(File, dimids)
2485 0 : if (dimids(2) < 0) then
2486 0 : allocate(header_info%hdims(1))
2487 0 : header_info%hdims(1) = dimids(1)
2488 : else
2489 0 : allocate(header_info%hdims(2))
2490 0 : header_info%hdims(1:2) = dimids(1:2)
2491 : end if
2492 : else
2493 : ! Write the horizontal coord attributes first so that we have the dims
2494 12288 : call cam_grids(gridind)%lat_coord%write_attr(File, dimids(2), file_index=file_index_loc)
2495 12288 : call cam_grids(gridind)%lon_coord%write_attr(File, dimids(1), file_index=file_index_loc)
2496 :
2497 12288 : if (dimids(2) == dimids(1)) then
2498 12288 : allocate(header_info%hdims(1))
2499 : else
2500 0 : allocate(header_info%hdims(2))
2501 0 : header_info%hdims(2) = dimids(2)
2502 : end if
2503 12288 : header_info%hdims(1) = dimids(1)
2504 :
2505 : ! We will handle errors for this routine
2506 12288 : call pio_seterrorhandling(File, PIO_BCAST_ERROR,err_handling)
2507 :
2508 12288 : attrPtr => cam_grids(gridind)%attributes
2509 61440 : do while (associated(attrPtr))
2510 : !!XXgoldyXX: Is this not working in PGI?
2511 : ! attr => attrPtr%getAttr()
2512 49152 : attr => attrPtr%attr
2513 49152 : call attr%write_attr(File, file_index=file_index_loc)
2514 : !!XXgoldyXX: Is this not working in PGI?
2515 : ! attrPtr => attrPtr%getNext()
2516 49152 : attrPtr => attrPtr%next
2517 : end do
2518 :
2519 : ! Back to previous I/O error handling
2520 12288 : call pio_seterrorhandling(File, err_handling)
2521 12288 : cam_grids(gridind)%attrs_defined(file_index_loc) = .true.
2522 : end if
2523 :
2524 12288 : end subroutine cam_grid_write_attr
2525 :
2526 24576 : subroutine write_cam_grid_val_0d_int(attr, File, file_index)
2527 : use pio, only: file_desc_t, pio_put_var
2528 :
2529 : ! Dummy arguments
2530 : class(cam_grid_attribute_0d_int_t), intent(inout) :: attr
2531 : type(file_desc_t), intent(inout) :: File
2532 : integer, optional, intent(in) :: file_index
2533 :
2534 : ! Local variables
2535 : integer :: ierr
2536 : integer :: file_index_loc
2537 :
2538 24576 : if (present(file_index)) then
2539 24576 : file_index_loc = file_index
2540 : else
2541 : file_index_loc = 1
2542 : end if
2543 :
2544 : ! We only write this var if it is a variable
2545 24576 : if (associated(attr%vardesc(file_index_loc)%p)) then
2546 0 : ierr = pio_put_var(File, attr%vardesc(file_index_loc)%p, attr%ival)
2547 0 : call cam_pio_handle_error(ierr, 'Error writing value in write_cam_grid_val_0d_int')
2548 0 : deallocate(attr%vardesc(file_index_loc)%p)
2549 0 : nullify(attr%vardesc(file_index_loc)%p)
2550 : end if
2551 :
2552 24576 : end subroutine write_cam_grid_val_0d_int
2553 :
2554 0 : subroutine write_cam_grid_val_0d_char(attr, File, file_index)
2555 : use pio, only: file_desc_t
2556 :
2557 : ! Dummy arguments
2558 : class(cam_grid_attribute_0d_char_t), intent(inout) :: attr
2559 : type(file_desc_t), intent(inout) :: File
2560 : integer, optional, intent(in) :: file_index
2561 :
2562 : ! This subroutine is a stub because global attributes are written
2563 : ! in define mode
2564 0 : return
2565 : end subroutine write_cam_grid_val_0d_char
2566 :
2567 0 : subroutine write_cam_grid_val_1d_int(attr, File, file_index)
2568 : use pio, only: file_desc_t, pio_put_var, pio_int, &
2569 : pio_write_darray, io_desc_t, pio_freedecomp
2570 : use cam_pio_utils, only: cam_pio_newdecomp
2571 :
2572 : ! Dummy arguments
2573 : class(cam_grid_attribute_1d_int_t), intent(inout) :: attr
2574 : type(file_desc_t), intent(inout) :: File
2575 : integer, optional, intent(in) :: file_index
2576 :
2577 : ! Local variables
2578 : integer :: ierr
2579 : type(io_desc_t), pointer :: iodesc
2580 : integer :: file_index_loc
2581 :
2582 0 : if (present(file_index)) then
2583 0 : file_index_loc = file_index
2584 : else
2585 : file_index_loc = 1
2586 : end if
2587 :
2588 0 : nullify(iodesc)
2589 : ! Since more than one grid can share an attribute, assume that if the
2590 : ! vardesc is not associated, another grid write the values
2591 0 : if (associated(attr%vardesc(file_index_loc)%p)) then
2592 : ! Write out the values for this dimension variable
2593 0 : if (associated(attr%map)) then
2594 : ! This is a distributed variable, use pio_write_darray
2595 0 : allocate(iodesc)
2596 0 : call cam_pio_newdecomp(iodesc, (/attr%dimsize/), attr%map, pio_int)
2597 0 : call pio_write_darray(File, attr%vardesc(file_index_loc)%p, iodesc, attr%values, ierr)
2598 0 : call pio_freedecomp(File, iodesc)
2599 0 : deallocate(iodesc)
2600 : nullify(iodesc)
2601 : else
2602 : ! This is a local variable, pio_put_var should work fine
2603 0 : ierr = pio_put_var(File, attr%vardesc(file_index_loc)%p, attr%values)
2604 : end if
2605 0 : call cam_pio_handle_error(ierr, 'Error writing variable values in write_cam_grid_val_1d_int')
2606 0 : deallocate(attr%vardesc(file_index_loc)%p)
2607 0 : nullify(attr%vardesc(file_index_loc)%p)
2608 : end if
2609 :
2610 0 : end subroutine write_cam_grid_val_1d_int
2611 :
2612 24576 : subroutine write_cam_grid_val_1d_r8(attr, File, file_index)
2613 0 : use pio, only: file_desc_t, pio_put_var, pio_double, &
2614 : pio_write_darray, io_desc_t, pio_freedecomp
2615 : use cam_pio_utils, only: cam_pio_newdecomp
2616 :
2617 : ! Dummy arguments
2618 : class(cam_grid_attribute_1d_r8_t), intent(inout) :: attr
2619 : type(file_desc_t), intent(inout) :: File
2620 : integer, optional, intent(in) :: file_index
2621 :
2622 : ! Local variables
2623 : integer :: ierr
2624 : type(io_desc_t), pointer :: iodesc
2625 : integer :: file_index_loc
2626 :
2627 24576 : if (present(file_index)) then
2628 24576 : file_index_loc = file_index
2629 : else
2630 : file_index_loc = 1
2631 : end if
2632 :
2633 24576 : nullify(iodesc)
2634 : ! Since more than one grid can share an attribute, assume that if the
2635 : ! vardesc is not associated, another grid write the values
2636 24576 : if (associated(attr%vardesc(file_index_loc)%p)) then
2637 : ! Write out the values for this dimension variable
2638 24576 : if (associated(attr%map)) then
2639 : ! This is a distributed variable, use pio_write_darray
2640 24576 : allocate(iodesc)
2641 49152 : call cam_pio_newdecomp(iodesc, (/attr%dimsize/), attr%map, pio_double)
2642 24576 : call pio_write_darray(File, attr%vardesc(file_index_loc)%p, iodesc, attr%values, ierr)
2643 24576 : call pio_freedecomp(File, iodesc)
2644 24576 : deallocate(iodesc)
2645 : nullify(iodesc)
2646 : else
2647 : ! This is a local variable, pio_put_var should work fine
2648 0 : ierr = pio_put_var(File, attr%vardesc(file_index_loc)%p, attr%values)
2649 : end if
2650 24576 : call cam_pio_handle_error(ierr, 'Error writing variable values in write_cam_grid_val_1d_r8')
2651 24576 : deallocate(attr%vardesc(file_index_loc)%p)
2652 24576 : nullify(attr%vardesc(file_index_loc)%p)
2653 : end if
2654 :
2655 24576 : end subroutine write_cam_grid_val_1d_r8
2656 :
2657 12288 : subroutine cam_grid_write_var(File, grid_id, file_index)
2658 24576 : use pio, only: file_desc_t, pio_bcast_error, pio_seterrorhandling
2659 :
2660 : ! Dummy arguments
2661 : type(file_desc_t), intent(inout) :: File ! PIO file Handle
2662 : integer, intent(in) :: grid_id
2663 : integer, optional, intent(in) :: file_index
2664 :
2665 : ! Local variables
2666 : integer :: gridind
2667 : integer :: err_handling
2668 : class(cam_grid_attribute_t), pointer :: attr
2669 : type(cam_grid_attr_ptr_t), pointer :: attrPtr
2670 : integer :: file_index_loc
2671 :
2672 12288 : if (present(file_index)) then
2673 9216 : file_index_loc = file_index
2674 : else
2675 3072 : file_index_loc = 1
2676 : end if
2677 12288 : gridind = get_cam_grid_index(grid_id)
2678 : ! Only write if not already done
2679 12288 : if (cam_grids(gridind)%attrs_defined(file_index_loc)) then
2680 : ! Write the horizontal coorinate values
2681 12288 : call cam_grids(gridind)%lon_coord%write_var(File, file_index)
2682 12288 : call cam_grids(gridind)%lat_coord%write_var(File, file_index)
2683 :
2684 : ! We will handle errors for this routine
2685 12288 : call pio_seterrorhandling(File, PIO_BCAST_ERROR,err_handling)
2686 :
2687 : ! Write out the variable values for each grid attribute
2688 12288 : attrPtr => cam_grids(gridind)%attributes
2689 61440 : do while (associated(attrPtr))
2690 : !!XXgoldyXX: Is this not working in PGI?
2691 : ! attr => attrPtr%getAttr()
2692 49152 : attr => attrPtr%attr
2693 49152 : call attr%write_val(File, file_index=file_index_loc)
2694 : !!XXgoldyXX: Is this not working in PGI?
2695 : ! attrPtr => attrPtr%getNext()
2696 49152 : attrPtr => attrPtr%next
2697 : end do
2698 :
2699 : ! Back to previous I/O error handling
2700 12288 : call pio_seterrorhandling(File, err_handling)
2701 :
2702 12288 : cam_grids(gridind)%attrs_defined(file_index_loc) = .false.
2703 : end if
2704 :
2705 12288 : end subroutine cam_grid_write_var
2706 :
2707 5372160 : logical function cam_grid_block_indexed(this)
2708 : class(cam_grid_t) :: this
2709 :
2710 5372160 : cam_grid_block_indexed = this%block_indexed
2711 5372160 : end function cam_grid_block_indexed
2712 :
2713 5372160 : logical function cam_grid_zonal_grid(this)
2714 : class(cam_grid_t) :: this
2715 :
2716 5372160 : cam_grid_zonal_grid = this%zonal_grid
2717 5372160 : end function cam_grid_zonal_grid
2718 :
2719 923904 : logical function cam_grid_unstructured(this)
2720 : class(cam_grid_t) :: this
2721 :
2722 923904 : cam_grid_unstructured = this%unstructured
2723 923904 : end function cam_grid_unstructured
2724 :
2725 : !---------------------------------------------------------------------------
2726 : !
2727 : ! cam_grid_get_dims: Return the dimensions of the grid
2728 : ! For lon/lat grids, this is (nlon, nlat)
2729 : ! For unstructured grids, this is (ncols, 1)
2730 : !
2731 : !---------------------------------------------------------------------------
2732 923904 : subroutine cam_grid_get_dims(this, dims)
2733 : ! Dummy arguments
2734 : class(cam_grid_t) :: this
2735 : integer, intent(inout) :: dims(2)
2736 :
2737 923904 : if (this%is_unstructured()) then
2738 923904 : call this%lon_coord%get_coord_len(dims(1))
2739 923904 : dims(2) = 1
2740 : else
2741 0 : call this%lon_coord%get_coord_len(dims(1))
2742 0 : call this%lat_coord%get_coord_len(dims(2))
2743 : end if
2744 :
2745 923904 : end subroutine cam_grid_get_dims
2746 :
2747 : !---------------------------------------------------------------------------
2748 : !
2749 : ! cam_grid_coord_names: Return the names of the grid axes
2750 : !
2751 : !---------------------------------------------------------------------------
2752 0 : subroutine cam_grid_coord_names(this, lon_name, lat_name)
2753 : ! Dummy arguments
2754 : class(cam_grid_t) :: this
2755 : character(len=*), intent(out) :: lon_name
2756 : character(len=*), intent(out) :: lat_name
2757 :
2758 0 : call this%lon_coord%get_coord_name(lon_name)
2759 0 : call this%lat_coord%get_coord_name(lat_name)
2760 :
2761 0 : end subroutine cam_grid_coord_names
2762 :
2763 : !---------------------------------------------------------------------------
2764 : !
2765 : ! cam_grid_dim_names: Return the names of the dimensions of the grid axes.
2766 : ! Note that these may be the same
2767 : !
2768 : !---------------------------------------------------------------------------
2769 1069056 : subroutine cam_grid_dim_names(this, name1, name2)
2770 : ! Dummy arguments
2771 : class(cam_grid_t) :: this
2772 : character(len=*), intent(out) :: name1
2773 : character(len=*), intent(out) :: name2
2774 :
2775 1069056 : call this%lon_coord%get_dim_name(name1)
2776 1069056 : call this%lat_coord%get_dim_name(name2)
2777 :
2778 1069056 : end subroutine cam_grid_dim_names
2779 :
2780 : !---------------------------------------------------------------------------
2781 : !
2782 : ! cam_grid_dimensions_id: Return the dimensions of the grid
2783 : ! For lon/lat grids, this is (nlon, nlat)
2784 : ! For unstructured grids, this is (ncols, 1)
2785 : !
2786 : !---------------------------------------------------------------------------
2787 919296 : subroutine cam_grid_dimensions_id(gridid, dims, rank)
2788 : ! Dummy arguments
2789 : integer, intent(in) :: gridid
2790 : integer, intent(inout) :: dims(2)
2791 : integer, optional, intent(out) :: rank
2792 :
2793 : ! Local variables
2794 : integer :: index
2795 : character(len=max_hcoordname_len) :: dname1, dname2
2796 : character(len=120) :: errormsg
2797 :
2798 919296 : index = get_cam_grid_index(gridid)
2799 919296 : if (index < 0) then
2800 0 : write(errormsg, *) 'No CAM grid with ID =', gridid
2801 0 : call endrun(errormsg)
2802 : else
2803 919296 : call cam_grids(index)%coord_lengths(dims)
2804 : end if
2805 919296 : if (present(rank)) then
2806 641280 : call cam_grids(index)%dim_names(dname1, dname2)
2807 641280 : if (trim(dname1) == trim(dname2)) then
2808 641280 : rank = 1
2809 : else
2810 0 : rank = 2
2811 : end if
2812 : end if
2813 :
2814 919296 : end subroutine cam_grid_dimensions_id
2815 :
2816 : !---------------------------------------------------------------------------
2817 : !
2818 : ! cam_grid_dimensions_name: Return the dimensions of the grid
2819 : ! For lon/lat grids, this is (nlon, nlat)
2820 : ! For unstructured grids, this is (ncols, 1)
2821 : !
2822 : !---------------------------------------------------------------------------
2823 2304 : subroutine cam_grid_dimensions_name(gridname, dims, rank)
2824 : ! Dummy arguments
2825 : character(len=*), intent(in) :: gridname
2826 : integer, intent(inout) :: dims(2)
2827 : integer, optional, intent(out) :: rank
2828 :
2829 : ! Local variables
2830 : integer :: gridind
2831 : character(len=max_hcoordname_len) :: dname1, dname2
2832 : character(len=120) :: errormsg
2833 :
2834 2304 : gridind = get_cam_grid_index(trim(gridname))
2835 2304 : if (gridind < 0) then
2836 0 : write(errormsg, *) 'No CAM grid with name = ', trim(gridname)
2837 0 : call endrun(errormsg)
2838 : else
2839 2304 : call cam_grids(gridind)%coord_lengths(dims)
2840 : end if
2841 2304 : if (present(rank)) then
2842 0 : call cam_grids(gridind)%dim_names(dname1, dname2)
2843 0 : if (trim(dname1) == trim(dname2)) then
2844 0 : rank = 1
2845 : else
2846 0 : rank = 2
2847 : end if
2848 : end if
2849 :
2850 2304 : end subroutine cam_grid_dimensions_name
2851 :
2852 : !---------------------------------------------------------------------------
2853 : !
2854 : ! cam_grid_set_map: Set a grid's distribution map
2855 : ! This maps the local grid elements to global file order
2856 : !
2857 : !---------------------------------------------------------------------------
2858 0 : subroutine cam_grid_set_map(this, map, src, dest)
2859 : use spmd_utils, only: mpi_sum, mpi_integer, mpicom
2860 : ! Dummy arguments
2861 : class(cam_grid_t) :: this
2862 : integer(iMap), pointer :: map(:,:)
2863 : integer, intent(in) :: src(2) ! decomp info
2864 : integer, intent(in) :: dest(2) ! Standard dim(s) in file
2865 :
2866 : ! Local variables
2867 : integer :: dims(2)
2868 : integer :: dstrt, dend
2869 : integer :: gridlen, gridloc, ierr
2870 :
2871 : ! Check to make sure the map meets our needs
2872 0 : call this%coord_lengths(dims)
2873 0 : dend = size(map, 1)
2874 : ! We always have to have one source and one destination
2875 0 : if (dest(2) > 0) then
2876 0 : dstrt = dend - 1
2877 : else
2878 : dstrt = dend
2879 : end if
2880 0 : if ((src(2) /= 0) .and. (dstrt < 3)) then
2881 0 : call endrun('cam_grid_set_map: src & dest too large for map')
2882 0 : else if (dstrt < 2) then
2883 0 : call endrun('cam_grid_set_map: dest too large for map')
2884 : ! No else needed
2885 : end if
2886 0 : if (dstrt == dend) then
2887 0 : gridloc = count(map(dend,:) /= 0)
2888 : else
2889 0 : gridloc = count((map(dstrt,:) /= 0) .and. (map(dend,:) /= 0))
2890 : end if
2891 0 : call MPI_Allreduce(gridloc, gridlen, 1, MPI_INTEGER, MPI_SUM, mpicom, ierr)
2892 0 : if (gridlen /= product(dims)) then
2893 0 : call endrun('cam_grid_set_map: Bad map size for '//trim(this%name))
2894 : else
2895 0 : if (.not. associated(this%map)) then
2896 0 : allocate(this%map)
2897 : end if
2898 0 : call this%map%init(map, this%unstructured, src, dest)
2899 : end if
2900 0 : end subroutine cam_grid_set_map
2901 :
2902 : !---------------------------------------------------------------------------
2903 : !
2904 : ! cam_grid_local_size: return the local size of a 2D array on this grid
2905 : !
2906 : !---------------------------------------------------------------------------
2907 0 : integer function cam_grid_local_size(this)
2908 :
2909 : ! Dummy argument
2910 : class(cam_grid_t) :: this
2911 :
2912 : ! Local variable
2913 : character(len=128) :: errormsg
2914 :
2915 0 : if (.not. associated(this%map)) then
2916 0 : write(errormsg, *) 'Grid, '//trim(this%name)//', has no map'
2917 0 : call endrun('cam_grid_local_size: '//trim(errormsg))
2918 : else
2919 0 : cam_grid_local_size = this%map%num_elem()
2920 : end if
2921 :
2922 0 : end function cam_grid_local_size
2923 :
2924 : !---------------------------------------------------------------------------
2925 : !
2926 : ! cam_grid_get_lon_lat: Find the latitude and longitude for a given
2927 : ! grid map index. Note if point is not mapped
2928 : !
2929 : !---------------------------------------------------------------------------
2930 0 : subroutine cam_grid_get_lon_lat(this, index, lon, lat, isMapped)
2931 :
2932 : ! Dummy arguments
2933 : class(cam_grid_t) :: this
2934 : integer, intent(in) :: index
2935 : real(r8), intent(out) :: lon
2936 : real(r8), intent(out) :: lat
2937 : logical, intent(out) :: isMapped
2938 :
2939 : ! Local variables
2940 : integer :: latindex, lonindex
2941 : character(len=*), parameter :: subname = "cam_grid_get_lon_lat"
2942 :
2943 0 : if (this%block_indexed) then
2944 0 : lonindex = index
2945 0 : latindex = index
2946 0 : isMapped = this%map%is_mapped(index)
2947 : else
2948 0 : call this%map%coord_vals(index, lonindex, latindex, isMapped)
2949 : end if
2950 :
2951 : !!XXgoldyXX: May be able to relax all the checks
2952 0 : if ( (latindex < LBOUND(this%lat_coord%values, 1)) .or. &
2953 : (latindex > UBOUND(this%lat_coord%values, 1))) then
2954 0 : call endrun(trim(subname)//": index out of range for latvals")
2955 : else
2956 0 : lat = this%lat_coord%values(latindex)
2957 : end if
2958 :
2959 0 : if ( (lonindex < LBOUND(this%lon_coord%values, 1)) .or. &
2960 : (lonindex > UBOUND(this%lon_coord%values, 1))) then
2961 0 : call endrun(trim(subname)//": index out of range for lonvals")
2962 : else
2963 0 : lon = this%lon_coord%values(lonindex)
2964 : end if
2965 :
2966 0 : end subroutine cam_grid_get_lon_lat
2967 :
2968 : !---------------------------------------------------------------------------
2969 : !
2970 : ! cam_grid_find_src_dims: Find the correct src array dims for this grid
2971 : !
2972 : !---------------------------------------------------------------------------
2973 121344 : subroutine cam_grid_find_src_dims(this, field_dnames, src_out)
2974 : ! Dummy arguments
2975 : class(cam_grid_t) :: this
2976 : character(len=*), intent(in) :: field_dnames(:)
2977 : integer, pointer :: src_out(:)
2978 :
2979 : ! Local variables
2980 : integer :: i, j
2981 : integer :: num_coords
2982 : character(len=max_hcoordname_len) :: coord_dimnames(2)
2983 :
2984 121344 : call this%dim_names(coord_dimnames(1), coord_dimnames(2))
2985 121344 : if (associated(src_out)) then
2986 0 : deallocate(src_out)
2987 : nullify(src_out)
2988 : end if
2989 121344 : if (trim(coord_dimnames(1)) == trim(coord_dimnames(2))) then
2990 : num_coords = 1
2991 : else
2992 0 : num_coords = 2
2993 : end if
2994 121344 : allocate(src_out(2)) ! Currently, all cases have two source dims
2995 242688 : do i = 1, num_coords
2996 485376 : do j = 1, size(field_dnames)
2997 364032 : if (trim(field_dnames(j)) == trim(coord_dimnames(i))) then
2998 121344 : src_out(i) = j
2999 : end if
3000 : end do
3001 : end do
3002 121344 : if (num_coords < 2) then
3003 121344 : src_out(2) = -1 ! Assume a block structure for unstructured grids
3004 : end if
3005 :
3006 121344 : end subroutine cam_grid_find_src_dims
3007 :
3008 : !---------------------------------------------------------------------------
3009 : !
3010 : ! cam_grid_find_dest_dims: Find the correct file array dims for this grid
3011 : !
3012 : !---------------------------------------------------------------------------
3013 121344 : subroutine cam_grid_find_dest_dims(this, file_dnames, dest_out)
3014 : ! Dummy arguments
3015 : class(cam_grid_t) :: this
3016 : character(len=*), intent(in) :: file_dnames(:)
3017 : integer, pointer :: dest_out(:)
3018 :
3019 : ! Local variables
3020 : integer :: i, j
3021 : integer :: num_coords
3022 : character(len=max_hcoordname_len) :: coord_dimnames(2)
3023 :
3024 121344 : call this%dim_names(coord_dimnames(1), coord_dimnames(2))
3025 121344 : if (associated(dest_out)) then
3026 0 : deallocate(dest_out)
3027 : nullify(dest_out)
3028 : end if
3029 121344 : if (trim(coord_dimnames(1)) == trim(coord_dimnames(2))) then
3030 : num_coords = 1
3031 : else
3032 0 : num_coords = 2
3033 : end if
3034 364032 : allocate(dest_out(num_coords))
3035 242688 : dest_out = 0
3036 242688 : do i = 1, num_coords
3037 485376 : do j = 1, size(file_dnames)
3038 364032 : if (trim(file_dnames(j)) == trim(coord_dimnames(i))) then
3039 121344 : dest_out(i) = j
3040 : end if
3041 : end do
3042 : end do
3043 :
3044 121344 : end subroutine cam_grid_find_dest_dims
3045 :
3046 : !---------------------------------------------------------------------------
3047 : !
3048 : ! cam_grid_get_pio_decomp: Find or create a PIO decomp on this grid
3049 : !
3050 : !---------------------------------------------------------------------------
3051 272640 : subroutine cam_grid_get_pio_decomp(this, field_lens, file_lens, dtype, &
3052 272640 : iodesc, field_dnames, file_dnames)
3053 : use pio, only: io_desc_t
3054 : use cam_pio_utils, only: cam_pio_get_decomp, calc_permutation
3055 :
3056 : ! Dummy arguments
3057 : class(cam_grid_t) :: this
3058 : integer, intent(in) :: field_lens(:)
3059 : integer, intent(in) :: file_lens(:)
3060 : integer, intent(in) :: dtype
3061 : type(io_desc_t), pointer, intent(out) :: iodesc
3062 : character(len=*), optional, intent(in) :: field_dnames(:)
3063 : character(len=*), optional, intent(in) :: file_dnames(:)
3064 :
3065 : ! Local variables
3066 272640 : integer, pointer :: src_in(:)
3067 272640 : integer, pointer :: dest_in(:)
3068 272640 : integer, allocatable :: permutation(:)
3069 : logical :: is_perm
3070 : character(len=128) :: errormsg
3071 :
3072 272640 : nullify(src_in)
3073 272640 : nullify(dest_in)
3074 272640 : is_perm = .false.
3075 272640 : if (.not. associated(this%map)) then
3076 0 : write(errormsg, *) 'Grid, '//trim(this%name)//', has no map'
3077 0 : call endrun('cam_grid_get_pio_decomp: '//trim(errormsg))
3078 : else
3079 272640 : if (present(field_dnames)) then
3080 121344 : call this%find_src_dims(field_dnames, src_in)
3081 : end if
3082 272640 : if (present(file_dnames)) then
3083 121344 : call this%find_dest_dims(file_dnames, dest_in)
3084 : end if
3085 272640 : if (present(file_dnames) .and. present(field_dnames)) then
3086 : ! This only works if the arrays are the same size
3087 121344 : if (size(file_dnames) == size(field_dnames)) then
3088 364032 : allocate(permutation(size(file_dnames)))
3089 121344 : call calc_permutation(file_dnames, field_dnames, permutation, is_perm)
3090 : end if
3091 : end if
3092 : ! Call cam_pio_get_decomp with the appropriate options
3093 272640 : if (present(field_dnames) .and. present(file_dnames)) then
3094 121344 : if (is_perm) then
3095 : call cam_pio_get_decomp(iodesc, field_lens, file_lens, dtype, &
3096 : this%map, field_dist_in=src_in, file_dist_in=dest_in, &
3097 0 : permute=permutation)
3098 : else
3099 : call cam_pio_get_decomp(iodesc, field_lens, file_lens, dtype, &
3100 121344 : this%map, field_dist_in=src_in, file_dist_in=dest_in)
3101 : end if
3102 151296 : else if (present(field_dnames)) then
3103 : call cam_pio_get_decomp(iodesc, field_lens, file_lens, dtype, &
3104 0 : this%map, field_dist_in=src_in)
3105 151296 : else if (present(file_dnames)) then
3106 : call cam_pio_get_decomp(iodesc, field_lens, file_lens, dtype, &
3107 0 : this%map, file_dist_in=dest_in)
3108 : else
3109 151296 : call cam_pio_get_decomp(iodesc, field_lens, file_lens, dtype, this%map)
3110 : end if
3111 : end if
3112 272640 : if (associated(src_in)) then
3113 121344 : deallocate(src_in)
3114 : nullify(src_in)
3115 : end if
3116 272640 : if (associated(dest_in)) then
3117 121344 : deallocate(dest_in)
3118 : nullify(dest_in)
3119 : end if
3120 272640 : if (allocated(permutation)) then
3121 121344 : deallocate(permutation)
3122 : end if
3123 :
3124 545280 : end subroutine cam_grid_get_pio_decomp
3125 :
3126 : !-------------------------------------------------------------------------------
3127 : !
3128 : ! cam_grid_find_dimids: Find the dimension NetCDF IDs on <File> for this grid
3129 : !
3130 : !-------------------------------------------------------------------------------
3131 1536 : subroutine cam_grid_find_dimids(this, File, dimids)
3132 272640 : use pio, only: file_desc_t, pio_noerr, pio_inq_dimid
3133 : use pio, only: pio_seterrorhandling, pio_bcast_error
3134 :
3135 : ! Dummy arguments
3136 : class(cam_grid_t) :: this
3137 : type(file_desc_t), intent(inout) :: File ! PIO file handle
3138 : integer, intent(out) :: dimids(:)
3139 :
3140 : ! Local vaariables
3141 : integer :: ierr
3142 : integer :: err_handling
3143 : character(len=max_hcoordname_len) :: dimname1, dimname2
3144 :
3145 : ! We will handle errors for this routine
3146 1536 : call pio_seterrorhandling(File, PIO_BCAST_ERROR,err_handling)
3147 :
3148 1536 : call this%dim_names(dimname1, dimname2)
3149 1536 : if (size(dimids) < 1) then
3150 0 : call endrun('CAM_GRID_FIND_DIMIDS: dimids must have positive size')
3151 : end if
3152 6144 : dimids = -1
3153 : ! Check the first dimension
3154 1536 : ierr = pio_inq_dimid(File, trim(dimname1), dimids(1))
3155 1536 : if(ierr /= PIO_NOERR) then
3156 0 : call endrun('CAM_GRID_FIND_DIMIDS: '//trim(this%name)//' dimension, '//trim(dimname1)//', does not exist on file')
3157 : end if
3158 1536 : if (trim(dimname1) /= trim(dimname2)) then
3159 : ! Structured grid, find second dimid
3160 0 : if (size(dimids) < 2) then
3161 0 : call endrun('CAM_GRID_FIND_DIMIDS: dimids too small for '//trim(this%name))
3162 : end if
3163 0 : ierr = pio_inq_dimid(File, trim(dimname2), dimids(2))
3164 0 : if(ierr /= PIO_NOERR) then
3165 0 : call endrun('CAM_GRID_FIND_DIMIDS: '//trim(this%name)//' dimension, '//trim(dimname2)//', does not exist on file')
3166 : end if
3167 : end if
3168 :
3169 : ! Back to whatever error handling was running before this routine
3170 1536 : call pio_seterrorhandling(File, err_handling)
3171 :
3172 1536 : end subroutine cam_grid_find_dimids
3173 :
3174 : !---------------------------------------------------------------------------
3175 : !
3176 : ! cam_grid_read_darray_2d_int: Read a variable defined on this grid
3177 : !
3178 : !---------------------------------------------------------------------------
3179 768 : subroutine cam_grid_read_darray_2d_int(this, File, adims, fdims, hbuf, varid)
3180 : use pio, only: file_desc_t, io_desc_t, pio_read_darray, PIO_INT
3181 : use cam_pio_utils, only: cam_pio_get_decomp
3182 :
3183 : ! Dummy arguments
3184 : class(cam_grid_t) :: this
3185 : type(file_desc_t), intent(inout) :: File ! PIO file handle
3186 : integer, intent(in) :: adims(:)
3187 : integer, intent(in) :: fdims(:)
3188 : integer, intent(out) :: hbuf(:,:)
3189 : type(var_desc_t), intent(inout) :: varid
3190 :
3191 : ! Local variables
3192 : type(io_desc_t), pointer :: iodesc
3193 : integer :: ierr
3194 :
3195 768 : call cam_pio_get_decomp(iodesc, adims, fdims, PIO_INT, this%map)
3196 768 : call pio_read_darray(File, varid, iodesc, hbuf, ierr)
3197 768 : call cam_pio_handle_error(ierr, 'cam_grid_read_darray_2d_int: Error reading variable')
3198 768 : end subroutine cam_grid_read_darray_2d_int
3199 :
3200 : !---------------------------------------------------------------------------
3201 : !
3202 : ! cam_grid_read_darray_3d_int: Read a variable defined on this grid
3203 : !
3204 : !---------------------------------------------------------------------------
3205 0 : subroutine cam_grid_read_darray_3d_int(this, File, adims, fdims, hbuf, varid)
3206 768 : use pio, only: file_desc_t, io_desc_t, pio_read_darray, PIO_INT
3207 : use cam_pio_utils, only: cam_pio_get_decomp
3208 :
3209 : ! Dummy arguments
3210 : class(cam_grid_t) :: this
3211 : type(file_desc_t), intent(inout) :: File ! PIO file handle
3212 : integer, intent(in) :: adims(:)
3213 : integer, intent(in) :: fdims(:)
3214 : integer, intent(out) :: hbuf(:,:,:)
3215 : type(var_desc_t), intent(inout) :: varid
3216 :
3217 : ! Local variables
3218 : type(io_desc_t), pointer :: iodesc
3219 : integer :: ierr
3220 :
3221 0 : call cam_pio_get_decomp(iodesc, adims, fdims, PIO_INT, this%map)
3222 0 : call pio_read_darray(File, varid, iodesc, hbuf, ierr)
3223 0 : call cam_pio_handle_error(ierr, 'cam_grid_read_darray_3d_int: Error reading variable')
3224 0 : end subroutine cam_grid_read_darray_3d_int
3225 :
3226 : !---------------------------------------------------------------------------
3227 : !
3228 : ! cam_grid_read_darray_2d_double: Read a variable defined on this grid
3229 : !
3230 : !---------------------------------------------------------------------------
3231 19968 : subroutine cam_grid_read_darray_2d_double(this, File, adims, fdims, hbuf, varid)
3232 0 : use pio, only: file_desc_t, io_desc_t, pio_read_darray
3233 : use pio, only: PIO_DOUBLE
3234 : use cam_pio_utils, only: cam_pio_get_decomp
3235 :
3236 : ! Dummy arguments
3237 : class(cam_grid_t) :: this
3238 : type(file_desc_t), intent(inout) :: File ! PIO file handle
3239 : integer, intent(in) :: adims(:)
3240 : integer, intent(in) :: fdims(:)
3241 : real(r8), intent(out) :: hbuf(:,:)
3242 : type(var_desc_t), intent(inout) :: varid
3243 :
3244 : ! Local variables
3245 : type(io_desc_t), pointer :: iodesc
3246 : integer :: ierr
3247 :
3248 19968 : call cam_pio_get_decomp(iodesc, adims, fdims, PIO_DOUBLE, this%map)
3249 19968 : call pio_read_darray(File, varid, iodesc, hbuf, ierr)
3250 19968 : call cam_pio_handle_error(ierr, 'cam_grid_read_darray_2d_double: Error reading variable')
3251 19968 : end subroutine cam_grid_read_darray_2d_double
3252 :
3253 : !---------------------------------------------------------------------------
3254 : !
3255 : ! cam_grid_read_darray_3d_double: Read a variable defined on this grid
3256 : !
3257 : !---------------------------------------------------------------------------
3258 83712 : subroutine cam_grid_read_darray_3d_double(this, File, adims, fdims, hbuf, varid)
3259 19968 : use pio, only: file_desc_t, io_desc_t, pio_read_darray
3260 : use pio, only: PIO_DOUBLE
3261 : use cam_pio_utils, only: cam_pio_get_decomp
3262 :
3263 : ! Dummy arguments
3264 : class(cam_grid_t) :: this
3265 : type(file_desc_t), intent(inout) :: File ! PIO file handle
3266 : integer, intent(in) :: adims(:)
3267 : integer, intent(in) :: fdims(:)
3268 : real(r8), intent(out) :: hbuf(:,:,:)
3269 : type(var_desc_t), intent(inout) :: varid
3270 :
3271 : ! Local variables
3272 : type(io_desc_t), pointer :: iodesc
3273 : integer :: ierr
3274 :
3275 83712 : call cam_pio_get_decomp(iodesc, adims, fdims, PIO_DOUBLE, this%map)
3276 83712 : call pio_read_darray(File, varid, iodesc, hbuf, ierr)
3277 83712 : call cam_pio_handle_error(ierr, 'cam_grid_read_darray_3d_double: Error reading variable')
3278 83712 : end subroutine cam_grid_read_darray_3d_double
3279 :
3280 : !---------------------------------------------------------------------------
3281 : !
3282 : ! cam_grid_read_darray_2d_real: Read a variable defined on this grid
3283 : !
3284 : !---------------------------------------------------------------------------
3285 0 : subroutine cam_grid_read_darray_2d_real(this, File, adims, fdims, hbuf, varid)
3286 83712 : use pio, only: file_desc_t, io_desc_t, pio_read_darray
3287 : use pio, only: PIO_REAL
3288 : use cam_pio_utils, only: cam_pio_get_decomp
3289 :
3290 : ! Dummy arguments
3291 : class(cam_grid_t) :: this
3292 : type(file_desc_t), intent(inout) :: File ! PIO file handle
3293 : integer, intent(in) :: adims(:)
3294 : integer, intent(in) :: fdims(:)
3295 : real(r4), intent(out) :: hbuf(:,:)
3296 : type(var_desc_t), intent(inout) :: varid
3297 :
3298 : ! Local variables
3299 : type(io_desc_t), pointer :: iodesc
3300 : integer :: ierr
3301 :
3302 0 : call cam_pio_get_decomp(iodesc, adims, fdims, PIO_REAL, this%map)
3303 0 : call pio_read_darray(File, varid, iodesc, hbuf, ierr)
3304 0 : call cam_pio_handle_error(ierr, 'cam_grid_read_darray_2d_real: Error reading variable')
3305 0 : end subroutine cam_grid_read_darray_2d_real
3306 :
3307 : !---------------------------------------------------------------------------
3308 : !
3309 : ! cam_grid_read_darray_3d_real: Read a variable defined on this grid
3310 : !
3311 : !---------------------------------------------------------------------------
3312 0 : subroutine cam_grid_read_darray_3d_real(this, File, adims, fdims, hbuf, varid)
3313 0 : use pio, only: file_desc_t, io_desc_t, pio_read_darray
3314 : use pio, only: PIO_REAL
3315 : use cam_pio_utils, only: cam_pio_get_decomp
3316 :
3317 : ! Dummy arguments
3318 : class(cam_grid_t) :: this
3319 : type(file_desc_t), intent(inout) :: File ! PIO file handle
3320 : integer, intent(in) :: adims(:)
3321 : integer, intent(in) :: fdims(:)
3322 : real(r4), intent(out) :: hbuf(:,:,:)
3323 : type(var_desc_t), intent(inout) :: varid
3324 :
3325 : ! Local variables
3326 : type(io_desc_t), pointer :: iodesc
3327 : integer :: ierr
3328 :
3329 0 : call cam_pio_get_decomp(iodesc, adims, fdims, PIO_REAL, this%map)
3330 0 : call pio_read_darray(File, varid, iodesc, hbuf, ierr)
3331 0 : call cam_pio_handle_error(ierr, 'cam_grid_read_darray_2d_: Error reading variable')
3332 0 : end subroutine cam_grid_read_darray_3d_real
3333 :
3334 : !---------------------------------------------------------------------------
3335 : !
3336 : ! cam_grid_write_darray_2d_int: Write a variable defined on this grid
3337 : !
3338 : !---------------------------------------------------------------------------
3339 1536 : subroutine cam_grid_write_darray_2d_int(this, File, adims, fdims, hbuf, varid)
3340 0 : use pio, only: file_desc_t, io_desc_t
3341 : use pio, only: pio_write_darray, PIO_INT
3342 :
3343 : use cam_pio_utils, only: cam_pio_get_decomp
3344 :
3345 : ! Dummy arguments
3346 : class(cam_grid_t) :: this
3347 : type(file_desc_t), intent(inout) :: File ! PIO file handle
3348 : integer, intent(in) :: adims(:)
3349 : integer, intent(in) :: fdims(:)
3350 : integer, intent(in) :: hbuf(:,:)
3351 : type(var_desc_t), intent(inout) :: varid
3352 :
3353 : ! Local variables
3354 : type(io_desc_t), pointer :: iodesc
3355 : integer :: ierr
3356 :
3357 1536 : call cam_pio_get_decomp(iodesc, adims, fdims, PIO_INT, this%map)
3358 1536 : call pio_write_darray(File, varid, iodesc, hbuf, ierr)
3359 1536 : call cam_pio_handle_error(ierr, 'cam_grid_write_darray_2d_int: Error writing variable')
3360 1536 : end subroutine cam_grid_write_darray_2d_int
3361 :
3362 : !---------------------------------------------------------------------------
3363 : !
3364 : ! cam_grid_write_darray_3d_int: Write a variable defined on this grid
3365 : !
3366 : !---------------------------------------------------------------------------
3367 0 : subroutine cam_grid_write_darray_3d_int(this, File, adims, fdims, hbuf, varid)
3368 1536 : use pio, only: file_desc_t, io_desc_t
3369 : use pio, only: pio_write_darray, PIO_INT
3370 : use cam_pio_utils, only: cam_pio_get_decomp
3371 :
3372 : ! Dummy arguments
3373 : class(cam_grid_t) :: this
3374 : type(file_desc_t), intent(inout) :: File ! PIO file handle
3375 : integer, intent(in) :: adims(:)
3376 : integer, intent(in) :: fdims(:)
3377 : integer, intent(in) :: hbuf(:,:,:)
3378 : type(var_desc_t), intent(inout) :: varid
3379 :
3380 : ! Local variables
3381 : type(io_desc_t), pointer :: iodesc
3382 : integer :: ierr
3383 :
3384 0 : call cam_pio_get_decomp(iodesc, adims, fdims, PIO_INT, this%map)
3385 0 : call pio_write_darray(File, varid, iodesc, hbuf, ierr)
3386 0 : call cam_pio_handle_error(ierr, 'cam_grid_write_darray_3d_int: Error writing variable')
3387 0 : end subroutine cam_grid_write_darray_3d_int
3388 :
3389 : !---------------------------------------------------------------------------
3390 : !
3391 : ! cam_grid_write_darray_2d_double: Write a variable defined on this grid
3392 : !
3393 : !---------------------------------------------------------------------------
3394 39936 : subroutine cam_grid_write_darray_2d_double(this, File, adims, fdims, hbuf, varid)
3395 0 : use pio, only: file_desc_t, io_desc_t
3396 : use pio, only: pio_write_darray, PIO_DOUBLE
3397 : use cam_pio_utils, only: cam_pio_get_decomp
3398 :
3399 : ! Dummy arguments
3400 : class(cam_grid_t) :: this
3401 : type(file_desc_t), intent(inout) :: File ! PIO file handle
3402 : integer, intent(in) :: adims(:)
3403 : integer, intent(in) :: fdims(:)
3404 : real(r8), intent(in) :: hbuf(:,:)
3405 : type(var_desc_t), intent(inout) :: varid
3406 :
3407 : ! Local variables
3408 : type(io_desc_t), pointer :: iodesc
3409 : integer :: ierr
3410 :
3411 39936 : call cam_pio_get_decomp(iodesc, adims, fdims, PIO_DOUBLE, this%map)
3412 39936 : call pio_write_darray(File, varid, iodesc, hbuf, ierr)
3413 39936 : call cam_pio_handle_error(ierr, 'cam_grid_write_darray_2d_double: Error writing variable')
3414 39936 : end subroutine cam_grid_write_darray_2d_double
3415 :
3416 : !---------------------------------------------------------------------------
3417 : !
3418 : ! cam_grid_write_darray_3d_double: Write a variable defined on this grid
3419 : !
3420 : !---------------------------------------------------------------------------
3421 167424 : subroutine cam_grid_write_darray_3d_double(this, File, adims, fdims, hbuf, varid)
3422 39936 : use pio, only: file_desc_t, io_desc_t
3423 : use pio, only: pio_write_darray, PIO_DOUBLE
3424 : use cam_pio_utils, only: cam_pio_get_decomp
3425 :
3426 : ! Dummy arguments
3427 : class(cam_grid_t) :: this
3428 : type(file_desc_t), intent(inout) :: File ! PIO file handle
3429 : integer, intent(in) :: adims(:)
3430 : integer, intent(in) :: fdims(:)
3431 : real(r8), intent(in) :: hbuf(:,:,:)
3432 : type(var_desc_t), intent(inout) :: varid
3433 :
3434 : ! Local variables
3435 : type(io_desc_t), pointer :: iodesc
3436 : integer :: ierr
3437 :
3438 167424 : call cam_pio_get_decomp(iodesc, adims, fdims, PIO_DOUBLE, this%map)
3439 167424 : call pio_write_darray(File, varid, iodesc, hbuf, ierr)
3440 167424 : call cam_pio_handle_error(ierr, 'cam_grid_write_darray_3d_double: Error writing variable')
3441 :
3442 167424 : end subroutine cam_grid_write_darray_3d_double
3443 :
3444 : !---------------------------------------------------------------------------
3445 : !
3446 : ! cam_grid_write_darray_2d_real: Write a variable defined on this grid
3447 : !
3448 : !---------------------------------------------------------------------------
3449 1211904 : subroutine cam_grid_write_darray_2d_real(this, File, adims, fdims, hbuf, varid)
3450 167424 : use pio, only: file_desc_t, io_desc_t
3451 : use pio, only: pio_write_darray, PIO_REAL
3452 : use cam_pio_utils, only: cam_pio_get_decomp
3453 :
3454 : ! Dummy arguments
3455 : class(cam_grid_t) :: this
3456 : type(file_desc_t), intent(inout) :: File ! PIO file handle
3457 : integer, intent(in) :: adims(:)
3458 : integer, intent(in) :: fdims(:)
3459 : real(r4), intent(in) :: hbuf(:,:)
3460 : type(var_desc_t), intent(inout) :: varid
3461 :
3462 : ! Local variables
3463 : type(io_desc_t), pointer :: iodesc
3464 : integer :: ierr
3465 :
3466 1211904 : call cam_pio_get_decomp(iodesc, adims, fdims, PIO_REAL, this%map)
3467 1211904 : call pio_write_darray(File, varid, iodesc, hbuf, ierr)
3468 1211904 : call cam_pio_handle_error(ierr, 'cam_grid_write_darray_2d_real: Error writing variable')
3469 1211904 : end subroutine cam_grid_write_darray_2d_real
3470 :
3471 : !---------------------------------------------------------------------------
3472 : !
3473 : ! cam_grid_write_darray_3d_real: Write a variable defined on this grid
3474 : !
3475 : !---------------------------------------------------------------------------
3476 695808 : subroutine cam_grid_write_darray_3d_real(this, File, adims, fdims, hbuf, varid)
3477 1211904 : use pio, only: file_desc_t, io_desc_t
3478 : use pio, only: pio_write_darray, PIO_REAL
3479 : use cam_pio_utils, only: cam_pio_get_decomp
3480 :
3481 : ! Dummy arguments
3482 : class(cam_grid_t) :: this
3483 : type(file_desc_t), intent(inout) :: File ! PIO file handle
3484 : integer, intent(in) :: adims(:)
3485 : integer, intent(in) :: fdims(:)
3486 : real(r4), intent(in) :: hbuf(:,:,:)
3487 : type(var_desc_t), intent(inout) :: varid
3488 :
3489 : ! Local variables
3490 : type(io_desc_t), pointer :: iodesc
3491 : integer :: ierr
3492 :
3493 695808 : nullify(iodesc)
3494 695808 : call cam_pio_get_decomp(iodesc, adims, fdims, PIO_REAL, this%map)
3495 695808 : call pio_write_darray(File, varid, iodesc, hbuf, ierr)
3496 695808 : call cam_pio_handle_error(ierr, 'cam_grid_write_darray_3d_real: Error writing variable')
3497 695808 : end subroutine cam_grid_write_darray_3d_real
3498 :
3499 : !---------------------------------------------------------------------------
3500 : !
3501 : ! cam_grid_get_patch_mask: Compute a map which is defined for locations
3502 : ! within the input patch.
3503 : !
3504 : !---------------------------------------------------------------------------
3505 0 : subroutine cam_grid_get_patch_mask(this, lonl, lonu, latl, latu, patch, cco)
3506 695808 : use spmd_utils, only: mpi_min, mpi_max, mpi_real8, mpicom
3507 : use physconst, only: pi
3508 :
3509 : ! Dummy arguments
3510 : class(cam_grid_t) :: this
3511 : real(r8), intent(in) :: lonl, lonu ! Longitude bounds
3512 : real(r8), intent(in) :: latl, latu ! Latitude bounds
3513 : type(cam_grid_patch_t), intent(inout) :: patch
3514 : logical, intent(in) :: cco ! Collect columns?
3515 :
3516 : ! Local arguments
3517 : real(r8) :: mindist, minlondist
3518 : real(r8) :: dist, temp1, temp2 ! Test distance calc
3519 : real(r8) :: londeg, latdeg
3520 : real(r8) :: lon, lat
3521 : real(r8) :: londeg_min, latdeg_min
3522 : real(r8) :: lonmin, lonmax, latmin, latmax
3523 : integer :: minind ! Location of closest point
3524 : integer :: mapind ! Grid map index
3525 : integer :: latind, lonind
3526 : integer :: ierr ! For MPI calls
3527 : integer :: dims(2) ! Global dim sizes
3528 : integer :: gridloc ! local size of grid
3529 : logical :: unstructured ! grid type
3530 : logical :: findClosest ! .false. == patch output
3531 : logical :: isMapped ! .true. iff point in map
3532 :
3533 : real(r8), parameter :: maxangle = pi / 4.0_r8
3534 : real(r8), parameter :: deg2rad = pi / 180.0_r8
3535 : real(r8), parameter :: maxtol = 0.99999_r8 ! max cos value
3536 : real(r8), parameter :: maxlat = pi * maxtol / 2.0_r8
3537 : character(len=*), parameter :: subname = 'cam_grid_get_patch_mask'
3538 :
3539 0 : if (.not. associated(this%map)) then
3540 0 : call endrun('cam_grid_get_patch_mask: Grid, '//trim(this%name)//', has no map')
3541 : end if
3542 0 : gridloc = this%map%num_elem()
3543 0 : unstructured = this%is_unstructured()
3544 0 : call this%coord_lengths(dims)
3545 0 : if (associated(patch%mask)) then
3546 0 : if (patch%mask%num_elem() /= gridloc) then
3547 : ! The mask needs to be the same size as the map
3548 0 : call endrun(subname//': mask is incorrect size')
3549 : ! No else, just needed a check
3550 : ! In particular, we are not zeroing the mask since multiple calls with
3551 : ! the same mask can be used for collected-column output
3552 : ! NB: Compacting the mask must be done after all calls (for a
3553 : ! particular mask) to this function.
3554 : end if
3555 0 : if (patch%collected_columns .neqv. cco) then
3556 0 : call endrun(subname//': collected_column mismatch')
3557 : end if
3558 : else
3559 0 : if (associated(patch%latmap)) then
3560 0 : call endrun(subname//': unallocated patch has latmap')
3561 : end if
3562 0 : if (associated(patch%lonmap)) then
3563 0 : call endrun(subname//': unallocated patch has lonmap')
3564 : end if
3565 0 : call patch%set_patch(lonl, lonu, latl, latu, cco, this%id, this%map)
3566 0 : if (patch%mask%num_elem() /= gridloc) then
3567 : ! Basic check to make sure the copy worked
3568 0 : call endrun(subname//': grid map is invalid')
3569 : end if
3570 0 : call patch%mask%clear()
3571 : ! Set up the lat/lon maps
3572 0 : if (cco) then
3573 : ! For collected column output, we need to collect coordinates and values
3574 0 : allocate(patch%latmap(patch%mask%num_elem()))
3575 0 : patch%latmap = 0
3576 0 : allocate(patch%latvals(patch%mask%num_elem()))
3577 0 : patch%latvals = 91.0_r8
3578 0 : allocate(patch%lonmap(patch%mask%num_elem()))
3579 0 : patch%lonmap = 0
3580 0 : allocate(patch%lonvals(patch%mask%num_elem()))
3581 0 : patch%lonvals = 361.0_r8
3582 : else
3583 0 : if (associated(this%lat_coord%values)) then
3584 0 : allocate(patch%latmap(LBOUND(this%lat_coord%values, 1):UBOUND(this%lat_coord%values, 1)))
3585 0 : patch%latmap = 0
3586 : else
3587 0 : nullify(patch%latmap)
3588 : end if
3589 0 : if (associated(this%lon_coord%values)) then
3590 0 : allocate(patch%lonmap(LBOUND(this%lon_coord%values, 1):UBOUND(this%lon_coord%values, 1)))
3591 0 : patch%lonmap = 0
3592 : else
3593 0 : nullify(patch%lonmap)
3594 : end if
3595 : end if
3596 : end if
3597 :
3598 : ! We have to iterate through each grid point to check
3599 : ! We have four cases, structured vs. unstructured grid *
3600 : ! patch area vs. closest column
3601 : ! Note that a 1-d patch 'area' is not allowed for unstructured grids
3602 0 : findClosest = .false.
3603 : ! Make sure our search items are in order
3604 0 : lonmin = min(lonl, lonu)
3605 0 : lonmax = max(lonl, lonu)
3606 0 : latmin = min(latl, latu)
3607 0 : latmax = max(latl, latu)
3608 0 : if (lonl == lonu) then
3609 0 : if (latl == latu) then
3610 : findClosest = .true.
3611 0 : else if (unstructured) then
3612 0 : call endrun(subname//': 1-D patch (lon) not allowed for unstructured grids')
3613 : else
3614 : ! Find closest lon line to lonu
3615 : ! This is a lat lon grid so it should have coordinate axes
3616 0 : lonmin = 365.0_r8
3617 0 : mindist = 365.0_r8
3618 0 : if (associated(this%lon_coord%values)) then
3619 0 : do lonind = LBOUND(this%lon_coord%values, 1), UBOUND(this%lon_coord%values, 1)
3620 0 : dist = abs(this%lon_coord%values(lonind) - lonu)
3621 0 : if (dist < mindist) then
3622 0 : lonmin = this%lon_coord%values(lonind)
3623 0 : mindist = dist
3624 : end if
3625 : end do
3626 : end if
3627 : ! Get the global minimum
3628 0 : dist = mindist
3629 0 : call MPI_allreduce(dist, mindist, 1, mpi_real8, mpi_min, mpicom, ierr)
3630 0 : if (dist == mindist) then
3631 : ! We have a ringer so use only that longitude
3632 : lonmax = lonmin
3633 : else
3634 : ! We don't have a minimum dist so count no points
3635 0 : lonmax = lonmin - 1.0_r8
3636 : end if
3637 : end if
3638 0 : else if (latl == latu) then
3639 0 : if (unstructured) then
3640 0 : call endrun(subname//': 1-D patch (lat) not allowed for unstructured grids')
3641 : else
3642 : ! Find closest lat line to latu
3643 : ! This is a lat lon grid so it should have coordinate axes
3644 0 : latmin = 91.0_r8
3645 0 : mindist = 181.0_r8
3646 0 : if (associated(this%lat_coord%values)) then
3647 0 : do latind = LBOUND(this%lat_coord%values, 1), UBOUND(this%lat_coord%values, 1)
3648 0 : dist = abs(this%lat_coord%values(latind) - latl)
3649 0 : if (dist < mindist) then
3650 0 : latmin = this%lat_coord%values(latind)
3651 0 : mindist = dist
3652 : end if
3653 : end do
3654 : end if
3655 : ! Get the global minimum
3656 0 : dist = mindist
3657 0 : call MPI_allreduce(dist, mindist, 1, mpi_real8, mpi_min, mpicom, ierr)
3658 0 : if (dist == mindist) then
3659 : ! We have a ringer so use only that latitude
3660 : latmax = latmin
3661 : else
3662 : ! We don't have a minimum dist so count no points
3663 0 : latmax = latmin - 1.0_r8
3664 : end if
3665 : end if
3666 : end if
3667 :
3668 : ! Convert to radians
3669 0 : lonmin = lonmin * deg2rad
3670 0 : lonmax = lonmax * deg2rad
3671 0 : latmin = latmin * deg2rad
3672 0 : latmax = latmax * deg2rad
3673 : ! Loop through all the local grid elements and find the closest match
3674 : ! (or all matches depending on the value of findClosest)
3675 0 : minind = -1
3676 0 : londeg_min = 361.0_r8
3677 0 : latdeg_min = 91.0_r8
3678 0 : mindist = 2.0_r8 * pi
3679 :
3680 0 : do mapind = 1, patch%mask%num_elem()
3681 0 : call this%get_lon_lat(mapind, londeg, latdeg, isMapped)
3682 0 : if (isMapped) then
3683 0 : lon = londeg * deg2rad
3684 0 : lat = latdeg * deg2rad
3685 0 : if (findClosest) then
3686 : ! Use the Spherical Law of Cosines to find the great-circle distance.
3687 : ! Might as well use the unit sphere since we just want differences
3688 0 : if ( (abs(lat - latmin) <= maxangle) .and. &
3689 : (abs(lon - lonmin) <= maxangle)) then
3690 : ! maxangle could be pi but why waste all those trig functions?
3691 0 : if ((lat == latmin) .and. (lon == lonmin)) then
3692 0 : dist = 0.0_r8
3693 : else
3694 : temp1 = (sin(latmin) * sin(lat)) + &
3695 0 : (cos(latmin) * cos(lat) * cos(lon - lonmin))
3696 0 : if (temp1 > maxtol) then
3697 : ! Use haversine formula
3698 0 : temp1 = sin(latmin - lat)
3699 0 : temp2 = sin((lonmin - lon) / 2.0_r8)
3700 0 : dist = 2.0_r8 * asin((temp1*temp1) + (cos(latmin)*cos(lat)*temp2*temp2))
3701 : else
3702 0 : dist = acos(temp1)
3703 : end if
3704 : end if
3705 0 : if ( (dist < mindist) .or. &
3706 : ((dist == mindist) .and. &
3707 : (abs(lon - lonmin) < abs(londeg_min*deg2rad - lonmin)))) then
3708 0 : minind = mapind
3709 0 : mindist = dist
3710 0 : londeg_min = londeg
3711 0 : latdeg_min = latdeg
3712 : end if
3713 : end if
3714 : else
3715 : if ( (latmin <= lat) .and. (lat <= latmax) .and. &
3716 0 : (lonmin <= lon) .and. (lon <= lonmax)) then
3717 0 : if (patch%mask%num_elem() >= mapind) then
3718 0 : if (.not. patch%mask%is_mapped(mapind)) then
3719 0 : call patch%mask%copy_elem(this%map, mapind)
3720 0 : patch%num_points = patch%num_points + 1
3721 0 : if (cco) then
3722 0 : if (patch%num_points > size(patch%latvals, 1)) then
3723 0 : call endrun(subname//': Number of cols larger than mask!?')
3724 : end if
3725 0 : call this%map%coord_dests(mapind, lonind, latind)
3726 0 : if (latind > 0) then
3727 : ! Grid is structured, get unique index
3728 0 : lonind = lonind + (latind * dims(1))
3729 : end if
3730 0 : patch%latmap(patch%num_points) = lonind
3731 0 : patch%latvals(patch%num_points) = latdeg
3732 0 : patch%lonmap(patch%num_points) = lonind
3733 0 : patch%lonvals(patch%num_points) = londeg
3734 0 : else if ((this%block_indexed) .or. unstructured) then
3735 0 : call this%map%coord_dests(mapind, lonind, latind)
3736 0 : if (latind == 0) then
3737 0 : latind = lonind
3738 : end if
3739 0 : if (associated(patch%latmap)) then
3740 0 : patch%latmap(mapind) = latind
3741 : end if
3742 0 : if (associated(patch%lonmap)) then
3743 0 : patch%lonmap(mapind) = lonind
3744 : end if
3745 : else
3746 0 : call this%map%coord_vals(mapind, lonind, latind)
3747 0 : if (associated(patch%latmap)) then
3748 0 : patch%latmap(latind) = latind
3749 : end if
3750 0 : if (associated(patch%lonmap)) then
3751 0 : patch%lonmap(lonind) = lonind
3752 : end if
3753 : end if
3754 : ! else do nothing, we already found this point
3755 : end if
3756 : else
3757 0 : call endrun(subname//': PE has patch points but mask too small')
3758 : end if
3759 : end if
3760 : end if ! findClosest
3761 : end if ! isMapped
3762 : end do
3763 0 : if (findClosest) then
3764 : ! We need to find the minimum mindist and use only that value
3765 0 : dist = mindist
3766 0 : call MPI_allreduce(dist, mindist, 1, mpi_real8, mpi_min, mpicom, ierr)
3767 : ! Special case for pole points
3768 0 : if (latdeg_min > 90.0_r8) then
3769 0 : temp1 = 0.0_r8
3770 : else
3771 0 : temp1 = abs(latdeg_min*deg2rad)
3772 : end if
3773 0 : call MPI_allreduce(temp1, lat, 1, mpi_real8, mpi_max, mpicom, ierr)
3774 0 : if ((abs(latmin) > maxlat) .or. (lat > maxlat)) then
3775 0 : if (dist == mindist) then
3776 : ! Only distance winners can compete
3777 0 : lon = abs(londeg_min - lonl)
3778 : else
3779 0 : lon = 361.0_r8
3780 : end if
3781 0 : call MPI_allreduce(lon, minlondist, 1, mpi_real8, mpi_min, mpicom, ierr)
3782 : ! Kill the losers
3783 0 : if (lon /= minlondist) then
3784 0 : dist = dist + 1.0_r8
3785 : end if
3786 : end if
3787 : ! Now, only task(s) which have real minimum distance should set their mask
3788 : ! minind test allows for no match
3789 0 : if (dist == mindist) then
3790 0 : if (minind < 0) then
3791 0 : call endrun("cam_grid_get_patch_mask: No closest point found!!")
3792 : else
3793 0 : if (patch%mask%num_elem() >= minind) then
3794 0 : if (.not. patch%mask%is_mapped(minind)) then
3795 0 : call patch%mask%copy_elem(this%map, minind)
3796 0 : patch%num_points = patch%num_points + 1
3797 0 : if (cco) then
3798 0 : if (patch%num_points > size(patch%latvals, 1)) then
3799 0 : call endrun(subname//': Number of columns larger than mask!?')
3800 : end if
3801 0 : call this%map%coord_dests(minind, lonind, latind)
3802 0 : if (latind > 0) then
3803 : ! Grid is structured, get unique index
3804 0 : lonind = lonind + (latind * dims(1))
3805 : end if
3806 0 : patch%latmap(patch%num_points) = lonind
3807 0 : patch%latvals(patch%num_points) = latdeg_min
3808 0 : patch%lonmap(patch%num_points) = lonind
3809 0 : patch%lonvals(patch%num_points) = londeg_min
3810 0 : else if ((this%block_indexed) .or. unstructured) then
3811 0 : call this%map%coord_dests(minind, lonind, latind)
3812 0 : if (latind == 0) then
3813 0 : latind = lonind
3814 : end if
3815 0 : if (associated(patch%latmap)) then
3816 0 : patch%latmap(minind) = latind
3817 : end if
3818 0 : if (associated(patch%lonmap)) then
3819 0 : patch%lonmap(minind) = lonind
3820 : end if
3821 : else
3822 0 : call this%map%coord_vals(minind, lonind, latind)
3823 0 : if (associated(patch%latmap)) then
3824 0 : patch%latmap(latind) = latind
3825 : end if
3826 0 : if (associated(patch%lonmap)) then
3827 0 : patch%lonmap(lonind) = lonind
3828 : end if
3829 : end if
3830 : ! else do nothing, we already found this point
3831 : end if
3832 : else
3833 0 : call endrun(subname//': PE has patch closest point but mask too small')
3834 : end if
3835 : end if
3836 : end if
3837 : end if ! findClosest
3838 :
3839 0 : end subroutine cam_grid_get_patch_mask
3840 :
3841 : !---------------------------------------------------------------------------
3842 : !
3843 : ! Grid Patch functions
3844 : !
3845 : !---------------------------------------------------------------------------
3846 :
3847 0 : integer function cam_grid_patch_get_id(this) result(id)
3848 :
3849 : ! Dummy argument
3850 : class(cam_grid_patch_t) :: this
3851 :
3852 0 : id = this%grid_id
3853 0 : end function cam_grid_patch_get_id
3854 :
3855 0 : subroutine cam_grid_patch_get_global_size_map(this, gsize)
3856 :
3857 : ! Dummy arguments
3858 : class(cam_grid_patch_t), intent(in) :: this
3859 : integer, intent(out) :: gsize
3860 :
3861 0 : gsize = this%global_size
3862 :
3863 0 : end subroutine cam_grid_patch_get_global_size_map
3864 :
3865 0 : subroutine cam_grid_patch_get_global_size_axes(this, latsize, lonsize)
3866 :
3867 : ! Dummy arguments
3868 : class(cam_grid_patch_t), intent(in) :: this
3869 : integer, intent(out) :: latsize
3870 : integer, intent(out) :: lonsize
3871 :
3872 0 : latsize = this%global_lat_size
3873 0 : lonsize = this%global_lon_size
3874 :
3875 0 : end subroutine cam_grid_patch_get_global_size_axes
3876 :
3877 : ! cam_grid_patch_get_axis_names
3878 : ! Collect or compute unique names for the latitude and longitude axes
3879 : ! If the grid is unstructured or col_output is .true., the column
3880 : ! dimension name is also generated (e.g., ncol)
3881 0 : subroutine cam_grid_patch_get_axis_names(this, lat_name, lon_name, &
3882 : col_name, col_output)
3883 :
3884 : ! Dummy arguments
3885 : class(cam_grid_patch_t) :: this
3886 : character(len=*), intent(out) :: lat_name
3887 : character(len=*), intent(out) :: lon_name
3888 : character(len=*), intent(out) :: col_name
3889 : logical, intent(in) :: col_output
3890 :
3891 : ! Local variable
3892 : integer :: index
3893 : character(len=120) :: errormsg
3894 : character(len=max_hcoordname_len) :: grid_name
3895 : logical :: unstruct
3896 :
3897 0 : if (cam_grid_check(this%grid_id)) then
3898 0 : index = this%grid_index()
3899 0 : unstruct = cam_grids(index)%is_unstructured()
3900 : ! Get coordinate and dim names
3901 0 : call cam_grids(index)%lat_coord%get_coord_name(lat_name)
3902 0 : call cam_grids(index)%lon_coord%get_coord_name(lon_name)
3903 0 : grid_name = cam_grids(index)%name
3904 0 : if (col_output .or. unstruct) then
3905 : ! In this case, we are using collect_column_output on a lat/lon grid
3906 0 : col_name = 'ncol_'//trim(grid_name)
3907 0 : lat_name = trim(lat_name)//'_'//trim(grid_name)
3908 0 : lon_name = trim(lon_name)//'_'//trim(grid_name)
3909 : else
3910 : ! Separate patch output for a lat/lon grid
3911 0 : col_name = ''
3912 0 : lat_name = trim(lat_name)//'_'//trim(grid_name)
3913 0 : lon_name = trim(lon_name)//'_'//trim(grid_name)
3914 : end if
3915 : else
3916 0 : write(errormsg, *) 'Bad grid ID:', this%grid_id
3917 0 : call endrun('cam_grid_patch_get_axis_names: '//errormsg)
3918 : end if
3919 :
3920 0 : end subroutine cam_grid_patch_get_axis_names
3921 :
3922 0 : subroutine cam_grid_patch_get_coord_long_name(this, axis, name)
3923 :
3924 : ! Dummy arguments
3925 : class(cam_grid_patch_t) :: this
3926 : character(len=*), intent(in) :: axis
3927 : character(len=*), intent(out) :: name
3928 :
3929 : ! Local variable
3930 : character(len=120) :: errormsg
3931 : integer :: index
3932 :
3933 0 : if (cam_grid_check(this%grid_id)) then
3934 0 : index = this%grid_index()
3935 0 : if (trim(axis) == 'lat') then
3936 0 : call cam_grids(index)%lat_coord%get_long_name(name)
3937 0 : else if (trim(axis) == 'lon') then
3938 0 : call cam_grids(index)%lon_coord%get_long_name(name)
3939 : else
3940 0 : write(errormsg, *) 'Bad axis name:', axis
3941 0 : call endrun('cam_grid_patch_get_coord_long_name: '//errormsg)
3942 : end if
3943 : else
3944 0 : write(errormsg, *) 'Bad grid ID:', this%grid_id
3945 0 : call endrun('cam_grid_patch_get_coord_long_name: '//errormsg)
3946 : end if
3947 :
3948 0 : end subroutine cam_grid_patch_get_coord_long_name
3949 :
3950 0 : subroutine cam_grid_patch_get_coord_units(this, axis, units)
3951 :
3952 : ! Dummy arguments
3953 : class(cam_grid_patch_t) :: this
3954 : character(len=*), intent(in) :: axis
3955 : character(len=*), intent(out) :: units
3956 :
3957 : ! Local variable
3958 : character(len=120) :: errormsg
3959 : integer :: index
3960 :
3961 0 : if (cam_grid_check(this%grid_id)) then
3962 0 : index = this%grid_index()
3963 0 : if (trim(axis) == 'lat') then
3964 0 : call cam_grids(index)%lat_coord%get_units(units)
3965 0 : else if (trim(axis) == 'lon') then
3966 0 : call cam_grids(index)%lon_coord%get_units(units)
3967 : else
3968 0 : write(errormsg, *) 'Bad axis name:', axis
3969 0 : call endrun('cam_grid_patch_get_coord_units: '//errormsg)
3970 : end if
3971 : else
3972 0 : write(errormsg, *) 'Bad grid ID:', this%grid_id
3973 0 : call endrun('cam_grid_patch_get_coord_units: '//errormsg)
3974 : end if
3975 :
3976 0 : end subroutine cam_grid_patch_get_coord_units
3977 :
3978 0 : subroutine cam_grid_patch_set_patch(this, lonl, lonu, latl, latu, cco, id, map)
3979 :
3980 : ! Dummy arguments
3981 : class(cam_grid_patch_t) :: this
3982 : real(r8), intent(in) :: lonl, lonu ! Longitude bounds
3983 : real(r8), intent(in) :: latl, latu ! Latitude bounds
3984 : logical, intent(in) :: cco ! Collect columns?
3985 : integer, intent(in) :: id
3986 : type(cam_filemap_t), intent(in) :: map
3987 :
3988 0 : this%grid_id = id
3989 0 : this%lon_range(1) = lonl
3990 0 : this%lon_range(2) = lonu
3991 0 : this%lat_range(1) = latl
3992 0 : this%lat_range(2) = latu
3993 0 : this%collected_columns = cco
3994 0 : if (.not. associated(this%mask)) then
3995 0 : allocate(this%mask)
3996 : end if
3997 0 : call this%mask%copy(map)
3998 0 : call this%mask%new_index()
3999 :
4000 0 : end subroutine cam_grid_patch_set_patch
4001 :
4002 0 : subroutine cam_grid_patch_get_decomp(this, field_lens, file_lens, dtype, &
4003 0 : iodesc, file_dest_in)
4004 : use pio, only: io_desc_t
4005 : use cam_pio_utils, only: cam_pio_get_decomp
4006 :
4007 : ! Dummy arguments
4008 : class(cam_grid_patch_t) :: this
4009 : integer, intent(in) :: field_lens(:)
4010 : integer, intent(in) :: file_lens(:)
4011 : integer, intent(in) :: dtype
4012 : type(io_desc_t), pointer, intent(out) :: iodesc
4013 : integer, optional, intent(in) :: file_dest_in(:)
4014 :
4015 : call cam_pio_get_decomp(iodesc, field_lens, file_lens, dtype, this%mask, &
4016 0 : file_dist_in=file_dest_in)
4017 :
4018 0 : end subroutine cam_grid_patch_get_decomp
4019 :
4020 0 : subroutine cam_grid_patch_compact(this, collected_output)
4021 :
4022 : ! Dummy arguments
4023 : class(cam_grid_patch_t) :: this
4024 : logical, optional, intent(in) :: collected_output
4025 :
4026 : ! Local variables
4027 : integer :: index ! Our grid's index
4028 : logical :: dups_ok
4029 :
4030 0 : index = this%grid_index()
4031 0 : if (index > 0) then
4032 0 : dups_ok = cam_grids(index)%is_unstructured()
4033 : else
4034 : ! This is probably an error condition but someone else will catch it first
4035 0 : dups_ok = .false.
4036 : end if
4037 0 : if (present(collected_output)) then
4038 0 : dups_ok = dups_ok .or. collected_output
4039 : end if
4040 : call this%mask%compact(this%lonmap, this%latmap, &
4041 : num_lons=this%global_lon_size, num_lats=this%global_lat_size, &
4042 : num_mapped=this%global_size, columnize=collected_output, &
4043 0 : dups_ok_in=dups_ok)
4044 :
4045 0 : end subroutine cam_grid_patch_compact
4046 :
4047 0 : subroutine cam_grid_patch_get_active_cols(this, lchnk, active, srcdim_in)
4048 :
4049 : ! Dummy arguments
4050 : class(cam_grid_patch_t) :: this
4051 : integer, intent(in) :: lchnk
4052 : logical, intent(out) :: active(:)
4053 : integer, optional, intent(in) :: srcdim_in
4054 :
4055 0 : if (.not. associated(this%mask)) then
4056 0 : call endrun('cam_grid_patch_get_active_cols: No mask')
4057 : else
4058 0 : call this%mask%active_cols(lchnk, active, srcdim_in)
4059 : end if
4060 :
4061 0 : end subroutine cam_grid_patch_get_active_cols
4062 :
4063 : ! cam_grid_patch_write_vals: Write lat and lon coord values to File
4064 0 : subroutine cam_grid_patch_write_vals(this, File, header_info)
4065 : use pio, only: file_desc_t, io_desc_t
4066 : use pio, only: pio_write_darray, PIO_DOUBLE
4067 : use pio, only: pio_initdecomp, pio_freedecomp
4068 : use cam_pio_utils, only: cam_pio_handle_error, pio_subsystem
4069 :
4070 : ! Dummy arguments
4071 : class(cam_grid_patch_t) :: this
4072 : type(file_desc_t), intent(inout) :: File ! PIO file handle
4073 : type(cam_grid_header_info_t), intent(inout) :: header_info
4074 :
4075 : ! Local variables
4076 : type(io_desc_t) :: iodesc
4077 : type(var_desc_t), pointer :: vdesc
4078 0 : real(r8), pointer :: coord_p(:)
4079 0 : real(r8), pointer :: coord(:)
4080 0 : integer(iMap), pointer :: map(:)
4081 : integer :: field_lens(1)
4082 : integer :: file_lens(1)
4083 : integer :: ierr
4084 :
4085 0 : nullify(vdesc)
4086 0 : nullify(coord_p)
4087 0 : nullify(coord)
4088 0 : nullify(map)
4089 0 : if (this%grid_id /= header_info%get_gridid()) then
4090 0 : call endrun('CAM_GRID_PATCH_WRITE_VALS: Grid id mismatch')
4091 : end if
4092 : ! Write out lon
4093 0 : if (associated(this%lonmap)) then
4094 0 : field_lens(1) = size(this%lonmap, 1)
4095 0 : map => this%lonmap
4096 : else
4097 0 : field_lens(1) = 0
4098 0 : allocate(map(0))
4099 : end if
4100 0 : file_lens(1) = this%global_lon_size
4101 : !! XXgoldyXX: Think about caching these decomps
4102 0 : call pio_initdecomp(pio_subsystem, pio_double, file_lens, map, iodesc)
4103 0 : if (associated(this%lonvals)) then
4104 0 : coord => this%lonvals
4105 : else
4106 0 : coord_p => cam_grid_get_lonvals(this%grid_id)
4107 0 : if (associated(coord_p)) then
4108 0 : coord => coord_p
4109 : else
4110 0 : allocate(coord(0))
4111 : end if
4112 : end if
4113 0 : vdesc => header_info%get_lon_varid()
4114 0 : call pio_write_darray(File, vdesc, iodesc, coord, ierr)
4115 0 : call cam_pio_handle_error(ierr, 'cam_grid_patch_write_vals: Error writing longitude')
4116 0 : if (.not. associated(this%lonmap)) then
4117 0 : deallocate(map)
4118 : nullify(map)
4119 : end if
4120 0 : if (.not. (associated(coord_p) .or. associated(this%lonvals))) then
4121 0 : deallocate(coord)
4122 : nullify(coord)
4123 : end if
4124 0 : call pio_freedecomp(File, iodesc)
4125 : ! Write out lat
4126 0 : if (associated(this%latmap)) then
4127 0 : field_lens(1) = size(this%latmap, 1)
4128 0 : map => this%latmap
4129 : else
4130 0 : field_lens(1) = 0
4131 0 : allocate(map(0))
4132 : end if
4133 0 : file_lens(1) = this%global_lat_size
4134 : !! XXgoldyXX: Think about caching these decomps
4135 0 : call pio_initdecomp(pio_subsystem, pio_double, file_lens, map, iodesc)
4136 :
4137 0 : if (associated(this%latvals)) then
4138 0 : coord => this%latvals
4139 : else
4140 0 : coord_p => cam_grid_get_latvals(this%grid_id)
4141 0 : if (associated(coord_p)) then
4142 0 : coord => coord_p
4143 : else
4144 0 : allocate(coord(0))
4145 : end if
4146 : end if
4147 0 : vdesc => header_info%get_lat_varid()
4148 0 : call pio_write_darray(File, vdesc, iodesc, coord, ierr)
4149 0 : call cam_pio_handle_error(ierr, 'cam_grid_patch_write_vals: Error writing latitude')
4150 0 : if (.not. associated(this%latmap)) then
4151 0 : deallocate(map)
4152 : nullify(map)
4153 : end if
4154 0 : if (.not. (associated(coord_p) .or. associated(this%latvals))) then
4155 0 : deallocate(coord)
4156 : nullify(coord)
4157 : end if
4158 0 : call pio_freedecomp(File, iodesc)
4159 :
4160 0 : end subroutine cam_grid_patch_write_vals
4161 :
4162 0 : integer function cam_grid_patch_get_grid_index(this) result(index)
4163 : ! Dummy argument
4164 : class(cam_grid_patch_t) :: this
4165 :
4166 : ! Local variable
4167 : integer :: i
4168 :
4169 0 : index = -1
4170 : ! Find the grid index associated with our grid_id which is a decomp
4171 0 : do i = 1, cam_grid_num_grids()
4172 0 : if (cam_grids(i)%id == this%grid_id) then
4173 : index = i
4174 : exit
4175 : end if
4176 : end do
4177 :
4178 0 : end function cam_grid_patch_get_grid_index
4179 :
4180 0 : subroutine cam_grid_patch_deallocate(this)
4181 : ! Dummy argument
4182 : class(cam_grid_patch_t) :: this
4183 :
4184 0 : if (associated(this%mask)) then
4185 0 : deallocate(this%mask)
4186 0 : nullify(this%mask)
4187 : end if
4188 :
4189 0 : end subroutine cam_grid_patch_deallocate
4190 :
4191 1907712 : integer function cam_grid_header_info_get_gridid(this) result(id)
4192 : ! Dummy argument
4193 : class(cam_grid_header_info_t) :: this
4194 :
4195 1907712 : id = this%grid_id
4196 :
4197 1907712 : end function cam_grid_header_info_get_gridid
4198 :
4199 0 : subroutine cam_grid_header_info_set_gridid(this, id)
4200 : ! Dummy argument
4201 : class(cam_grid_header_info_t) :: this
4202 : integer, intent(in) :: id
4203 :
4204 0 : this%grid_id = id
4205 :
4206 0 : end subroutine cam_grid_header_info_set_gridid
4207 :
4208 0 : subroutine cam_grid_header_info_set_hdims(this, hdim1, hdim2)
4209 : ! Dummy arguments
4210 : class(cam_grid_header_info_t) :: this
4211 : integer, intent(in) :: hdim1
4212 : integer, optional, intent(in) :: hdim2
4213 :
4214 : ! Local variables
4215 : integer :: hdsize
4216 :
4217 0 : if (present(hdim2)) then
4218 : hdsize = 2
4219 : else
4220 0 : hdsize = 1
4221 : end if
4222 :
4223 0 : if (allocated(this%hdims)) then
4224 : ! This can happen, for instance on opening a new version of the file
4225 0 : if (size(this%hdims) /= hdsize) then
4226 0 : call endrun('cam_grid_header_info_set_hdims: hdims is wrong size')
4227 : end if
4228 : else
4229 0 : allocate(this%hdims(hdsize))
4230 : end if
4231 0 : this%hdims(1) = hdim1
4232 0 : if (present(hdim2)) then
4233 0 : this%hdims(2) = hdim2
4234 : end if
4235 :
4236 0 : end subroutine cam_grid_header_info_set_hdims
4237 :
4238 1909248 : integer function cam_grid_header_info_num_hdims(this) result(num)
4239 : ! Dummy argument
4240 : class(cam_grid_header_info_t) :: this
4241 :
4242 1909248 : if (allocated(this%hdims)) then
4243 1909248 : num = size(this%hdims)
4244 : else
4245 : num = 0
4246 : end if
4247 :
4248 1909248 : end function cam_grid_header_info_num_hdims
4249 :
4250 1910784 : integer function cam_grid_header_info_hdim(this, index) result(id)
4251 : ! Dummy arguments
4252 : class(cam_grid_header_info_t) :: this
4253 : integer, intent(in) :: index
4254 :
4255 : ! Local variable
4256 : character(len=120) :: errormsg
4257 :
4258 1910784 : if (allocated(this%hdims)) then
4259 1910784 : if ((index >= 1) .and. (index <= size(this%hdims))) then
4260 1910784 : id = this%hdims(index)
4261 : else
4262 0 : write(errormsg, '(a,i0,a)') 'Index out of range, (',index,')'
4263 0 : call endrun('cam_grid_header_info_hdim: '//errormsg)
4264 : end if
4265 : else
4266 0 : write(errormsg, '(a)') 'No hdims allocated'
4267 0 : call endrun('cam_grid_header_info_hdim: '//errormsg)
4268 : end if
4269 :
4270 1910784 : end function cam_grid_header_info_hdim
4271 :
4272 0 : subroutine cam_grid_header_info_set_varids(this, lon_varid, lat_varid)
4273 :
4274 : ! Dummy arguments
4275 : class(cam_grid_header_info_t) :: this
4276 : type(var_desc_t), pointer :: lon_varid
4277 : type(var_desc_t), pointer :: lat_varid
4278 :
4279 0 : if (associated(this%lon_varid)) then
4280 0 : deallocate(this%lon_varid)
4281 0 : nullify(this%lon_varid)
4282 : end if
4283 0 : this%lon_varid => lon_varid
4284 0 : if (associated(this%lat_varid)) then
4285 0 : deallocate(this%lat_varid)
4286 0 : nullify(this%lat_varid)
4287 : end if
4288 0 : this%lat_varid => lat_varid
4289 :
4290 0 : end subroutine cam_grid_header_info_set_varids
4291 :
4292 0 : function cam_grid_header_info_lon_varid(this) result(id)
4293 :
4294 : ! Dummy arguments
4295 : class(cam_grid_header_info_t) :: this
4296 : type(var_desc_t), pointer :: id
4297 :
4298 0 : id => this%lon_varid
4299 :
4300 0 : end function cam_grid_header_info_lon_varid
4301 :
4302 0 : function cam_grid_header_info_lat_varid(this) result(id)
4303 :
4304 : ! Dummy arguments
4305 : class(cam_grid_header_info_t) :: this
4306 : type(var_desc_t), pointer :: id
4307 :
4308 0 : id => this%lat_varid
4309 :
4310 0 : end function cam_grid_header_info_lat_varid
4311 :
4312 4608 : subroutine cam_grid_header_info_deallocate(this)
4313 : ! Dummy argument
4314 : class(cam_grid_header_info_t) :: this
4315 :
4316 4608 : this%grid_id = -1
4317 4608 : if (allocated(this%hdims)) then
4318 4608 : deallocate(this%hdims)
4319 : end if
4320 4608 : if (associated(this%lon_varid)) then
4321 0 : deallocate(this%lon_varid)
4322 0 : nullify(this%lon_varid)
4323 : end if
4324 4608 : if (associated(this%lat_varid)) then
4325 0 : deallocate(this%lat_varid)
4326 0 : nullify(this%lat_varid)
4327 : end if
4328 :
4329 4608 : end subroutine cam_grid_header_info_deallocate
4330 :
4331 0 : end module cam_grid_support
|
