LCOV - code coverage report
Current view: | top level - utils - cam_grid_support.F90 (source / functions) |  |  | Hit | Total | Coverage
Test: | coverage.info |  | Lines: | 588 | 1429 | 41.1 %
Date: | 2024-12-17 22:39:59 |  | Functions: | 73 | 141 | 51.8 %

              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      819456 :   subroutine horiz_coord_len(this, clen)
         406             :     ! Dummy arguments
         407             :     class(horiz_coord_t), intent(in)    :: this
         408             :     integer,              intent(out)   :: clen
         409             :
         410      819456 :     clen = this%dimsize
         411      819456 :   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     2446848 :   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     2446848 :     if (len_trim(this%dimname) > 0) then
         430             :       ! We have a separate dimension name (e.g., ncol)
         431     2446848 :       if (len(dimname) < len_trim(this%dimname)) then
         432           0 :         call endrun('horiz_coord_dimname: input name too short')
         433             :       end if
         434     2446848 :       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     2446848 :   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      497664 :   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      497664 :     call pio_seterrorhandling(File, PIO_BCAST_ERROR,err_handling)
         576             :
         577      497664 :     if (present(file_index)) then
         578      497664 :        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      497664 :     call this%get_dim_name(dimname)
         585             :     call cam_pio_def_dim(File, trim(dimname), this%dimsize, dimid,       &
         586      497664 :          existOK=.true.)
         587             :     ! Should we define the variable?
         588      497664 :     ierr = pio_inq_varid(File, trim(this%name), vardesc)
         589      497664 :     if (ierr /= PIO_NOERR) then
         590             :       ! Variable not already defined, it is up to us to define the variable
         591      497664 :       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      497664 :       allocate(this%vardesc(file_index_loc)%p)
         596             :       call cam_pio_def_var(File, trim(this%name), pio_double,                 &
         597      995328 :            (/ dimid /), this%vardesc(file_index_loc)%p, existOK=.false.)
         598             :       ! long_name
         599      497664 :       ierr=pio_put_att(File, this%vardesc(file_index_loc)%p, 'long_name', trim(this%long_name))
         600      497664 :       call cam_pio_handle_error(ierr, 'Error writing "long_name" attr in write_horiz_coord_attr')
         601             :       ! units
         602      497664 :       ierr=pio_put_att(File, this%vardesc(file_index_loc)%p, 'units', trim(this%units))
         603      497664 :       call cam_pio_handle_error(ierr, 'Error writing "units" attr in write_horiz_coord_attr')
         604             :       ! Take care of bounds if they exist
         605      497664 :       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      497664 :     if (present(dimid_out)) then
         623      497664 :       dimid_out = dimid
         624             :     end if
         625             :
         626             :     ! Back to old error handling
         627      497664 :     call pio_seterrorhandling(File, err_handling)
         628             :
         629      497664 :   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      497664 :   subroutine write_horiz_coord_var(this, File, file_index)
         640      497664 :     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      497664 :     if (present(file_index)) then
         669      491520 :        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      497664 :     if (associated(this%vardesc(file_index_loc)%p)) then
         676             :       ! We will handle errors for this routine
         677      497664 :        call pio_seterrorhandling(File, PIO_BCAST_ERROR,err_handling)
         678             :
         679             :       ! Write out the values for this dimension variable
         680      497664 :       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      497664 :         piosys => shr_pio_getiosys(atm_id)
         692             :         call pio_initdecomp(piosys, pio_double, (/this%dimsize/), this%map,   &
         693      995328 :              iodesc)
         694      497664 :         call pio_write_darray(File, this%vardesc(file_index_loc)%p, iodesc, this%values, ierr)
         695             :
         696      497664 :         call pio_syncfile(File)
         697      497664 :         call pio_freedecomp(File, iodesc)
         698             :         ! Take care of bounds if they exist
         699      497664 :         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      497664 :       write(errormsg, *) 'Error writing variable values for ',trim(this%name),&
         717      995328 :            ' in write_horiz_coord_var'
         718      497664 :       call cam_pio_handle_error(ierr, errormsg)
         719             :
         720             :       ! Back to old error handling
         721      497664 :       call pio_seterrorhandling(File, err_handling)
         722             :
         723             :       ! We are done with this variable descriptor, reset for next file
         724      497664 :       deallocate(this%vardesc(file_index_loc)%p)
         725      497664 :       nullify(this%vardesc(file_index_loc)%p)
         726             :       ! Same with the bounds descriptor
         727      497664 :       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      497664 :   end subroutine write_horiz_coord_var
         734             :
         735             : !!#######################################################################
         736             : !!
         737             : !! CAM grid functions
         738             : !!
         739             : !!#######################################################################
         740             :
         741  5217000264 :   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  5217000264 :     get_cam_grid_index_char = -1
         748 23469857856 :     do i = 1, registeredhgrids
         749 23469857856 :       if(trim(gridname) == trim(cam_grids(i)%name)) then
         750  5216993352 :         get_cam_grid_index_char = i
         751  5216993352 :         exit
         752             :       end if
         753             :     end do
         754             :
         755      497664 :   end function get_cam_grid_index_char
         756             :
         757  1245355104 :   integer function get_cam_grid_index_int(gridid)
         758             :     ! Dummy arguments
         759             :     integer, intent(in) :: gridid
         760             :     ! Local variables
         761             :     integer :: i
         762             :
         763  1245355104 :     get_cam_grid_index_int = -1
         764  5600175648 :     do i = 1, registeredhgrids
         765  5600175648 :       if(gridid == cam_grids(i)%id) then
         766             :         get_cam_grid_index_int = i
         767             :         exit
         768             :       end if
         769             :     end do
         770             :
         771  1245355104 :   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      461568 :   integer function cam_grid_num_grids()
         959      461568 :     cam_grid_num_grids = registeredhgrids
         960      461568 :   end function cam_grid_num_grids
         961             :
         962             :   ! Return .true. iff id represents a valid CAM grid
         963      455424 :   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      455424 :          (get_cam_grid_index(id) <= cam_grid_num_grids()))
         969      455424 :   end function cam_grid_check
         970             :
         971  5216960328 :   integer function cam_grid_id(name)
         972             :     ! Dummy argument
         973             :     character(len=*),   intent(in)    :: name
         974             :
         975             :     ! Local variable
         976             :     integer                           :: index
         977             :
         978  5216960328 :     index = get_cam_grid_index(name)
         979  5216960328 :     if (index > 0) then
         980  5216960328 :       cam_grid_id = cam_grids(index)%id
         981             :     else
         982             :       cam_grid_id = -1
         983             :     end if
         984             :
         985  5216960328 :   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      269568 :   subroutine cam_grid_get_decomp(id, field_lens, file_lens, dtype, iodesc,    &
        1038      269568 :        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      269568 :     gridid = get_cam_grid_index(id)
        1055      269568 :     if (gridid > 0) then
        1056           0 :       call cam_grids(gridid)%get_decomp(field_lens, file_lens, dtype, iodesc, &
        1057      566016 :            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      269568 :   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       19200 :   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       19200 :     gridid = get_cam_grid_index(id)
        1152       19200 :     if (gridid > 0) then
        1153       19200 :       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       19200 :   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       38400 :   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       38400 :     gridid = get_cam_grid_index(id)
        1344       38400 :     if (gridid > 0) then
        1345       38400 :       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       38400 :   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    25804800 :   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    25804800 :     gridid = get_cam_grid_index(id)
        1408    25804800 :     if (gridid > 0) then
        1409    25804800 :       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    25804800 :   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    16957440 :   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    16957440 :     gridid = get_cam_grid_index(id)
        1440    16957440 :     if (gridid > 0) then
        1441    16957440 :       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    16957440 :   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     5177088 :   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     5177088 :     gridid = get_cam_grid_index(id)
        1483     5177088 :     if (gridid > 0) then
        1484     5177088 :       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     5177088 :         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     5177088 :   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  1184517216 :   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  1184517216 :     gridid = get_cam_grid_index(id)
        1592  1184517216 :     if (gridid > 0) then
        1593  1184517216 :       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  1184517216 :         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  1184517216 :   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('EUL')
        1662           0 :           wtname='gw'
        1663             :        case('FV')
        1664           0 :           wtname='gw'
        1665             :        case('INI')
        1666           0 :           wtname='area_weight_ini'
        1667             :        case('physgrid')
        1668           0 :           wtname='areawt'
        1669             :        case('FVM')
        1670           0 :           wtname='area_weight_fvm'
        1671             :        case('mpas_cell')
        1672           0 :           wtname='area_weight_mpas'
        1673             :        case default
        1674           0 :           call endrun('cam_grid_get_areawt: Invalid gridname:'//trim(cam_grids(gridind)%name))
        1675             :        end select
        1676             :
        1677           0 :        call find_cam_grid_attr(gridind, trim(wtname), attrptr)
        1678           0 :        if (.not.associated(attrptr)) then
        1679             :           write(errormsg, '(4a)')                                               &
        1680           0 :                'cam_grid_get_areawt: error retrieving weight attribute ', trim(wtname),         &
        1681           0 :                ' for cam grid ', cam_grids(gridind)%name
        1682           0 :           call endrun(errormsg)
        1683             :        else
        1684           0 :           call attrptr%print_attr()
        1685             :           select type(attrptr)
        1686             :           type is (cam_grid_attribute_1d_r8_t)
        1687           0 :              wtvals => attrptr%values
        1688             :           class default
        1689           0 :              call endrun('cam_grid_get_areawt: wt attribute is not a real datatype')
        1690             :           end select
        1691             :        end if
        1692             :     end if
        1693             :
        1694           0 :   end function cam_grid_get_areawt
        1695             :
        1696             :   ! Find the longitude and latitude of a range of map entries
        1697             :   ! beg and end are the range of the first source index. blk is a block or chunk index
        1698           0 :   subroutine cam_grid_get_coords(id, beg, end, blk, lon, lat)
        1699             :
        1700             :     ! Dummy arguments
        1701             :     integer,               intent(in)    :: id
        1702             :     integer,               intent(in)    :: beg
        1703             :     integer,               intent(in)    :: end
        1704             :     integer,               intent(in)    :: blk
        1705             :     real(r8),              intent(inout) :: lon(:)
        1706             :     real(r8),              intent(inout) :: lat(:)
        1707             :
        1708             :     ! Local variables
        1709             :     integer                              :: gridid
        1710             :     integer                              :: i
        1711           0 :     gridid = get_cam_grid_index(id)
        1712           0 :     if (gridid > 0) then
        1713           0 :       do i = beg, end
        1714           0 :         if (cam_grids(gridid)%is_unstructured()) then
        1715           0 :           call endrun('cam_grid_get_coords: Not implemented')
        1716             :         else
        1717           0 :           call endrun('cam_grid_get_coords: Not implemented')
        1718             :         end if
        1719             :       end do
        1720             :     else
        1721           0 :       call endrun('cam_grid_get_coords: Bad grid ID')
        1722             :     end if
        1723           0 :   end subroutine cam_grid_get_coords
        1724             :
        1725           0 :   logical function cam_grid_is_unstructured(id) result(unstruct)
        1726             :
        1727             :     ! Dummy arguments
        1728             :     integer,                  intent(in) :: id
        1729             :
        1730             :     ! Local variables
        1731             :     integer                              :: gridid
        1732           0 :     gridid = get_cam_grid_index(id)
        1733           0 :     if (gridid > 0) then
        1734           0 :       unstruct = cam_grids(gridid)%is_unstructured()
        1735             :     else
        1736           0 :       call endrun('cam_grid_is_unstructured: Bad grid ID')
        1737             :     end if
        1738           0 :   end function cam_grid_is_unstructured
        1739             :
        1740     5177088 :   logical function cam_grid_is_block_indexed(id) result(block_indexed)
        1741             :
        1742             :     ! Dummy arguments
        1743             :     integer,                  intent(in) :: id
        1744             :
        1745             :     ! Local variables
        1746             :     integer                              :: gridid
        1747     5177088 :     gridid = get_cam_grid_index(id)
        1748     5177088 :     if (gridid > 0) then
        1749     5177088 :       block_indexed = cam_grids(gridid)%is_block_indexed()
        1750             :     else
        1751           0 :       call endrun('s: Bad grid ID')
        1752             :     end if
        1753     5177088 :   end function cam_grid_is_block_indexed
        1754             :
        1755     5177088 :   logical function cam_grid_is_zonal(id) result(zonal)
        1756             :
        1757             :     ! Dummy arguments
        1758             :     integer,                  intent(in) :: id
        1759             :
        1760             :     ! Local variables
        1761             :     integer                              :: gridid
        1762     5177088 :     gridid = get_cam_grid_index(id)
        1763     5177088 :     if (gridid > 0) then
        1764     5177088 :       zonal = cam_grids(gridid)%is_zonal_grid()
        1765             :     else
        1766           0 :       call endrun('s: Bad grid ID')
        1767             :     end if
        1768     5177088 :   end function cam_grid_is_zonal
        1769             :
        1770             :   ! Compute or update a grid patch mask
        1771           0 :   subroutine cam_grid_compute_patch(id, patch, lonl, lonu, latl, latu, cco)
        1772             :
        1773             :     ! Dummy arguments
        1774             :     integer,                         intent(in)    :: id
        1775             :     type(cam_grid_patch_t),          intent(inout) :: patch
        1776             :     real(r8),                        intent(in)    :: lonl
        1777             :     real(r8),                        intent(in)    :: lonu
        1778             :     real(r8),                        intent(in)    :: latl
        1779             :     real(r8),                        intent(in)    :: latu
        1780             :     logical,                         intent(in)    :: cco ! Collect columns?
        1781             :
        1782             :     ! Local variables
        1783             :     integer                                        :: gridid
        1784             :
        1785           0 :     gridid = get_cam_grid_index(id)
        1786           0 :     if (gridid > 0) then
        1787           0 :       call cam_grids(gridid)%get_patch_mask(lonl, lonu, latl, latu, patch, cco)
        1788             :     else
        1789           0 :       call endrun('cam_grid_compute_patch: Bad grid ID')
        1790             :     end if
        1791             :
        1792           0 :   end subroutine cam_grid_compute_patch
        1793             :
        1794             : !!#######################################################################
        1795             : !!
        1796             : !! CAM grid attribute functions
        1797             : !!
        1798             : !!#######################################################################
        1799             :
        1800           0 :   subroutine cam_grid_attr_init(this, name, long_name, next)
        1801             :     ! Dummy arguments
        1802             :     class(cam_grid_attribute_t)                        :: this
        1803             :     character(len=*),                    intent(in)    :: name
        1804             :     character(len=*),                    intent(in)    :: long_name
        1805             :     class(cam_grid_attribute_t), pointer               :: next
        1806             :
        1807           0 :     this%name      = trim(name)
        1808           0 :     this%long_name = trim(long_name)
        1809           0 :     this%next => next
        1810           0 :   end subroutine cam_grid_attr_init
        1811             :
        1812       26112 :   subroutine print_attr_base(this)
        1813             :     ! Dummy arguments
        1814             :     class(cam_grid_attribute_t), intent(in)             :: this
        1815       26112 :     if (masterproc) then
        1816          34 :       write(iulog, '(5a)') 'Attribute: ', trim(this%name), ", long name = '", &
        1817          68 :            trim(this%long_name), "'"
        1818             :     end if
        1819       26112 :   end subroutine print_attr_base
        1820             :
        1821        9216 :   subroutine cam_grid_attr_init_0d_int(this, name, long_name, val)
        1822             :     ! Dummy arguments
        1823             :     class(cam_grid_attribute_0d_int_t)                  :: this
        1824             :     character(len=*),                    intent(in)     :: name
        1825             :     character(len=*),                    intent(in)     :: long_name
        1826             :     integer,                             intent(in)     :: val
        1827             :
        1828             : !    call this%cam_grid_attr_init(name, '')
        1829        9216 :     this%name      = trim(name)
        1830        9216 :     this%long_name = trim(long_name)
        1831        9216 :     this%ival      = val
        1832        9216 :   end subroutine cam_grid_attr_init_0d_int
        1833             :
        1834       12288 :   subroutine print_attr_0d_int(this)
        1835             :     ! Dummy arguments
        1836             :     class(cam_grid_attribute_0d_int_t), intent(in)      :: this
        1837             :
        1838       12288 :     call this%print_attr_base()
        1839       12288 :     if (masterproc) then
        1840          16 :       write(iulog, *) '          value = ', this%ival
        1841             :     end if
        1842       12288 :   end subroutine print_attr_0d_int
        1843             :
        1844           0 :   subroutine cam_grid_attr_init_0d_char(this, name, long_name, val)
        1845             :     ! Dummy arguments
        1846             :     class(cam_grid_attribute_0d_char_t)                 :: this
        1847             :     character(len=*),                    intent(in)     :: name
        1848             :     character(len=*),                    intent(in)     :: long_name
        1849             :     character(len=*),                    intent(in)     :: val
        1850             :
        1851             : !    call this%cam_grid_attr_init(name, '')
        1852           0 :     this%name      = trim(name)
        1853           0 :     this%long_name = trim(long_name)
        1854           0 :     this%val       = trim(val)
        1855           0 :   end subroutine cam_grid_attr_init_0d_char
        1856             :
        1857           0 :   subroutine print_attr_0d_char(this)
        1858             :     ! Dummy arguments
        1859             :     class(cam_grid_attribute_0d_char_t), intent(in)     :: this
        1860             :
        1861           0 :     call this%print_attr_base()
        1862           0 :     if (masterproc) then
        1863           0 :       write(iulog, *) '          value = ', trim(this%val)
        1864             :     end if
        1865           0 :   end subroutine print_attr_0d_char
        1866             :
        1867           0 :   subroutine cam_grid_attr_init_1d_int(this, name, long_name, dimname,        &
        1868           0 :        dimsize, values, map)
        1869             :     ! Dummy arguments
        1870             :     class(cam_grid_attribute_1d_int_t)                  :: this
        1871             :     character(len=*),                    intent(in)     :: name
        1872             :     character(len=*),                    intent(in)     :: long_name
        1873             :     character(len=*),                    intent(in)     :: dimname
        1874             :     integer,                             intent(in)     :: dimsize
        1875             :     integer,                     target, intent(in)     :: values(:)
        1876             :     integer(iMap),     optional, target, intent(in)     :: map(:)
        1877             :
        1878             : !    call this%cam_grid_attr_init(trim(name), trim(long_name))
        1879           0 :     if (len_trim(name) > max_hcoordname_len) then
        1880           0 :        call endrun('cam_grid_attr_1d_int: name too long')
        1881             :     end if
        1882           0 :     this%name      = trim(name)
        1883           0 :     if (len_trim(long_name) > max_chars) then
        1884           0 :        call endrun('cam_grid_attr_1d_int: long_name too long')
        1885             :     end if
        1886           0 :     this%long_name = trim(long_name)
        1887             :
        1888           0 :     if (len_trim(dimname) > max_hcoordname_len) then
        1889           0 :        call endrun('cam_grid_attr_1d_int: dimname too long')
        1890             :     end if
        1891           0 :     this%dimname =  trim(dimname)
        1892           0 :     this%dimsize =  dimsize
        1893           0 :     this%values  => values
        1894             :     ! Fill in the optional map
        1895           0 :     if (present(map)) then
        1896           0 :       allocate(this%map(size(map)))
        1897           0 :       this%map(:) = map(:)
        1898             :     else
        1899           0 :       nullify(this%map)
        1900             :     end if
        1901           0 :   end subroutine cam_grid_attr_init_1d_int
        1902             :
        1903       13824 :   subroutine cam_grid_attr_init_1d_r8(this, name, long_name, dimname,         &
        1904       13824 :        dimsize, values, map)
        1905             :     ! Dummy arguments
        1906             :     class(cam_grid_attribute_1d_r8_t)                   :: this
        1907             :     character(len=*),                    intent(in)     :: name
        1908             :     character(len=*),                    intent(in)     :: long_name
        1909             :     character(len=*),                    intent(in)     :: dimname
        1910             :     integer,                             intent(in)     :: dimsize
        1911             :     real(r8),                    target, intent(in)     :: values(:)
        1912             :     integer(iMap),     optional, target, intent(in)     :: map(:)
        1913             :
        1914             : !    call this%cam_grid_attr_init(trim(name), trim(long_name), next)
        1915       13824 :     this%name      = trim(name)
        1916       13824 :     this%long_name = trim(long_name)
        1917             :
        1918       13824 :     this%dimname =  trim(dimname)
        1919       13824 :     this%dimsize =  dimsize
        1920       13824 :     this%values  => values
        1921             :     ! Fill in the optional map
        1922       13824 :     if (present(map)) then
        1923       41472 :       allocate(this%map(size(map)))
        1924     1119168 :       this%map(:) = map(:)
        1925             :     else
        1926           0 :       nullify(this%map)
        1927             :     end if
        1928       13824 :   end subroutine cam_grid_attr_init_1d_r8
        1929             :
        1930           0 :   subroutine print_attr_1d_int(this)
        1931             :     ! Dummy arguments
        1932             :     class(cam_grid_attribute_1d_int_t), intent(in)      :: this
        1933           0 :     call this%print_attr_base()
        1934           0 :     if (masterproc) then
        1935           0 :       write(iulog, *) '          dimname = ', trim(this%dimname)
        1936             :     end if
        1937           0 :   end subroutine print_attr_1d_int
        1938             :
        1939       13824 :   subroutine print_attr_1d_r8(this)
        1940             :     ! Dummy arguments
        1941             :     class(cam_grid_attribute_1d_r8_t), intent(in)       :: this
        1942       13824 :     call this%print_attr_base()
        1943       13824 :     if (masterproc) then
        1944          18 :       write(iulog, *) '          dimname = ', trim(this%dimname)
        1945             :     end if
        1946       13824 :   end subroutine print_attr_1d_r8
        1947             :
        1948       26112 :   subroutine insert_grid_attribute(gridind, attr)
        1949             :     integer,                              intent(in) :: gridind
        1950             :     class(cam_grid_attribute_t), pointer             :: attr
        1951             :
        1952             :     ! Push a new attribute onto the grid
        1953             :     type(cam_grid_attr_ptr_t),  pointer              :: attrPtr
        1954             :
        1955       26112 :     allocate(attrPtr)
        1956       26112 :     call attrPtr%initialize(attr)
        1957       26112 :     call attrPtr%setNext(cam_grids(gridind)%attributes)
        1958       26112 :     cam_grids(gridind)%attributes => attrPtr
        1959       26112 :     call attrPtr%attr%print_attr()
        1960       26112 :   end subroutine insert_grid_attribute
        1961             :
        1962        9216 :   subroutine add_cam_grid_attribute_0d_int(gridname, name, long_name, val)
        1963             :     ! Dummy arguments
        1964             :     character(len=*),      intent(in)                   :: gridname
        1965             :     character(len=*),      intent(in)                   :: name
        1966             :     character(len=*),      intent(in)                   :: long_name
        1967             :     integer,               intent(in)                   :: val
        1968             :
        1969             :     ! Local variables
        1970             :     type(cam_grid_attribute_0d_int_t), pointer          :: attr
        1971             :     class(cam_grid_attribute_t),       pointer          :: attptr
        1972             :     character(len=120)                                  :: errormsg
        1973             :     integer                                             :: gridind
        1974             :
        1975        9216 :     gridind = get_cam_grid_index(trim(gridname))
        1976        9216 :     if (gridind > 0) then
        1977        9216 :       call find_cam_grid_attr(gridind, trim(name), attptr)
        1978        9216 :       if (associated(attptr)) then
        1979             :         ! Attribute found, can't add it again!
        1980             :         write(errormsg, '(4a)')                                               &
        1981           0 :              'add_cam_grid_attribute_0d_int: attribute ', trim(name),         &
        1982           0 :            ' already exists for ', cam_grids(gridind)%name
        1983           0 :         call endrun(errormsg)
        1984             :       else
        1985             :         ! Need a new attribute.
        1986       27648 :         allocate(attr)
        1987        9216 :         call attr%cam_grid_attr_init_0d_int(trim(name), trim(long_name), val)
        1988        9216 :         attptr => attr
        1989        9216 :         call insert_grid_attribute(gridind, attptr)
        1990             :       end if
        1991             :     else
        1992           0 :       write(errormsg, '(3a)') 'add_cam_grid_attribute_0d_int: grid ',         &
        1993           0 :            trim(gridname), ' was not found'
        1994           0 :       call endrun(errormsg)
        1995             :     end if
        1996             : !    call cam_grids(gridind)%print_cam_grid()
        1997        9216 :   end subroutine add_cam_grid_attribute_0d_int
        1998             :
        1999           0 :   subroutine add_cam_grid_attribute_0d_char(gridname, name, val)
        2000             :     ! Dummy arguments
        2001             :     character(len=*),      intent(in)                   :: gridname
        2002             :     character(len=*),      intent(in)                   :: name
        2003             :     character(len=*),      intent(in)                   :: val
        2004             :
        2005             :     ! Local variables
        2006             :     type(cam_grid_attribute_0d_char_t), pointer         :: attr
        2007             :     class(cam_grid_attribute_t),        pointer         :: attptr
        2008             :     character(len=120)                                  :: errormsg
        2009             :     integer                                             :: gridind
        2010             :
        2011           0 :     gridind = get_cam_grid_index(trim(gridname))
        2012           0 :     if (gridind > 0) then
        2013           0 :       call find_cam_grid_attr(gridind, trim(name), attptr)
        2014           0 :       if (associated(attptr)) then
        2015             :         ! Attribute found, can't add it again!
        2016             :         write(errormsg, '(4a)')                                               &
        2017           0 :              'add_cam_grid_attribute_0d_char: attribute ', trim(name),        &
        2018           0 :            ' already exists for ', cam_grids(gridind)%name
        2019           0 :         call endrun(errormsg)
        2020             :       else
        2021             :         ! Need a new attribute.
        2022           0 :         allocate(attr)
        2023           0 :         call attr%cam_grid_attr_init_0d_char(trim(name), '', val)
        2024           0 :         attptr => attr
        2025           0 :         call insert_grid_attribute(gridind, attptr)
        2026             :       end if
        2027             :     else
        2028           0 :       write(errormsg, '(3a)') 'add_cam_grid_attribute_0d_char: grid ',        &
        2029           0 :            trim(gridname), ' was not found'
        2030           0 :       call endrun(errormsg)
        2031             :     end if
        2032             : !    call cam_grids(gridind)%print_cam_grid()
        2033           0 :   end subroutine add_cam_grid_attribute_0d_char
        2034             :
        2035           0 :   subroutine add_cam_grid_attribute_1d_int(gridname, name, long_name,         &
        2036           0 :        dimname, values, map)
        2037             :     ! Dummy arguments
        2038             :     character(len=*),      intent(in)                   :: gridname
        2039             :     character(len=*),      intent(in)                   :: name
        2040             :     character(len=*),      intent(in)                   :: long_name
        2041             :     character(len=*),      intent(in)                   :: dimname
        2042             :     integer,               intent(in), target           :: values(:)
        2043             :     integer(iMap),         intent(in), target, optional :: map(:)
        2044             :
        2045             :     ! Local variables
        2046             :     type(cam_grid_attribute_1d_int_t), pointer          :: attr
        2047             :     class(cam_grid_attribute_t),       pointer          :: attptr
        2048             :     character(len=120)                                  :: errormsg
        2049             :     integer                                             :: gridind
        2050             :     integer                                             :: dimsize
        2051             :
        2052           0 :     nullify(attr)
        2053           0 :     nullify(attptr)
        2054           0 :     gridind = get_cam_grid_index(trim(gridname))
        2055           0 :     if (gridind > 0) then
        2056           0 :       call find_cam_grid_attr(gridind, trim(name), attptr)
        2057           0 :       if (associated(attptr)) then
        2058             :         ! Attribute found, can't add it again!
        2059             :         write(errormsg, '(4a)')                                               &
        2060           0 :              'add_cam_grid_attribute_1d_int: attribute ', trim(name),         &
        2061           0 :              ' already exists for ', cam_grids(gridind)%name
        2062           0 :         call endrun(errormsg)
        2063             :       else
        2064             :         ! Need a new attribute.
        2065           0 :         dimsize = cam_grids(gridind)%lat_coord%global_size(trim(dimname))
        2066           0 :         if (dimsize < 1) then
        2067           0 :           dimsize = cam_grids(gridind)%lon_coord%global_size(trim(dimname))
        2068             :         end if
        2069           0 :         if (dimsize < 1) then
        2070           0 :           write(errormsg, *) 'add_cam_grid_attribute_1d_int: attribute ',     &
        2071           0 :                'dimension ', trim(dimname), ' for ', trim(name), ', not found'
        2072           0 :           call endrun(errormsg)
        2073             :         end if
        2074           0 :         allocate(attr)
        2075             :         call attr%cam_grid_attr_init_1d_int(trim(name), trim(long_name),      &
        2076           0 :              trim(dimname), dimsize, values, map)
        2077           0 :         attptr => attr
        2078           0 :         call insert_grid_attribute(gridind, attptr)
        2079             :       end if
        2080             :     else
        2081           0 :       write(errormsg, '(3a)') 'add_cam_grid_attribute_1d_int: grid ',         &
        2082           0 :            trim(gridname), ' was not found'
        2083           0 :       call endrun(errormsg)
        2084             :     end if
        2085             : !    call cam_grids(gridind)%print_cam_grid()
        2086           0 :   end subroutine add_cam_grid_attribute_1d_int
        2087             :
        2088       13824 :   subroutine add_cam_grid_attribute_1d_r8(gridname, name, long_name,          &
        2089       13824 :        dimname, values, map)
        2090             :     ! Dummy arguments
        2091             :     character(len=*),      intent(in)                   :: gridname
        2092             :     character(len=*),      intent(in)                   :: name
        2093             :     character(len=*),      intent(in)                   :: long_name
        2094             :     character(len=*),      intent(in)                   :: dimname
        2095             :     real(r8),              intent(in), target           :: values(:)
        2096             :     integer(iMap),         intent(in), target, optional :: map(:)
        2097             :
        2098             :     ! Local variables
        2099             :     type(cam_grid_attribute_1d_r8_t),  pointer          :: attr
        2100             :     class(cam_grid_attribute_t),       pointer          :: attptr
        2101             :     character(len=120)                                  :: errormsg
        2102             :     integer                                             :: gridind
        2103             :     integer                                             :: dimsize
        2104             :
        2105       13824 :     gridind = get_cam_grid_index(trim(gridname))
        2106       13824 :     if (gridind > 0) then
        2107       13824 :       call find_cam_grid_attr(gridind, trim(name), attptr)
        2108       13824 :       if (associated(attptr)) then
        2109             :         ! Attribute found, can't add it again!
        2110             :         write(errormsg, '(4a)')                                               &
        2111           0 :              'add_cam_grid_attribute_1d_r8: attribute ', trim(name),          &
        2112           0 :              ' already exists for ', cam_grids(gridind)%name
        2113           0 :         call endrun(errormsg)
        2114             :       else
        2115             :         ! Need a new attribute.
        2116       13824 :         dimsize = cam_grids(gridind)%lat_coord%global_size(trim(dimname))
        2117       13824 :         if (dimsize < 1) then
        2118           0 :           dimsize = cam_grids(gridind)%lon_coord%global_size(trim(dimname))
        2119             :         end if
        2120       13824 :         if (dimsize < 1) then
        2121           0 :           write(errormsg, *) 'add_cam_grid_attribute_1d_r8: attribute ',      &
        2122           0 :                'dimension ', trim(dimname), ' for ', trim(name), ', not found'
        2123           0 :           call endrun(errormsg)
        2124             :         end if
        2125       41472 :         allocate(attr)
        2126             :         call attr%cam_grid_attr_init_1d_r8(trim(name), trim(long_name),       &
        2127       13824 :              trim(dimname), dimsize, values, map)
        2128       13824 :         attptr => attr
        2129       13824 :         call insert_grid_attribute(gridind, attptr)
        2130             :       end if
        2131             :     else
        2132           0 :       write(errormsg, '(3a)') 'add_cam_grid_attribute_1d_r8: grid ',          &
        2133           0 :            trim(gridname), ' was not found'
        2134           0 :       call endrun(errormsg)
        2135             :     end if
        2136             : !    call cam_grids(gridind)%print_cam_grid()
        2137       13824 :   end subroutine add_cam_grid_attribute_1d_r8
        2138             :
        2139             : !!#######################################################################
        2140             : !!
        2141             : !! CAM grid attribute pointer (list node) functions
        2142             : !!
        2143             : !!#######################################################################
        2144             :
        2145       26112 :   subroutine initializeAttrPtr(this, attr)
        2146             :     ! Dummy arguments
        2147             :     class(cam_grid_attr_ptr_t)           :: this
        2148             :     class(cam_grid_attribute_t), target  :: attr
        2149             :
        2150       26112 :     if (associated(this%next)) then
        2151           0 :       if (masterproc) then
        2152           0 :         write(iulog, *) 'WARNING: Overwriting attr pointer for cam_grid_attr_ptr_t'
        2153             :       end if
        2154             :     end if
        2155       26112 :     this%attr => attr
        2156       26112 :   end subroutine initializeAttrPtr
        2157             :
        2158           0 :   function getAttrPtrAttr(this)
        2159             :     ! Dummy variable
        2160             :     class(cam_grid_attr_ptr_t)                 :: this
        2161             :     class(cam_grid_attribute_t), pointer       :: getAttrPtrAttr
        2162             :
        2163           0 :     getAttrPtrAttr => this%attr
        2164           0 :   end function getAttrPtrAttr
        2165             :
        2166           0 :   function getAttrPtrNext(this)
        2167             :     ! Dummy arguments
        2168             :     class(cam_grid_attr_ptr_t)                 :: this
        2169             :     type(cam_grid_attr_ptr_t), pointer         :: getAttrPtrNext
        2170             :
        2171           0 :     getAttrPtrNext => this%next
        2172           0 :   end function getAttrPtrNext
        2173             :
        2174       26112 :   subroutine setAttrPtrNext(this, next)
        2175             :     ! Dummy arguments
        2176             :     class(cam_grid_attr_ptr_t)                 :: this
        2177             :     type(cam_grid_attr_ptr_t),  pointer        :: next
        2178             :
        2179       26112 :     if (associated(this%next)) then
        2180           0 :       if (masterproc) then
        2181           0 :         write(iulog, *) 'WARNING: Overwriting next pointer for cam_grid_attr_ptr_t'
        2182             :       end if
        2183             :     end if
        2184       26112 :     this%next => next
        2185       26112 :   end subroutine setAttrPtrNext
        2186             :
        2187             :   !---------------------------------------------------------------------------
        2188             :   !
        2189             :   !  write_cam_grid_attr_0d_int
        2190             :   !
        2191             :   !  Write a grid attribute
        2192             :   !
        2193             :   !---------------------------------------------------------------------------
        2194             :
        2195      497664 :   subroutine write_cam_grid_attr_0d_int(attr, File, file_index)
        2196             :     use pio,           only: file_desc_t, pio_put_att, pio_noerr, pio_int,    &
        2197             :          pio_inq_att, PIO_GLOBAL
        2198             :     use cam_pio_utils, only: cam_pio_def_var
        2199             :
        2200             :     ! Dummy arguments
        2201             :     class(cam_grid_attribute_0d_int_t), intent(inout) :: attr
        2202             :     type(file_desc_t),                  intent(inout) :: File ! PIO file Handle
        2203             :     integer,           optional,        intent(in)    :: file_index
        2204             :
        2205             :     ! Local variables
        2206             :     integer                             :: attrtype
        2207             :     integer(imap)                       :: attrlen
        2208             :     integer                             :: ierr
        2209             :     integer                             :: file_index_loc
        2210             :
        2211      497664 :     if (present(file_index)) then
        2212      497664 :        file_index_loc = file_index
        2213             :     else
        2214             :        file_index_loc = 1
        2215             :     end if
        2216             :
        2217             :     ! Since more than one grid can share an attribute, assume that if the
        2218             :     ! vardesc is associated, that grid defined the attribute
        2219      497664 :     if (.not. associated(attr%vardesc(file_index_loc)%p)) then
        2220      497664 :       if (len_trim(attr%long_name) > 0) then
        2221             :         ! This 0d attribute is a scalar variable with a long_name attribute
        2222             :         ! First, define the variable
        2223           0 :         allocate(attr%vardesc(file_index_loc)%p)
        2224             :         call cam_pio_def_var(File, trim(attr%name), pio_int, attr%vardesc(file_index_loc)%p,    &
        2225           0 :              existOK=.false.)
        2226           0 :         ierr=pio_put_att(File, attr%vardesc(file_index_loc)%p, 'long_name', trim(attr%long_name))
        2227           0 :         call cam_pio_handle_error(ierr, 'Error writing "long_name" attr in write_cam_grid_attr_0d_int')
        2228             :       else
        2229             :         ! This 0d attribute is a global attribute
        2230             :         ! Check to see if the attribute already exists in the file
        2231      497664 :         ierr = pio_inq_att(File, PIO_GLOBAL, attr%name, attrtype, attrlen)
        2232      497664 :         if (ierr /= PIO_NOERR) then
        2233             :           ! Time to define the attribute
        2234      494592 :           ierr = pio_put_att(File, PIO_GLOBAL, trim(attr%name), attr%ival)
        2235      494592 :           call cam_pio_handle_error(ierr, 'Unable to define attribute in write_cam_grid_attr_0d_int')
        2236             :         end if
        2237             :       end if
        2238             :     end if
        2239             :
        2240      497664 :   end subroutine write_cam_grid_attr_0d_int
        2241             :
        2242             :   !---------------------------------------------------------------------------
        2243             :   !
        2244             :   !  write_cam_grid_attr_0d_char
        2245             :   !
        2246             :   !  Write a grid attribute
        2247             :   !
        2248             :   !---------------------------------------------------------------------------
        2249             :
        2250           0 :   subroutine write_cam_grid_attr_0d_char(attr, File, file_index)
        2251      497664 :     use pio, only: file_desc_t, pio_put_att, pio_noerr,                       &
        2252             :                    pio_inq_att, PIO_GLOBAL
        2253             :
        2254             :     ! Dummy arguments
        2255             :     class(cam_grid_attribute_0d_char_t), intent(inout) :: attr
        2256             :     type(file_desc_t),                   intent(inout) :: File ! PIO file Handle
        2257             :     integer,             optional,       intent(in)    :: file_index
        2258             :
        2259             :     ! Local variables
        2260             :     integer                             :: attrtype
        2261             :     integer(imap)                       :: attrlen
        2262             :     integer                             :: ierr
        2263             :     integer                             :: file_index_loc
        2264             :
        2265           0 :     if (present(file_index)) then
        2266           0 :        file_index_loc = file_index
        2267             :     else
        2268             :        file_index_loc = 1
        2269             :     end if
        2270             :
        2271             :     ! Since more than one grid can share an attribute, assume that if the
        2272             :     ! vardesc is associated, that grid defined the attribute
        2273           0 :     if (.not. associated(attr%vardesc(file_index_loc)%p)) then
        2274             :       ! The 0d char attributes are global attribues
        2275             :       ! Check to see if the attribute already exists in the file
        2276           0 :       ierr = pio_inq_att(File, PIO_GLOBAL, attr%name, attrtype, attrlen)
        2277           0 :       if (ierr /= PIO_NOERR) then
        2278             :         ! Time to define the variable
        2279           0 :         ierr = pio_put_att(File, PIO_GLOBAL, trim(attr%name), attr%val)
        2280           0 :         call cam_pio_handle_error(ierr, 'Unable to define attribute in write_cam_grid_attr_0d_char')
        2281             :       end if
        2282             :     end if
        2283             :
        2284           0 :   end subroutine write_cam_grid_attr_0d_char
        2285             :
        2286             :   !---------------------------------------------------------------------------
        2287             :   !
        2288             :   !  write_cam_grid_attr_1d_int
        2289             :   !
        2290             :   !  Write a grid attribute
        2291             :   !
        2292             :   !---------------------------------------------------------------------------
        2293             :
        2294           0 :   subroutine write_cam_grid_attr_1d_int(attr, File, file_index)
        2295             :     use pio,           only: file_desc_t, pio_put_att, pio_noerr
        2296             :     use pio,           only: pio_inq_dimid, pio_int
        2297             :     use cam_pio_utils, only: cam_pio_def_var, cam_pio_closefile
        2298             :
        2299             :     ! Dummy arguments
        2300             :     class(cam_grid_attribute_1d_int_t), intent(inout) :: attr
        2301             :     type(file_desc_t),                  intent(inout) :: File ! PIO file Handle
        2302             :     integer,             optional,      intent(in)    :: file_index
        2303             :
        2304             :     ! Local variables
        2305             :     integer                             :: dimid      ! PIO dimension ID
        2306             :     character(len=120)                  :: errormsg
        2307             :     integer                             :: ierr
        2308             :     integer                             :: file_index_loc
        2309             :
        2310           0 :     if (present(file_index)) then
        2311           0 :        file_index_loc = file_index
        2312             :     else
        2313             :        file_index_loc = 1
        2314             :     end if
        2315             :
        2316             :     ! Since more than one grid can share an attribute, assume that if the
        2317             :     ! vardesc is associated, that grid defined the attribute
        2318           0 :     if (.not. associated(attr%vardesc(file_index_loc)%p)) then
        2319             :       ! Check to see if the dimension already exists in the file
        2320           0 :       ierr = pio_inq_dimid(File, trim(attr%dimname), dimid)
        2321           0 :       if (ierr /= PIO_NOERR) then
        2322             :         ! The dimension has not yet been defined. This is an error
        2323             :         ! NB: It should have been defined as part of a coordinate
        2324           0 :         write(errormsg, *) 'write_cam_grid_attr_1d_int: dimension, ',         &
        2325           0 :              trim(attr%dimname), ', does not exist'
        2326           0 :         call cam_pio_closefile(File)
        2327           0 :         call endrun(errormsg)
        2328             :       end if
        2329             :       ! Time to define the variable
        2330           0 :       allocate(attr%vardesc(file_index_loc)%p)
        2331             :       call cam_pio_def_var(File, trim(attr%name), pio_int, (/dimid/),         &
        2332           0 :            attr%vardesc(file_index_loc)%p, existOK=.false.)
        2333           0 :       ierr = pio_put_att(File, attr%vardesc(file_index_loc)%p, 'long_name', trim(attr%long_name))
        2334           0 :       call cam_pio_handle_error(ierr, 'Error writing "long_name" attr in write_cam_grid_attr_1d_int')
        2335             :     end if
        2336             :
        2337           0 :   end subroutine write_cam_grid_attr_1d_int
        2338             :
        2339             :   !---------------------------------------------------------------------------
        2340             :   !
        2341             :   !  write_cam_grid_attr_1d_r8
        2342             :   !
        2343             :   !  Write a grid attribute
        2344             :   !
        2345             :   !---------------------------------------------------------------------------
        2346             :
        2347      497664 :   subroutine write_cam_grid_attr_1d_r8(attr, File, file_index)
        2348           0 :     use pio,           only: file_desc_t, pio_put_att, pio_noerr, pio_double, &
        2349             :          pio_inq_dimid
        2350             :     use cam_pio_utils, only: cam_pio_def_var, cam_pio_closefile
        2351             :
        2352             :     ! Dummy arguments
        2353             :     class(cam_grid_attribute_1d_r8_t), intent(inout) :: attr
        2354             :     type(file_desc_t),                 intent(inout) :: File ! PIO file Handle
        2355             :     integer,            optional,      intent(in)    :: file_index
        2356             :
        2357             :     ! Local variables
        2358             :     integer                             :: dimid      ! PIO dimension ID
        2359             :     character(len=120)                  :: errormsg
        2360             :     integer                             :: ierr
        2361             :     integer                             :: file_index_loc
        2362             :
        2363      497664 :     if (present(file_index)) then
        2364      497664 :        file_index_loc = file_index
        2365             :     else
        2366             :        file_index_loc = 1
        2367             :     end if
        2368             :
        2369             :     ! Since more than one grid can share an attribute, assume that if the
        2370             :     ! vardesc is associated, that grid defined the attribute
        2371      497664 :     if (.not. associated(attr%vardesc(file_index_loc)%p)) then
        2372             :       ! Check to see if the dimension already exists in the file
        2373      497664 :       ierr = pio_inq_dimid(File, trim(attr%dimname), dimid)
        2374      497664 :       if (ierr /= PIO_NOERR) then
        2375             :         ! The dimension has not yet been defined. This is an error
        2376             :         ! NB: It should have been defined as part of a coordinate
        2377           0 :         write(errormsg, *) 'write_cam_grid_attr_1d_r8: dimension, ',          &
        2378           0 :              trim(attr%dimname), ', does not exist'
        2379           0 :         call cam_pio_closefile(File)
        2380           0 :         call endrun(errormsg)
        2381             :       end if
        2382             :       ! Time to define the variable
        2383      497664 :       allocate(attr%vardesc(file_index_loc)%p)
        2384             :       call cam_pio_def_var(File, trim(attr%name), pio_double, (/dimid/),      &
        2385      995328 :            attr%vardesc(file_index_loc)%p, existOK=.false.)
        2386             :       ! long_name
        2387      497664 :       ierr = pio_put_att(File, attr%vardesc(file_index_loc)%p, 'long_name', trim(attr%long_name))
        2388      497664 :       call cam_pio_handle_error(ierr, 'Error writing "long_name" attr in write_cam_grid_attr_1d_r8')
        2389             :     end if
        2390             :
        2391      497664 :   end subroutine write_cam_grid_attr_1d_r8
        2392             :
        2393             :   !---------------------------------------------------------------------------
        2394             :   !
        2395             :   !  cam_grid_attribute_copy
        2396             :   !
        2397             :   !  Copy an attribute from a source grid to a destination grid
        2398             :   !
        2399             :   !---------------------------------------------------------------------------
        2400        3072 :   subroutine cam_grid_attribute_copy(src_grid, dest_grid, attribute_name)
        2401             :     ! Dummy arguments
        2402             :     character(len=*),         intent(in) :: src_grid
        2403             :     character(len=*),         intent(in) :: dest_grid
        2404             :     character(len=*),         intent(in) :: attribute_name
        2405             :
        2406             :     ! Local variables
        2407             :     character(len=120)                   :: errormsg
        2408             :     integer                              :: src_ind, dest_ind
        2409             :     class(cam_grid_attribute_t), pointer :: attr
        2410             :
        2411             :     ! Find the source and destination grid indices
        2412        3072 :     src_ind = get_cam_grid_index(trim(src_grid))
        2413        3072 :     dest_ind = get_cam_grid_index(trim(dest_grid))
        2414             :
        2415        3072 :     call find_cam_grid_attr(dest_ind, trim(attribute_name), attr)
        2416        3072 :     if (associated(attr)) then
        2417             :       ! Attribute found, can't add it again!
        2418           0 :       write(errormsg, '(4a)') 'CAM_GRID_ATTRIBUTE_COPY: attribute ',          &
        2419           0 :            trim(attribute_name),' already exists for ',cam_grids(dest_ind)%name
        2420           0 :       call endrun(errormsg)
        2421             :     else
        2422        3072 :       call find_cam_grid_attr(src_ind, trim(attribute_name), attr)
        2423        3072 :       if (associated(attr)) then
        2424             :         ! Copy the attribute
        2425        3072 :         call insert_grid_attribute(dest_ind, attr)
        2426             :       else
        2427           0 :         write(errormsg, '(4a)') ": Did not find attribute, '",                &
        2428           0 :              trim(attribute_name), "' in ", cam_grids(src_ind)%name
        2429           0 :         call endrun("CAM_GRID_ATTRIBUTE_COPY"//errormsg)
        2430             :       end if
        2431             :     end if
        2432             :
        2433      497664 :   end subroutine cam_grid_attribute_copy
        2434             :
        2435             :   !---------------------------------------------------------------------------
        2436             :   !
        2437             :   !  cam_grid_write_attr
        2438             :   !
        2439             :   !  Write the dimension and coordinate attributes for the horizontal history
        2440             :   !  coordinates.
        2441             :   !
        2442             :   !---------------------------------------------------------------------------
        2443      248832 :   subroutine cam_grid_write_attr(File, grid_id, header_info, file_index)
        2444             :     use pio, only: file_desc_t, PIO_BCAST_ERROR, pio_seterrorhandling
        2445             :
        2446             :     ! Dummy arguments
        2447             :     type(file_desc_t),            intent(inout) :: File       ! PIO file Handle
        2448             :     integer,                      intent(in)    :: grid_id
        2449             :     type(cam_grid_header_info_t), intent(inout) :: header_info
        2450             :     integer,         optional,    intent(in)    :: file_index
        2451             :
        2452             :     ! Local variables
        2453             :     integer                                     :: gridind
        2454             :     class(cam_grid_attribute_t), pointer        :: attr
        2455             :     type(cam_grid_attr_ptr_t),   pointer        :: attrPtr
        2456             :     integer                                     :: dimids(2)
        2457             :     integer                                     :: err_handling
        2458             :     integer                                     :: file_index_loc
        2459             :
        2460      248832 :     if (present(file_index)) then
        2461      245760 :        file_index_loc = file_index
        2462             :     else
        2463        3072 :        file_index_loc = 1
        2464             :     end if
        2465             :
        2466      248832 :     gridind = get_cam_grid_index(grid_id)
        2467             :     !! Fill this in to make sure history finds grid
        2468      248832 :     header_info%grid_id = grid_id
        2469             :
        2470      248832 :     if (allocated(header_info%hdims)) then
        2471      122880 :       deallocate(header_info%hdims)
        2472             :     end if
        2473             :
        2474      248832 :     if (associated(header_info%lon_varid)) then
        2475             :       ! This could be a sign of bad memory management
        2476           0 :       call endrun('CAM_GRID_WRITE_ATTR: lon_varid should be NULL')
        2477             :     end if
        2478      248832 :     if (associated(header_info%lat_varid)) then
        2479             :       ! This could be a sign of bad memory management
        2480           0 :       call endrun('CAM_GRID_WRITE_ATTR: lat_varid should be NULL')
        2481             :     end if
        2482             :
        2483             :     ! Only write this grid if not already defined
        2484      248832 :     if (cam_grids(gridind)%attrs_defined(file_index_loc)) then
        2485             :       ! We need to fill out the hdims info for this grid
        2486           0 :       call cam_grids(gridind)%find_dimids(File, dimids)
        2487           0 :       if (dimids(2) < 0) then
        2488           0 :         allocate(header_info%hdims(1))
        2489           0 :         header_info%hdims(1) = dimids(1)
        2490             :       else
        2491           0 :         allocate(header_info%hdims(2))
        2492           0 :         header_info%hdims(1:2) = dimids(1:2)
        2493             :       end if
        2494             :     else
        2495             :       ! Write the horizontal coord attributes first so that we have the dims
        2496      248832 :       call cam_grids(gridind)%lat_coord%write_attr(File, dimids(2), file_index=file_index_loc)
        2497      248832 :       call cam_grids(gridind)%lon_coord%write_attr(File, dimids(1), file_index=file_index_loc)
        2498             :
        2499      248832 :       if (dimids(2) == dimids(1)) then
        2500      248832 :         allocate(header_info%hdims(1))
        2501             :       else
        2502           0 :         allocate(header_info%hdims(2))
        2503           0 :         header_info%hdims(2) = dimids(2)
        2504             :       end if
        2505      248832 :       header_info%hdims(1) = dimids(1)
        2506             :
        2507             :       ! We will handle errors for this routine
        2508      248832 :        call pio_seterrorhandling(File, PIO_BCAST_ERROR,err_handling)
        2509             :
        2510      248832 :       attrPtr => cam_grids(gridind)%attributes
        2511     1244160 :       do while (associated(attrPtr))
        2512             : !!XXgoldyXX: Is this not working in PGI?
        2513             : !      attr => attrPtr%getAttr()
        2514      995328 :         attr => attrPtr%attr
        2515      995328 :         call attr%write_attr(File, file_index=file_index_loc)
        2516             : !!XXgoldyXX: Is this not working in PGI?
        2517             : !      attrPtr => attrPtr%getNext()
        2518      995328 :         attrPtr => attrPtr%next
        2519             :       end do
        2520             :
        2521             :       ! Back to previous I/O error handling
        2522      248832 :       call pio_seterrorhandling(File, err_handling)
        2523      248832 :       cam_grids(gridind)%attrs_defined(file_index_loc) = .true.
        2524             :     end if
        2525             :
        2526      248832 :   end subroutine cam_grid_write_attr
        2527             :
        2528      497664 :   subroutine write_cam_grid_val_0d_int(attr, File, file_index)
        2529             :     use pio, only: file_desc_t, pio_put_var
        2530             :
        2531             :     ! Dummy arguments
        2532             :     class(cam_grid_attribute_0d_int_t), intent(inout) :: attr
        2533             :     type(file_desc_t),                  intent(inout) :: File
        2534             :     integer,          optional,         intent(in)    :: file_index
        2535             :
        2536             :     ! Local variables
        2537             :     integer                          :: ierr
        2538             :     integer                          :: file_index_loc
        2539             :
        2540      497664 :     if (present(file_index)) then
        2541      497664 :        file_index_loc = file_index
        2542             :     else
        2543             :        file_index_loc = 1
        2544             :     end if
        2545             :
        2546             :     ! We only write this var if it is a variable
        2547      497664 :     if (associated(attr%vardesc(file_index_loc)%p)) then
        2548           0 :       ierr = pio_put_var(File, attr%vardesc(file_index_loc)%p, attr%ival)
        2549           0 :       call cam_pio_handle_error(ierr, 'Error writing value in write_cam_grid_val_0d_int')
        2550           0 :       deallocate(attr%vardesc(file_index_loc)%p)
        2551           0 :       nullify(attr%vardesc(file_index_loc)%p)
        2552             :     end if
        2553             :
        2554      497664 :   end subroutine write_cam_grid_val_0d_int
        2555             :
        2556           0 :   subroutine write_cam_grid_val_0d_char(attr, File, file_index)
        2557             :     use pio, only: file_desc_t
        2558             :
        2559             :     ! Dummy arguments
        2560             :     class(cam_grid_attribute_0d_char_t), intent(inout) :: attr
        2561             :     type(file_desc_t),                   intent(inout) :: File
        2562             :     integer,            optional,        intent(in)    :: file_index
        2563             :
        2564             :     ! This subroutine is a stub because global attributes are written
        2565             :     ! in define mode
        2566           0 :     return
        2567             :   end subroutine write_cam_grid_val_0d_char
        2568             :
        2569           0 :   subroutine write_cam_grid_val_1d_int(attr, File, file_index)
        2570             :     use pio,           only: file_desc_t, pio_put_var, pio_int,               &
        2571             :                              pio_write_darray, io_desc_t, pio_freedecomp
        2572             :     use cam_pio_utils, only: cam_pio_newdecomp
        2573             :
        2574             :     ! Dummy arguments
        2575             :     class(cam_grid_attribute_1d_int_t), intent(inout) :: attr
        2576             :     type(file_desc_t),                  intent(inout) :: File
        2577             :     integer,            optional,       intent(in)    :: file_index
        2578             :
        2579             :     ! Local variables
        2580             :     integer                          :: ierr
        2581             :     type(io_desc_t), pointer         :: iodesc
        2582             :     integer                          :: file_index_loc
        2583             :
        2584           0 :     if (present(file_index)) then
        2585           0 :        file_index_loc = file_index
        2586             :     else
        2587             :        file_index_loc = 1
        2588             :     end if
        2589             :
        2590           0 :     nullify(iodesc)
        2591             :     ! Since more than one grid can share an attribute, assume that if the
        2592             :     ! vardesc is not associated, another grid write the values
        2593           0 :     if (associated(attr%vardesc(file_index_loc)%p)) then
        2594             :       ! Write out the values for this dimension variable
        2595           0 :       if (associated(attr%map)) then
        2596             :         ! This is a distributed variable, use pio_write_darray
        2597           0 :         allocate(iodesc)
        2598           0 :         call cam_pio_newdecomp(iodesc, (/attr%dimsize/), attr%map, pio_int)
        2599           0 :         call pio_write_darray(File, attr%vardesc(file_index_loc)%p, iodesc, attr%values, ierr)
        2600           0 :         call pio_freedecomp(File, iodesc)
        2601           0 :         deallocate(iodesc)
        2602             :         nullify(iodesc)
        2603             :       else
        2604             :         ! This is a local variable, pio_put_var should work fine
        2605           0 :         ierr = pio_put_var(File, attr%vardesc(file_index_loc)%p, attr%values)
        2606             :       end if
        2607           0 :       call cam_pio_handle_error(ierr, 'Error writing variable values in write_cam_grid_val_1d_int')
        2608           0 :       deallocate(attr%vardesc(file_index_loc)%p)
        2609           0 :       nullify(attr%vardesc(file_index_loc)%p)
        2610             :     end if
        2611             :
        2612           0 :   end subroutine write_cam_grid_val_1d_int
        2613             :
        2614      497664 :   subroutine write_cam_grid_val_1d_r8(attr, File, file_index)
        2615           0 :     use pio,           only: file_desc_t, pio_put_var, pio_double,            &
        2616             :                              pio_write_darray, io_desc_t, pio_freedecomp
        2617             :     use cam_pio_utils, only: cam_pio_newdecomp
        2618             :
        2619             :     ! Dummy arguments
        2620             :     class(cam_grid_attribute_1d_r8_t), intent(inout) :: attr
        2621             :     type(file_desc_t),                 intent(inout) :: File
        2622             :     integer,            optional,      intent(in)    :: file_index
        2623             :
        2624             :     ! Local variables
        2625             :     integer                          :: ierr
        2626             :     type(io_desc_t), pointer         :: iodesc
        2627             :     integer                          :: file_index_loc
        2628             :
        2629      497664 :     if (present(file_index)) then
        2630      497664 :        file_index_loc = file_index
        2631             :     else
        2632             :        file_index_loc = 1
        2633             :     end if
        2634             :
        2635      497664 :     nullify(iodesc)
        2636             :     ! Since more than one grid can share an attribute, assume that if the
        2637             :     ! vardesc is not associated, another grid write the values
        2638      497664 :     if (associated(attr%vardesc(file_index_loc)%p)) then
        2639             :       ! Write out the values for this dimension variable
        2640      497664 :       if (associated(attr%map)) then
        2641             :         ! This is a distributed variable, use pio_write_darray
        2642      497664 :         allocate(iodesc)
        2643      995328 :         call cam_pio_newdecomp(iodesc, (/attr%dimsize/), attr%map, pio_double)
        2644      497664 :         call pio_write_darray(File, attr%vardesc(file_index_loc)%p, iodesc, attr%values, ierr)
        2645      497664 :         call pio_freedecomp(File, iodesc)
        2646      497664 :         deallocate(iodesc)
        2647             :         nullify(iodesc)
        2648             :       else
        2649             :         ! This is a local variable, pio_put_var should work fine
        2650           0 :         ierr = pio_put_var(File, attr%vardesc(file_index_loc)%p, attr%values)
        2651             :       end if
        2652      497664 :       call cam_pio_handle_error(ierr, 'Error writing variable values in write_cam_grid_val_1d_r8')
        2653      497664 :       deallocate(attr%vardesc(file_index_loc)%p)
        2654      497664 :       nullify(attr%vardesc(file_index_loc)%p)
        2655             :     end if
        2656             :
        2657      497664 :   end subroutine write_cam_grid_val_1d_r8
        2658             :
        2659      248832 :   subroutine cam_grid_write_var(File, grid_id, file_index)
        2660      497664 :    use pio, only: file_desc_t, pio_bcast_error, pio_seterrorhandling
        2661             :
        2662             :     ! Dummy arguments
        2663             :     type(file_desc_t), intent(inout)     :: File        ! PIO file Handle
        2664             :     integer,           intent(in)        :: grid_id
        2665             :     integer, optional, intent(in)        :: file_index
        2666             :
        2667             :     ! Local variables
        2668             :     integer                              :: gridind
        2669             :     integer                              :: err_handling
        2670             :     class(cam_grid_attribute_t), pointer :: attr
        2671             :     type(cam_grid_attr_ptr_t),   pointer :: attrPtr
        2672             :     integer                              :: file_index_loc
        2673             :
        2674      248832 :     if (present(file_index)) then
        2675      245760 :        file_index_loc = file_index
        2676             :     else
        2677        3072 :        file_index_loc = 1
        2678             :     end if
        2679      248832 :     gridind = get_cam_grid_index(grid_id)
        2680             :     ! Only write if not already done
        2681      248832 :     if (cam_grids(gridind)%attrs_defined(file_index_loc)) then
        2682             :       ! Write the horizontal coorinate values
        2683      248832 :       call cam_grids(gridind)%lon_coord%write_var(File, file_index)
        2684      248832 :       call cam_grids(gridind)%lat_coord%write_var(File, file_index)
        2685             :
        2686             :       ! We will handle errors for this routine
        2687      248832 :        call pio_seterrorhandling(File, PIO_BCAST_ERROR,err_handling)
        2688             :
        2689             :       ! Write out the variable values for each grid attribute
        2690      248832 :       attrPtr => cam_grids(gridind)%attributes
        2691     1244160 :       do while (associated(attrPtr))
        2692             : !!XXgoldyXX: Is this not working in PGI?
        2693             : !      attr => attrPtr%getAttr()
        2694      995328 :         attr => attrPtr%attr
        2695      995328 :         call attr%write_val(File, file_index=file_index_loc)
        2696             : !!XXgoldyXX: Is this not working in PGI?
        2697             : !      attrPtr => attrPtr%getNext()
        2698      995328 :         attrPtr => attrPtr%next
        2699             :       end do
        2700             :
        2701             :       ! Back to previous I/O error handling
        2702      248832 :       call pio_seterrorhandling(File, err_handling)
        2703             :
        2704      248832 :       cam_grids(gridind)%attrs_defined(file_index_loc) = .false.
        2705             :     end if
        2706             :
        2707      248832 :   end subroutine cam_grid_write_var
        2708             :
        2709     5177088 :   logical function cam_grid_block_indexed(this)
        2710             :     class(cam_grid_t)                         :: this
        2711             :
        2712     5177088 :     cam_grid_block_indexed = this%block_indexed
        2713     5177088 :   end function cam_grid_block_indexed
        2714             :
        2715     5177088 :   logical function cam_grid_zonal_grid(this)
        2716             :     class(cam_grid_t)                         :: this
        2717             :
        2718     5177088 :     cam_grid_zonal_grid = this%zonal_grid
        2719     5177088 :   end function cam_grid_zonal_grid
        2720             :
        2721      819456 :   logical function cam_grid_unstructured(this)
        2722             :     class(cam_grid_t)                         :: this
        2723             :
        2724      819456 :     cam_grid_unstructured = this%unstructured
        2725      819456 :   end function cam_grid_unstructured
        2726             :
        2727             :   !---------------------------------------------------------------------------
        2728             :   !
        2729             :   !  cam_grid_get_dims: Return the dimensions of the grid
        2730             :   !                For lon/lat grids, this is (nlon, nlat)
        2731             :   !                For unstructured grids, this is (ncols, 1)
        2732             :   !
        2733             :   !---------------------------------------------------------------------------
        2734      819456 :   subroutine cam_grid_get_dims(this, dims)
        2735             :     ! Dummy arguments
        2736             :     class(cam_grid_t)                :: this
        2737             :     integer,           intent(inout) :: dims(2)
        2738             :
        2739      819456 :     if (this%is_unstructured()) then
        2740      819456 :       call this%lon_coord%get_coord_len(dims(1))
        2741      819456 :       dims(2) = 1
        2742             :     else
        2743           0 :       call this%lon_coord%get_coord_len(dims(1))
        2744           0 :       call this%lat_coord%get_coord_len(dims(2))
        2745             :     end if
        2746             :
        2747      819456 :   end subroutine cam_grid_get_dims
        2748             :
        2749             :   !---------------------------------------------------------------------------
        2750             :   !
        2751             :   !  cam_grid_coord_names: Return the names of the grid axes
        2752             :   !
        2753             :   !---------------------------------------------------------------------------
        2754           0 :   subroutine cam_grid_coord_names(this, lon_name, lat_name)
        2755             :     ! Dummy arguments
        2756             :     class(cam_grid_t)                :: this
        2757             :     character(len=*),  intent(out)   :: lon_name
        2758             :     character(len=*),  intent(out)   :: lat_name
        2759             :
        2760           0 :     call this%lon_coord%get_coord_name(lon_name)
        2761           0 :     call this%lat_coord%get_coord_name(lat_name)
        2762             :
        2763           0 :   end subroutine cam_grid_coord_names
        2764             :
        2765             :   !---------------------------------------------------------------------------
        2766             :   !
        2767             :   !  cam_grid_dim_names: Return the names of the dimensions of the grid axes.
        2768             :   !        Note that these may be the same
        2769             :   !
        2770             :   !---------------------------------------------------------------------------
        2771      967680 :   subroutine cam_grid_dim_names(this, name1, name2)
        2772             :     ! Dummy arguments
        2773             :     class(cam_grid_t)                :: this
        2774             :     character(len=*),  intent(out)   :: name1
        2775             :     character(len=*),  intent(out)   :: name2
        2776             :
        2777      967680 :     call this%lon_coord%get_dim_name(name1)
        2778      967680 :     call this%lat_coord%get_dim_name(name2)
        2779             :
        2780      967680 :   end subroutine cam_grid_dim_names
        2781             :
        2782             :   !---------------------------------------------------------------------------
        2783             :   !
        2784             :   !  cam_grid_dimensions_id: Return the dimensions of the grid
        2785             :   !                For lon/lat grids, this is (nlon, nlat)
        2786             :   !                For unstructured grids, this is (ncols, 1)
        2787             :   !
        2788             :   !---------------------------------------------------------------------------
        2789      814848 :   subroutine cam_grid_dimensions_id(gridid, dims, rank)
        2790             :     ! Dummy arguments
        2791             :     integer,           intent(in)     :: gridid
        2792             :     integer,           intent(inout)  :: dims(2)
        2793             :     integer, optional, intent(out)    :: rank
        2794             :
        2795             :     ! Local variables
        2796             :     integer                           :: index
        2797             :     character(len=max_hcoordname_len) :: dname1, dname2
        2798             :     character(len=120)                :: errormsg
        2799             :
        2800      814848 :     index = get_cam_grid_index(gridid)
        2801      814848 :     if (index < 0) then
        2802           0 :       write(errormsg, *) 'No CAM grid with ID =', gridid
        2803           0 :       call endrun(errormsg)
        2804             :     else
        2805      814848 :       call cam_grids(index)%coord_lengths(dims)
        2806             :     end if
        2807      814848 :     if (present(rank)) then
        2808      539904 :       call cam_grids(index)%dim_names(dname1, dname2)
        2809      539904 :       if (trim(dname1) == trim(dname2)) then
        2810      539904 :         rank = 1
        2811             :       else
        2812           0 :         rank = 2
        2813             :       end if
        2814             :     end if
        2815             :
        2816      814848 :   end subroutine cam_grid_dimensions_id
        2817             :
        2818             :   !---------------------------------------------------------------------------
        2819             :   !
        2820             :   !  cam_grid_dimensions_name: Return the dimensions of the grid
        2821             :   !                For lon/lat grids, this is (nlon, nlat)
        2822             :   !                For unstructured grids, this is (ncols, 1)
        2823             :   !
        2824             :   !---------------------------------------------------------------------------
        2825        2304 :   subroutine cam_grid_dimensions_name(gridname, dims, rank)
        2826             :     ! Dummy arguments
        2827             :     character(len=*),  intent(in)     :: gridname
        2828             :     integer,           intent(inout)  :: dims(2)
        2829             :     integer, optional, intent(out)    :: rank
        2830             :
        2831             :     ! Local variables
        2832             :     integer                           :: gridind
        2833             :     character(len=max_hcoordname_len) :: dname1, dname2
        2834             :     character(len=120)                :: errormsg
        2835             :
        2836        2304 :     gridind = get_cam_grid_index(trim(gridname))
        2837        2304 :     if (gridind < 0) then
        2838           0 :       write(errormsg, *) 'No CAM grid with name = ', trim(gridname)
        2839           0 :       call endrun(errormsg)
        2840             :     else
        2841        2304 :       call cam_grids(gridind)%coord_lengths(dims)
        2842             :     end if
        2843        2304 :     if (present(rank)) then
        2844           0 :       call cam_grids(gridind)%dim_names(dname1, dname2)
        2845           0 :       if (trim(dname1) == trim(dname2)) then
        2846           0 :         rank = 1
        2847             :       else
        2848           0 :         rank = 2
        2849             :       end if
        2850             :     end if
        2851             :
        2852        2304 :   end subroutine cam_grid_dimensions_name
        2853             :
        2854             :   !---------------------------------------------------------------------------
        2855             :   !
        2856             :   !  cam_grid_set_map: Set a grid's distribution map
        2857             :   !             This maps the local grid elements to global file order
        2858             :   !
        2859             :   !---------------------------------------------------------------------------
        2860           0 :   subroutine cam_grid_set_map(this, map, src, dest)
        2861             :     use spmd_utils,      only: mpi_sum, mpi_integer, mpicom
        2862             :     ! Dummy arguments
        2863             :     class(cam_grid_t)                      :: this
        2864             :     integer(iMap),     pointer             :: map(:,:)
        2865             :     integer,                    intent(in) :: src(2)   ! decomp info
        2866             :     integer,                    intent(in) :: dest(2)  ! Standard dim(s) in file
        2867             :
        2868             :     ! Local variables
        2869             :     integer                                :: dims(2)
        2870             :     integer                                :: dstrt, dend
        2871             :     integer                                :: gridlen, gridloc, ierr
        2872             :
        2873             :     ! Check to make sure the map meets our needs
        2874           0 :     call this%coord_lengths(dims)
        2875           0 :     dend = size(map, 1)
        2876             :     ! We always have to have one source and one destination
        2877           0 :     if (dest(2) > 0) then
        2878           0 :       dstrt = dend - 1
        2879             :     else
        2880             :       dstrt = dend
        2881             :     end if
        2882           0 :     if ((src(2) /= 0) .and. (dstrt < 3)) then
        2883           0 :       call endrun('cam_grid_set_map: src & dest too large for map')
        2884           0 :     else if (dstrt < 2) then
        2885           0 :       call endrun('cam_grid_set_map: dest too large for map')
        2886             :     ! No else needed
        2887             :     end if
        2888           0 :     if (dstrt == dend) then
        2889           0 :       gridloc = count(map(dend,:) /= 0)
        2890             :     else
        2891           0 :       gridloc = count((map(dstrt,:) /= 0) .and. (map(dend,:) /= 0))
        2892             :     end if
        2893           0 :     call MPI_Allreduce(gridloc, gridlen, 1, MPI_INTEGER, MPI_SUM, mpicom, ierr)
        2894           0 :     if (gridlen /= product(dims)) then
        2895           0 :       call endrun('cam_grid_set_map: Bad map size for '//trim(this%name))
        2896             :     else
        2897           0 :       if (.not. associated(this%map)) then
        2898           0 :         allocate(this%map)
        2899             :       end if
        2900           0 :       call this%map%init(map, this%unstructured, src, dest)
        2901             :     end if
        2902           0 :   end subroutine cam_grid_set_map
        2903             :
        2904             :   !---------------------------------------------------------------------------
        2905             :   !
        2906             :   !  cam_grid_local_size: return the local size of a 2D array on this grid
        2907             :   !
        2908             :   !---------------------------------------------------------------------------
        2909           0 :   integer function cam_grid_local_size(this)
        2910             :
        2911             :     ! Dummy argument
        2912             :     class(cam_grid_t)                         :: this
        2913             :
        2914             :     ! Local variable
        2915             :     character(len=128)                        :: errormsg
        2916             :
        2917           0 :     if (.not. associated(this%map)) then
        2918           0 :       write(errormsg, *) 'Grid, '//trim(this%name)//', has no map'
        2919           0 :       call endrun('cam_grid_local_size: '//trim(errormsg))
        2920             :     else
        2921           0 :       cam_grid_local_size = this%map%num_elem()
        2922             :     end if
        2923             :
        2924           0 :   end function cam_grid_local_size
        2925             :
        2926             :   !---------------------------------------------------------------------------
        2927             :   !
        2928             :   !  cam_grid_get_lon_lat: Find the latitude and longitude for a given
        2929             :   !                        grid map index. Note if point is not mapped
        2930             :   !
        2931             :   !---------------------------------------------------------------------------
        2932           0 :   subroutine cam_grid_get_lon_lat(this, index, lon, lat, isMapped)
        2933             :
        2934             :     ! Dummy arguments
        2935             :     class(cam_grid_t)                        :: this
        2936             :     integer,                   intent(in)    :: index
        2937             :     real(r8),                  intent(out)   :: lon
        2938             :     real(r8),                  intent(out)   :: lat
        2939             :     logical,                   intent(out)   :: isMapped
        2940             :
        2941             :     ! Local variables
        2942             :     integer                                  :: latindex, lonindex
        2943             :     character(len=*), parameter              :: subname = "cam_grid_get_lon_lat"
        2944             :
        2945           0 :     if (this%block_indexed) then
        2946           0 :       lonindex = index
        2947           0 :       latindex = index
        2948           0 :       isMapped = this%map%is_mapped(index)
        2949             :     else
        2950           0 :       call this%map%coord_vals(index, lonindex, latindex, isMapped)
        2951             :     end if
        2952             :
        2953             :     !!XXgoldyXX: May be able to relax all the checks
        2954           0 :     if ( (latindex < LBOUND(this%lat_coord%values, 1)) .or.                   &
        2955             :          (latindex > UBOUND(this%lat_coord%values, 1))) then
        2956           0 :       call endrun(trim(subname)//": index out of range for latvals")
        2957             :     else
        2958           0 :       lat = this%lat_coord%values(latindex)
        2959             :     end if
        2960             :
        2961           0 :     if ( (lonindex < LBOUND(this%lon_coord%values, 1)) .or.                   &
        2962             :          (lonindex > UBOUND(this%lon_coord%values, 1))) then
        2963           0 :       call endrun(trim(subname)//": index out of range for lonvals")
        2964             :     else
        2965           0 :       lon = this%lon_coord%values(lonindex)
        2966             :     end if
        2967             :
        2968           0 :   end subroutine cam_grid_get_lon_lat
        2969             :
        2970             :   !---------------------------------------------------------------------------
        2971             :   !
        2972             :   !  cam_grid_find_src_dims: Find the correct src array dims for this grid
        2973             :   !
        2974             :   !---------------------------------------------------------------------------
        2975      121344 :   subroutine cam_grid_find_src_dims(this, field_dnames, src_out)
        2976             :     ! Dummy arguments
        2977             :     class(cam_grid_t)                         :: this
        2978             :     character(len=*),           intent(in)    :: field_dnames(:)
        2979             :     integer,           pointer                :: src_out(:)
        2980             :
        2981             :     ! Local variables
        2982             :     integer                                   :: i, j
        2983             :     integer                                   :: num_coords
        2984             :     character(len=max_hcoordname_len)         :: coord_dimnames(2)
        2985             :
        2986      121344 :     call this%dim_names(coord_dimnames(1), coord_dimnames(2))
        2987      121344 :     if (associated(src_out)) then
        2988           0 :       deallocate(src_out)
        2989             :       nullify(src_out)
        2990             :     end if
        2991      121344 :     if (trim(coord_dimnames(1)) == trim(coord_dimnames(2))) then
        2992             :       num_coords = 1
        2993             :     else
        2994           0 :       num_coords = 2
        2995             :     end if
        2996      121344 :     allocate(src_out(2)) ! Currently, all cases have two source dims
        2997      242688 :     do i = 1, num_coords
        2998      485376 :       do j = 1, size(field_dnames)
        2999      364032 :         if (trim(field_dnames(j)) == trim(coord_dimnames(i))) then
        3000      121344 :           src_out(i) = j
        3001             :         end if
        3002             :       end do
        3003             :     end do
        3004      121344 :     if (num_coords < 2) then
        3005      121344 :       src_out(2) = -1  ! Assume a block structure for unstructured grids
        3006             :     end if
        3007             :
        3008      121344 :   end subroutine cam_grid_find_src_dims
        3009             :
        3010             :   !---------------------------------------------------------------------------
        3011             :   !
        3012             :   !  cam_grid_find_dest_dims: Find the correct file array dims for this grid
        3013             :   !
        3014             :   !---------------------------------------------------------------------------
        3015      121344 :   subroutine cam_grid_find_dest_dims(this, file_dnames, dest_out)
        3016             :     ! Dummy arguments
        3017             :     class(cam_grid_t)                         :: this
        3018             :     character(len=*),           intent(in)    :: file_dnames(:)
        3019             :     integer,           pointer                :: dest_out(:)
        3020             :
        3021             :     ! Local variables
        3022             :     integer                                   :: i, j
        3023             :     integer                                   :: num_coords
        3024             :     character(len=max_hcoordname_len)         :: coord_dimnames(2)
        3025             :
        3026      121344 :     call this%dim_names(coord_dimnames(1), coord_dimnames(2))
        3027      121344 :     if (associated(dest_out)) then
        3028           0 :       deallocate(dest_out)
        3029             :       nullify(dest_out)
        3030             :     end if
        3031      121344 :     if (trim(coord_dimnames(1)) == trim(coord_dimnames(2))) then
        3032             :       num_coords = 1
        3033             :     else
        3034           0 :       num_coords = 2
        3035             :     end if
        3036      364032 :     allocate(dest_out(num_coords))
        3037      242688 :     dest_out = 0
        3038      242688 :     do i = 1, num_coords
        3039      485376 :       do j = 1, size(file_dnames)
        3040      364032 :         if (trim(file_dnames(j)) == trim(coord_dimnames(i))) then
        3041      121344 :           dest_out(i) = j
        3042             :         end if
        3043             :       end do
        3044             :     end do
        3045             :
        3046      121344 :   end subroutine cam_grid_find_dest_dims
        3047             :
        3048             :   !---------------------------------------------------------------------------
        3049             :   !
        3050             :   !  cam_grid_get_pio_decomp: Find or create a PIO decomp on this grid
        3051             :   !
        3052             :   !---------------------------------------------------------------------------
        3053      269568 :   subroutine cam_grid_get_pio_decomp(this, field_lens, file_lens, dtype,      &
        3054      269568 :        iodesc, field_dnames, file_dnames)
        3055             :     use pio,           only: io_desc_t
        3056             :     use cam_pio_utils, only: cam_pio_get_decomp, calc_permutation
        3057             :
        3058             :     ! Dummy arguments
        3059             :     class(cam_grid_t)                         :: this
        3060             :     integer,                    intent(in)    :: field_lens(:)
        3061             :     integer,                    intent(in)    :: file_lens(:)
        3062             :     integer,                    intent(in)    :: dtype
        3063             :     type(io_desc_t), pointer,   intent(out)   :: iodesc
        3064             :     character(len=*), optional, intent(in)    :: field_dnames(:)
        3065             :     character(len=*), optional, intent(in)    :: file_dnames(:)
        3066             :
        3067             :     ! Local variables
        3068      269568 :     integer,              pointer             :: src_in(:)
        3069      269568 :     integer,              pointer             :: dest_in(:)
        3070      269568 :     integer, allocatable                      :: permutation(:)
        3071             :     logical                                   :: is_perm
        3072             :     character(len=128)                        :: errormsg
        3073             :
        3074      269568 :     nullify(src_in)
        3075      269568 :     nullify(dest_in)
        3076      269568 :     is_perm = .false.
        3077      269568 :     if (.not. associated(this%map)) then
        3078           0 :       write(errormsg, *) 'Grid, '//trim(this%name)//', has no map'
        3079           0 :       call endrun('cam_grid_get_pio_decomp: '//trim(errormsg))
        3080             :     else
        3081      269568 :       if (present(field_dnames)) then
        3082      121344 :         call this%find_src_dims(field_dnames, src_in)
        3083             :       end if
        3084      269568 :       if (present(file_dnames)) then
        3085      121344 :         call this%find_dest_dims(file_dnames, dest_in)
        3086             :       end if
        3087      269568 :       if (present(file_dnames) .and. present(field_dnames)) then
        3088             :         ! This only works if the arrays are the same size
        3089      121344 :         if (size(file_dnames) == size(field_dnames)) then
        3090      364032 :           allocate(permutation(size(file_dnames)))
        3091      121344 :           call calc_permutation(file_dnames, field_dnames, permutation, is_perm)
        3092             :         end if
        3093             :       end if
        3094             :       ! Call cam_pio_get_decomp with the appropriate options
        3095      269568 :       if (present(field_dnames) .and. present(file_dnames)) then
        3096      121344 :         if (is_perm) then
        3097             :           call cam_pio_get_decomp(iodesc, field_lens, file_lens, dtype,       &
        3098             :                this%map, field_dist_in=src_in, file_dist_in=dest_in,          &
        3099           0 :                permute=permutation)
        3100             :         else
        3101             :           call cam_pio_get_decomp(iodesc, field_lens, file_lens, dtype,       &
        3102      121344 :                this%map, field_dist_in=src_in, file_dist_in=dest_in)
        3103             :         end if
        3104      148224 :       else if (present(field_dnames)) then
        3105             :         call cam_pio_get_decomp(iodesc, field_lens, file_lens, dtype,         &
        3106           0 :              this%map, field_dist_in=src_in)
        3107      148224 :       else if (present(file_dnames)) then
        3108             :         call cam_pio_get_decomp(iodesc, field_lens, file_lens, dtype,         &
        3109           0 :              this%map, file_dist_in=dest_in)
        3110             :       else
        3111      148224 :         call cam_pio_get_decomp(iodesc, field_lens, file_lens, dtype, this%map)
        3112             :       end if
        3113             :     end if
        3114      269568 :     if (associated(src_in)) then
        3115      121344 :       deallocate(src_in)
        3116             :       nullify(src_in)
        3117             :     end if
        3118      269568 :     if (associated(dest_in)) then
        3119      121344 :       deallocate(dest_in)
        3120             :       nullify(dest_in)
        3121             :     end if
        3122      269568 :     if (allocated(permutation)) then
        3123      121344 :       deallocate(permutation)
        3124             :     end if
        3125             :
        3126      539136 :   end subroutine cam_grid_get_pio_decomp
        3127             :
        3128             :   !-------------------------------------------------------------------------------
        3129             :   !
        3130             :   !  cam_grid_find_dimids: Find the dimension NetCDF IDs on <File> for this grid
        3131             :   !
        3132             :   !-------------------------------------------------------------------------------
        3133        1536 :   subroutine cam_grid_find_dimids(this, File, dimids)
        3134      269568 :     use pio, only: file_desc_t, pio_noerr, pio_inq_dimid
        3135             :     use pio, only: pio_seterrorhandling, pio_bcast_error
        3136             :
        3137             :     ! Dummy arguments
        3138             :     class(cam_grid_t)                        :: this
        3139             :     type(file_desc_t),         intent(inout) :: File       ! PIO file handle
        3140             :     integer,                   intent(out)   :: dimids(:)
        3141             :
        3142             :     ! Local vaariables
        3143             :     integer                                  :: ierr
        3144             :     integer                                  :: err_handling
        3145             :     character(len=max_hcoordname_len)        :: dimname1, dimname2
        3146             :
        3147             :     ! We will handle errors for this routine
        3148        1536 :     call pio_seterrorhandling(File, PIO_BCAST_ERROR,err_handling)
        3149             :
        3150        1536 :     call this%dim_names(dimname1, dimname2)
        3151        1536 :     if (size(dimids) < 1) then
        3152           0 :       call endrun('CAM_GRID_FIND_DIMIDS: dimids must have positive size')
        3153             :     end if
        3154        6144 :     dimids = -1
        3155             :     ! Check the first dimension
        3156        1536 :     ierr = pio_inq_dimid(File, trim(dimname1), dimids(1))
        3157        1536 :     if(ierr /= PIO_NOERR) then
        3158           0 :       call endrun('CAM_GRID_FIND_DIMIDS: '//trim(this%name)//' dimension, '//trim(dimname1)//', does not exist on file')
        3159             :     end if
        3160        1536 :     if (trim(dimname1) /= trim(dimname2)) then
        3161             :       ! Structured grid, find second dimid
        3162           0 :       if (size(dimids) < 2) then
        3163           0 :         call endrun('CAM_GRID_FIND_DIMIDS: dimids too small for '//trim(this%name))
        3164             :       end if
        3165           0 :       ierr = pio_inq_dimid(File, trim(dimname2), dimids(2))
        3166           0 :       if(ierr /= PIO_NOERR) then
        3167           0 :         call endrun('CAM_GRID_FIND_DIMIDS: '//trim(this%name)//' dimension, '//trim(dimname2)//', does not exist on file')
        3168             :       end if
        3169             :     end if
        3170             :
        3171             :     ! Back to whatever error handling was running before this routine
        3172        1536 :     call pio_seterrorhandling(File, err_handling)
        3173             :
        3174        1536 :   end subroutine cam_grid_find_dimids
        3175             :
        3176             :   !---------------------------------------------------------------------------
        3177             :   !
        3178             :   !  cam_grid_read_darray_2d_int: Read a variable defined on this grid
        3179             :   !
        3180             :   !---------------------------------------------------------------------------
        3181         768 :   subroutine cam_grid_read_darray_2d_int(this, File, adims, fdims, hbuf, varid)
        3182             :     use pio,           only: file_desc_t, io_desc_t, pio_read_darray, PIO_INT
        3183             :     use cam_pio_utils, only: cam_pio_get_decomp
        3184             :
        3185             :     ! Dummy arguments
        3186             :     class(cam_grid_t)                        :: this
        3187             :     type(file_desc_t),         intent(inout) :: File       ! PIO file handle
        3188             :     integer,                   intent(in)    :: adims(:)
        3189             :     integer,                   intent(in)    :: fdims(:)
        3190             :     integer,                   intent(out)   :: hbuf(:,:)
        3191             :     type(var_desc_t),          intent(inout) :: varid
        3192             :
        3193             :     ! Local variables
        3194             :     type(io_desc_t), pointer                 :: iodesc
        3195             :     integer                                  :: ierr
        3196             :
        3197         768 :     call cam_pio_get_decomp(iodesc, adims, fdims, PIO_INT, this%map)
        3198         768 :     call pio_read_darray(File, varid, iodesc, hbuf, ierr)
        3199         768 :     call cam_pio_handle_error(ierr, 'cam_grid_read_darray_2d_int: Error reading variable')
        3200         768 :   end subroutine cam_grid_read_darray_2d_int
        3201             :
        3202             :   !---------------------------------------------------------------------------
        3203             :   !
        3204             :   !  cam_grid_read_darray_3d_int: Read a variable defined on this grid
        3205             :   !
        3206             :   !---------------------------------------------------------------------------
        3207           0 :   subroutine cam_grid_read_darray_3d_int(this, File, adims, fdims, hbuf, varid)
        3208         768 :     use pio,           only: file_desc_t, io_desc_t, pio_read_darray, PIO_INT
        3209             :     use cam_pio_utils, only: cam_pio_get_decomp
        3210             :
        3211             :     ! Dummy arguments
        3212             :     class(cam_grid_t)                        :: this
        3213             :     type(file_desc_t),         intent(inout) :: File       ! PIO file handle
        3214             :     integer,                   intent(in)    :: adims(:)
        3215             :     integer,                   intent(in)    :: fdims(:)
        3216             :     integer,                   intent(out)   :: hbuf(:,:,:)
        3217             :     type(var_desc_t),          intent(inout) :: varid
        3218             :
        3219             :     ! Local variables
        3220             :     type(io_desc_t), pointer                 :: iodesc
        3221             :     integer                                  :: ierr
        3222             :
        3223           0 :     call cam_pio_get_decomp(iodesc, adims, fdims, PIO_INT, this%map)
        3224           0 :     call pio_read_darray(File, varid, iodesc, hbuf, ierr)
        3225           0 :     call cam_pio_handle_error(ierr, 'cam_grid_read_darray_3d_int: Error reading variable')
        3226           0 :   end subroutine cam_grid_read_darray_3d_int
        3227             :
        3228             :   !---------------------------------------------------------------------------
        3229             :   !
        3230             :   !  cam_grid_read_darray_2d_double: Read a variable defined on this grid
        3231             :   !
        3232             :   !---------------------------------------------------------------------------
        3233       19200 :   subroutine cam_grid_read_darray_2d_double(this, File, adims, fdims, hbuf, varid)
        3234           0 :     use pio,           only: file_desc_t, io_desc_t, pio_read_darray
        3235             :     use pio,           only: PIO_DOUBLE
        3236             :     use cam_pio_utils, only: cam_pio_get_decomp
        3237             :
        3238             :     ! Dummy arguments
        3239             :     class(cam_grid_t)                        :: this
        3240             :     type(file_desc_t),         intent(inout) :: File       ! PIO file handle
        3241             :     integer,                   intent(in)    :: adims(:)
        3242             :     integer,                   intent(in)    :: fdims(:)
        3243             :     real(r8),                  intent(out)   :: hbuf(:,:)
        3244             :     type(var_desc_t),          intent(inout) :: varid
        3245             :
        3246             :     ! Local variables
        3247             :     type(io_desc_t), pointer                 :: iodesc
        3248             :     integer                                  :: ierr
        3249             :
        3250       19200 :     call cam_pio_get_decomp(iodesc, adims, fdims, PIO_DOUBLE, this%map)
        3251       19200 :     call pio_read_darray(File, varid, iodesc, hbuf, ierr)
        3252       19200 :     call cam_pio_handle_error(ierr, 'cam_grid_read_darray_2d_double: Error reading variable')
        3253       19200 :   end subroutine cam_grid_read_darray_2d_double
        3254             :
        3255             :   !---------------------------------------------------------------------------
        3256             :   !
        3257             :   !  cam_grid_read_darray_3d_double: Read a variable defined on this grid
        3258             :   !
        3259             :   !---------------------------------------------------------------------------
        3260       83712 :   subroutine cam_grid_read_darray_3d_double(this, File, adims, fdims, hbuf, varid)
        3261       19200 :     use pio,           only: file_desc_t, io_desc_t, pio_read_darray
        3262             :     use pio,           only: PIO_DOUBLE
        3263             :     use cam_pio_utils, only: cam_pio_get_decomp
        3264             :
        3265             :     ! Dummy arguments
        3266             :     class(cam_grid_t)                        :: this
        3267             :     type(file_desc_t),         intent(inout) :: File       ! PIO file handle
        3268             :     integer,                   intent(in)    :: adims(:)
        3269             :     integer,                   intent(in)    :: fdims(:)
        3270             :     real(r8),                  intent(out)   :: hbuf(:,:,:)
        3271             :     type(var_desc_t),          intent(inout) :: varid
        3272             :
        3273             :     ! Local variables
        3274             :     type(io_desc_t), pointer                 :: iodesc
        3275             :     integer                                  :: ierr
        3276             :
        3277       83712 :     call cam_pio_get_decomp(iodesc, adims, fdims, PIO_DOUBLE, this%map)
        3278       83712 :     call pio_read_darray(File, varid, iodesc, hbuf, ierr)
        3279       83712 :     call cam_pio_handle_error(ierr, 'cam_grid_read_darray_3d_double: Error reading variable')
        3280       83712 :   end subroutine cam_grid_read_darray_3d_double
        3281             :
        3282             :   !---------------------------------------------------------------------------
        3283             :   !
        3284             :   !  cam_grid_read_darray_2d_real: Read a variable defined on this grid
        3285             :   !
        3286             :   !---------------------------------------------------------------------------
        3287           0 :   subroutine cam_grid_read_darray_2d_real(this, File, adims, fdims, hbuf, varid)
        3288       83712 :     use pio,           only: file_desc_t, io_desc_t, pio_read_darray
        3289             :     use pio,           only: PIO_REAL
        3290             :     use cam_pio_utils, only: cam_pio_get_decomp
        3291             :
        3292             :     ! Dummy arguments
        3293             :     class(cam_grid_t)                        :: this
        3294             :     type(file_desc_t),         intent(inout) :: File       ! PIO file handle
        3295             :     integer,                   intent(in)    :: adims(:)
        3296             :     integer,                   intent(in)    :: fdims(:)
        3297             :     real(r4),                  intent(out)   :: hbuf(:,:)
        3298             :     type(var_desc_t),          intent(inout) :: varid
        3299             :
        3300             :     ! Local variables
        3301             :     type(io_desc_t), pointer                 :: iodesc
        3302             :     integer                                  :: ierr
        3303             :
        3304           0 :     call cam_pio_get_decomp(iodesc, adims, fdims, PIO_REAL, this%map)
        3305           0 :     call pio_read_darray(File, varid, iodesc, hbuf, ierr)
        3306           0 :     call cam_pio_handle_error(ierr, 'cam_grid_read_darray_2d_real: Error reading variable')
        3307           0 :   end subroutine cam_grid_read_darray_2d_real
        3308             :
        3309             :   !---------------------------------------------------------------------------
        3310             :   !
        3311             :   !  cam_grid_read_darray_3d_real: Read a variable defined on this grid
        3312             :   !
        3313             :   !---------------------------------------------------------------------------
        3314           0 :   subroutine cam_grid_read_darray_3d_real(this, File, adims, fdims, hbuf, varid)
        3315           0 :     use pio,           only: file_desc_t, io_desc_t, pio_read_darray
        3316             :     use pio,           only: PIO_REAL
        3317             :     use cam_pio_utils, only: cam_pio_get_decomp
        3318             :
        3319             :     ! Dummy arguments
        3320             :     class(cam_grid_t)                        :: this
        3321             :     type(file_desc_t),         intent(inout) :: File       ! PIO file handle
        3322             :     integer,                   intent(in)    :: adims(:)
        3323             :     integer,                   intent(in)    :: fdims(:)
        3324             :     real(r4),                  intent(out)   :: hbuf(:,:,:)
        3325             :     type(var_desc_t),          intent(inout) :: varid
        3326             :
        3327             :     ! Local variables
        3328             :     type(io_desc_t), pointer                 :: iodesc
        3329             :     integer                                  :: ierr
        3330             :
        3331           0 :     call cam_pio_get_decomp(iodesc, adims, fdims, PIO_REAL, this%map)
        3332           0 :     call pio_read_darray(File, varid, iodesc, hbuf, ierr)
        3333           0 :     call cam_pio_handle_error(ierr, 'cam_grid_read_darray_2d_: Error reading variable')
        3334           0 :   end subroutine cam_grid_read_darray_3d_real
        3335             :
        3336             :   !---------------------------------------------------------------------------
        3337             :   !
        3338             :   !  cam_grid_write_darray_2d_int: Write a variable defined on this grid
        3339             :   !
        3340             :   !---------------------------------------------------------------------------
        3341        1536 :   subroutine cam_grid_write_darray_2d_int(this, File, adims, fdims, hbuf, varid)
        3342           0 :     use pio,           only: file_desc_t, io_desc_t
        3343             :     use pio,           only: pio_write_darray, PIO_INT
        3344             :
        3345             :     use cam_pio_utils, only: cam_pio_get_decomp
        3346             :
        3347             :     ! Dummy arguments
        3348             :     class(cam_grid_t)                        :: this
        3349             :     type(file_desc_t),         intent(inout) :: File       ! PIO file handle
        3350             :     integer,                   intent(in)    :: adims(:)
        3351             :     integer,                   intent(in)    :: fdims(:)
        3352             :     integer,                   intent(in)    :: hbuf(:,:)
        3353             :     type(var_desc_t),          intent(inout) :: varid
        3354             :
        3355             :     ! Local variables
        3356             :     type(io_desc_t), pointer                 :: iodesc
        3357             :     integer                                  :: ierr
        3358             :
        3359        1536 :     call cam_pio_get_decomp(iodesc, adims, fdims, PIO_INT, this%map)
        3360        1536 :     call pio_write_darray(File, varid, iodesc, hbuf, ierr)
        3361        1536 :     call cam_pio_handle_error(ierr, 'cam_grid_write_darray_2d_int: Error writing variable')
        3362        1536 :   end subroutine cam_grid_write_darray_2d_int
        3363             :
        3364             :   !---------------------------------------------------------------------------
        3365             :   !
        3366             :   !  cam_grid_write_darray_3d_int: Write a variable defined on this grid
        3367             :   !
        3368             :   !---------------------------------------------------------------------------
        3369           0 :   subroutine cam_grid_write_darray_3d_int(this, File, adims, fdims, hbuf, varid)
        3370        1536 :     use pio,           only: file_desc_t, io_desc_t
        3371             :     use pio,           only: pio_write_darray, PIO_INT
        3372             :     use cam_pio_utils, only: cam_pio_get_decomp
        3373             :
        3374             :     ! Dummy arguments
        3375             :     class(cam_grid_t)                        :: this
        3376             :     type(file_desc_t),         intent(inout) :: File       ! PIO file handle
        3377             :     integer,                   intent(in)    :: adims(:)
        3378             :     integer,                   intent(in)    :: fdims(:)
        3379             :     integer,                   intent(in)    :: hbuf(:,:,:)
        3380             :     type(var_desc_t),          intent(inout) :: varid
        3381             :
        3382             :     ! Local variables
        3383             :     type(io_desc_t), pointer                 :: iodesc
        3384             :     integer                                  :: ierr
        3385             :
        3386           0 :     call cam_pio_get_decomp(iodesc, adims, fdims, PIO_INT, this%map)
        3387           0 :     call pio_write_darray(File, varid, iodesc, hbuf, ierr)
        3388           0 :     call cam_pio_handle_error(ierr, 'cam_grid_write_darray_3d_int: Error writing variable')
        3389           0 :   end subroutine cam_grid_write_darray_3d_int
        3390             :
        3391             :   !---------------------------------------------------------------------------
        3392             :   !
        3393             :   !  cam_grid_write_darray_2d_double: Write a variable defined on this grid
        3394             :   !
        3395             :   !---------------------------------------------------------------------------
        3396       38400 :   subroutine cam_grid_write_darray_2d_double(this, File, adims, fdims, hbuf, varid)
        3397           0 :     use pio,           only: file_desc_t, io_desc_t
        3398             :     use pio,           only: pio_write_darray, PIO_DOUBLE
        3399             :     use cam_pio_utils, only: cam_pio_get_decomp
        3400             :
        3401             :     ! Dummy arguments
        3402             :     class(cam_grid_t)                        :: this
        3403             :     type(file_desc_t),         intent(inout) :: File       ! PIO file handle
        3404             :     integer,                   intent(in)    :: adims(:)
        3405             :     integer,                   intent(in)    :: fdims(:)
        3406             :     real(r8),                  intent(in)    :: hbuf(:,:)
        3407             :     type(var_desc_t),          intent(inout) :: varid
        3408             :
        3409             :     ! Local variables
        3410             :     type(io_desc_t), pointer                 :: iodesc
        3411             :     integer                                  :: ierr
        3412             :
        3413       38400 :     call cam_pio_get_decomp(iodesc, adims, fdims, PIO_DOUBLE, this%map)
        3414       38400 :     call pio_write_darray(File, varid, iodesc, hbuf, ierr)
        3415       38400 :     call cam_pio_handle_error(ierr, 'cam_grid_write_darray_2d_double: Error writing variable')
        3416       38400 :   end subroutine cam_grid_write_darray_2d_double
        3417             :
        3418             :   !---------------------------------------------------------------------------
        3419             :   !
        3420             :   !  cam_grid_write_darray_3d_double: Write a variable defined on this grid
        3421             :   !
        3422             :   !---------------------------------------------------------------------------
        3423      167424 :   subroutine cam_grid_write_darray_3d_double(this, File, adims, fdims, hbuf, varid)
        3424       38400 :     use pio,           only: file_desc_t, io_desc_t
        3425             :     use pio,           only: pio_write_darray, PIO_DOUBLE
        3426             :     use cam_pio_utils, only: cam_pio_get_decomp
        3427             :
        3428             :     ! Dummy arguments
        3429             :     class(cam_grid_t)                        :: this
        3430             :     type(file_desc_t),         intent(inout) :: File       ! PIO file handle
        3431             :     integer,                   intent(in)    :: adims(:)
        3432             :     integer,                   intent(in)    :: fdims(:)
        3433             :     real(r8),                  intent(in)    :: hbuf(:,:,:)
        3434             :     type(var_desc_t),          intent(inout) :: varid
        3435             :
        3436             :     ! Local variables
        3437             :     type(io_desc_t), pointer                 :: iodesc
        3438             :     integer                                  :: ierr
        3439             :
        3440      167424 :     call cam_pio_get_decomp(iodesc, adims, fdims, PIO_DOUBLE, this%map)
        3441      167424 :     call pio_write_darray(File, varid, iodesc, hbuf, ierr)
        3442      167424 :     call cam_pio_handle_error(ierr, 'cam_grid_write_darray_3d_double: Error writing variable')
        3443             :
        3444      167424 :   end subroutine cam_grid_write_darray_3d_double
        3445             :
        3446             :   !---------------------------------------------------------------------------
        3447             :   !
        3448             :   !  cam_grid_write_darray_2d_real: Write a variable defined on this grid
        3449             :   !
        3450             :   !---------------------------------------------------------------------------
        3451    25804800 :   subroutine cam_grid_write_darray_2d_real(this, File, adims, fdims, hbuf, varid)
        3452      167424 :     use pio,           only: file_desc_t, io_desc_t
        3453             :     use pio,           only: pio_write_darray, PIO_REAL
        3454             :     use cam_pio_utils, only: cam_pio_get_decomp
        3455             :
        3456             :     ! Dummy arguments
        3457             :     class(cam_grid_t)                        :: this
        3458             :     type(file_desc_t),         intent(inout) :: File       ! PIO file handle
        3459             :     integer,                   intent(in)    :: adims(:)
        3460             :     integer,                   intent(in)    :: fdims(:)
        3461             :     real(r4),                  intent(in)    :: hbuf(:,:)
        3462             :     type(var_desc_t),          intent(inout) :: varid
        3463             :
        3464             :     ! Local variables
        3465             :     type(io_desc_t), pointer                 :: iodesc
        3466             :     integer                                  :: ierr
        3467             :
        3468    25804800 :     call cam_pio_get_decomp(iodesc, adims, fdims, PIO_REAL, this%map)
        3469    25804800 :     call pio_write_darray(File, varid, iodesc, hbuf, ierr)
        3470    25804800 :     call cam_pio_handle_error(ierr, 'cam_grid_write_darray_2d_real: Error writing variable')
        3471    25804800 :   end subroutine cam_grid_write_darray_2d_real
        3472             :
        3473             :   !---------------------------------------------------------------------------
        3474             :   !
        3475             :   !  cam_grid_write_darray_3d_real: Write a variable defined on this grid
        3476             :   !
        3477             :   !---------------------------------------------------------------------------
        3478    16957440 :   subroutine cam_grid_write_darray_3d_real(this, File, adims, fdims, hbuf, varid)
        3479    25804800 :     use pio,           only: file_desc_t, io_desc_t
        3480             :     use pio,           only: pio_write_darray, PIO_REAL
        3481             :     use cam_pio_utils, only: cam_pio_get_decomp
        3482             :
        3483             :     ! Dummy arguments
        3484             :     class(cam_grid_t)                        :: this
        3485             :     type(file_desc_t),         intent(inout) :: File       ! PIO file handle
        3486             :     integer,                   intent(in)    :: adims(:)
        3487             :     integer,                   intent(in)    :: fdims(:)
        3488             :     real(r4),                  intent(in)    :: hbuf(:,:,:)
        3489             :     type(var_desc_t),          intent(inout) :: varid
        3490             :
        3491             :     ! Local variables
        3492             :     type(io_desc_t), pointer                 :: iodesc
        3493             :     integer                                  :: ierr
        3494             :
        3495    16957440 :     nullify(iodesc)
        3496    16957440 :     call cam_pio_get_decomp(iodesc, adims, fdims, PIO_REAL, this%map)
        3497    16957440 :     call pio_write_darray(File, varid, iodesc, hbuf, ierr)
        3498    16957440 :     call cam_pio_handle_error(ierr, 'cam_grid_write_darray_3d_real: Error writing variable')
        3499    16957440 :   end subroutine cam_grid_write_darray_3d_real
        3500             :
        3501             :   !---------------------------------------------------------------------------
        3502             :   !
        3503             :   !  cam_grid_get_patch_mask: Compute a map which is defined for locations
        3504             :   !       within the input patch.
        3505             :   !
        3506             :   !---------------------------------------------------------------------------
        3507           0 :   subroutine cam_grid_get_patch_mask(this, lonl, lonu, latl, latu, patch, cco)
        3508    16957440 :     use spmd_utils,      only: mpi_min, mpi_max, mpi_real8, mpicom
        3509             :     use physconst,       only: pi
        3510             :
        3511             :     ! Dummy arguments
        3512             :     class(cam_grid_t)                     :: this
        3513             :     real(r8),               intent(in)    :: lonl, lonu ! Longitude bounds
        3514             :     real(r8),               intent(in)    :: latl, latu ! Latitude bounds
        3515             :     type(cam_grid_patch_t), intent(inout) :: patch
        3516             :     logical,                intent(in)    :: cco        ! Collect columns?
        3517             :
        3518             :     ! Local arguments
        3519             :     real(r8)                         :: mindist, minlondist
        3520             :     real(r8)                         :: dist, temp1, temp2  ! Test distance calc
        3521             :     real(r8)                         :: londeg, latdeg
        3522             :     real(r8)                         :: lon,    lat
        3523             :     real(r8)                         :: londeg_min, latdeg_min
        3524             :     real(r8)                         :: lonmin, lonmax, latmin, latmax
        3525             :     integer                          :: minind  ! Location of closest point
        3526             :     integer                          :: mapind  ! Grid map index
        3527             :     integer                          :: latind, lonind
        3528             :     integer                          :: ierr    ! For MPI calls
        3529             :     integer                          :: dims(2) ! Global dim sizes
        3530             :     integer                          :: gridloc ! local size of grid
        3531             :     logical                          :: unstructured ! grid type
        3532             :     logical                          :: findClosest  ! .false. == patch output
        3533             :     logical                          :: isMapped     ! .true. iff point in map
        3534             :
        3535             :     real(r8),         parameter      :: maxangle = pi / 4.0_r8
        3536             :     real(r8),         parameter      :: deg2rad = pi / 180.0_r8
        3537             :     real(r8),         parameter      :: maxtol = 0.99999_r8 ! max cos value
        3538             :     real(r8),         parameter      :: maxlat = pi * maxtol / 2.0_r8
        3539             :     character(len=*), parameter      :: subname = 'cam_grid_get_patch_mask'
        3540             :
        3541           0 :     if (.not. associated(this%map)) then
        3542           0 :       call endrun('cam_grid_get_patch_mask: Grid, '//trim(this%name)//', has no map')
        3543             :     end if
        3544           0 :     gridloc = this%map%num_elem()
        3545           0 :     unstructured = this%is_unstructured()
        3546           0 :     call this%coord_lengths(dims)
        3547           0 :     if (associated(patch%mask)) then
        3548           0 :       if (patch%mask%num_elem() /= gridloc) then
        3549             :         ! The mask needs to be the same size as the map
        3550           0 :         call endrun(subname//': mask is incorrect size')
        3551             :         ! No else, just needed a check
        3552             :         ! In particular, we are not zeroing the mask since multiple calls with
        3553             :         ! the same mask can be used for collected-column output
        3554             :         ! NB: Compacting the mask must be done after all calls (for a
        3555             :         !     particular mask) to this function.
        3556             :       end if
        3557           0 :       if (patch%collected_columns .neqv. cco) then
        3558           0 :         call endrun(subname//': collected_column mismatch')
        3559             :       end if
        3560             :     else
        3561           0 :       if (associated(patch%latmap)) then
        3562           0 :         call endrun(subname//': unallocated patch has latmap')
        3563             :       end if
        3564           0 :       if (associated(patch%lonmap)) then
        3565           0 :         call endrun(subname//': unallocated patch has lonmap')
        3566             :       end if
        3567           0 :       call patch%set_patch(lonl, lonu, latl, latu, cco, this%id, this%map)
        3568           0 :       if (patch%mask%num_elem() /= gridloc) then
        3569             :         ! Basic check to make sure the copy worked
        3570           0 :         call endrun(subname//': grid map is invalid')
        3571             :       end if
        3572           0 :       call patch%mask%clear()
        3573             :       ! Set up the lat/lon maps
        3574           0 :       if (cco) then
        3575             :         ! For collected column output, we need to collect coordinates and values
        3576           0 :         allocate(patch%latmap(patch%mask%num_elem()))
        3577           0 :         patch%latmap = 0
        3578           0 :         allocate(patch%latvals(patch%mask%num_elem()))
        3579           0 :         patch%latvals = 91.0_r8
        3580           0 :         allocate(patch%lonmap(patch%mask%num_elem()))
        3581           0 :         patch%lonmap = 0
        3582           0 :         allocate(patch%lonvals(patch%mask%num_elem()))
        3583           0 :         patch%lonvals = 361.0_r8
        3584             :       else
        3585           0 :         if (associated(this%lat_coord%values)) then
        3586           0 :           allocate(patch%latmap(LBOUND(this%lat_coord%values, 1):UBOUND(this%lat_coord%values, 1)))
        3587           0 :           patch%latmap = 0
        3588             :         else
        3589           0 :           nullify(patch%latmap)
        3590             :         end if
        3591           0 :         if (associated(this%lon_coord%values)) then
        3592           0 :           allocate(patch%lonmap(LBOUND(this%lon_coord%values, 1):UBOUND(this%lon_coord%values, 1)))
        3593           0 :           patch%lonmap = 0
        3594             :         else
        3595           0 :           nullify(patch%lonmap)
        3596             :         end if
        3597             :       end if
        3598             :     end if
        3599             :
        3600             :     ! We have to iterate through each grid point to check
        3601             :     ! We have four cases, structured vs. unstructured grid *
        3602             :     !   patch area vs. closest column
        3603             :     ! Note that a 1-d patch 'area' is not allowed for unstructured grids
        3604           0 :     findClosest = .false.
        3605             :     ! Make sure our search items are in order
        3606           0 :     lonmin = min(lonl, lonu)
        3607           0 :     lonmax = max(lonl, lonu)
        3608           0 :     latmin = min(latl, latu)
        3609           0 :     latmax = max(latl, latu)
        3610           0 :     if (lonl == lonu) then
        3611           0 :       if (latl == latu) then
        3612             :         findClosest = .true.
        3613           0 :       else if (unstructured) then
        3614           0 :         call endrun(subname//': 1-D patch (lon) not allowed for unstructured grids')
        3615             :       else
        3616             :         ! Find closest lon line to lonu
        3617             :         ! This is a lat lon grid so it should have coordinate axes
        3618           0 :         lonmin = 365.0_r8
        3619           0 :         mindist = 365.0_r8
        3620           0 :         if (associated(this%lon_coord%values)) then
        3621           0 :           do lonind = LBOUND(this%lon_coord%values, 1), UBOUND(this%lon_coord%values, 1)
        3622           0 :             dist = abs(this%lon_coord%values(lonind) - lonu)
        3623           0 :             if (dist < mindist) then
        3624           0 :               lonmin = this%lon_coord%values(lonind)
        3625           0 :               mindist = dist
        3626             :             end if
        3627             :           end do
        3628             :         end if
        3629             :         ! Get the global minimum
        3630           0 :         dist = mindist
        3631           0 :         call MPI_allreduce(dist, mindist, 1, mpi_real8, mpi_min, mpicom, ierr)
        3632           0 :         if (dist == mindist) then
        3633             :           ! We have a ringer so use only that longitude
        3634             :           lonmax = lonmin
        3635             :         else
        3636             :           ! We don't have a minimum dist so count no points
        3637           0 :           lonmax = lonmin - 1.0_r8
        3638             :         end if
        3639             :       end if
        3640           0 :     else if (latl == latu) then
        3641           0 :       if (unstructured) then
        3642           0 :         call endrun(subname//': 1-D patch (lat) not allowed for unstructured grids')
        3643             :       else
        3644             :         ! Find closest lat line to latu
        3645             :         ! This is a lat lon grid so it should have coordinate axes
        3646           0 :         latmin = 91.0_r8
        3647           0 :         mindist = 181.0_r8
        3648           0 :         if (associated(this%lat_coord%values)) then
        3649           0 :           do latind = LBOUND(this%lat_coord%values, 1), UBOUND(this%lat_coord%values, 1)
        3650           0 :             dist = abs(this%lat_coord%values(latind) - latl)
        3651           0 :             if (dist < mindist) then
        3652           0 :               latmin = this%lat_coord%values(latind)
        3653           0 :               mindist = dist
        3654             :             end if
        3655             :           end do
        3656             :         end if
        3657             :         ! Get the global minimum
        3658           0 :         dist = mindist
        3659           0 :         call MPI_allreduce(dist, mindist, 1, mpi_real8, mpi_min, mpicom, ierr)
        3660           0 :         if (dist == mindist) then
        3661             :           ! We have a ringer so use only that latitude
        3662             :           latmax = latmin
        3663             :         else
        3664             :           ! We don't have a minimum dist so count no points
        3665           0 :           latmax = latmin - 1.0_r8
        3666             :         end if
        3667             :       end if
        3668             :     end if
        3669             :
        3670             :     ! Convert to radians
        3671           0 :     lonmin = lonmin * deg2rad
        3672           0 :     lonmax = lonmax * deg2rad
        3673           0 :     latmin = latmin * deg2rad
        3674           0 :     latmax = latmax * deg2rad
        3675             :     ! Loop through all the local grid elements and find the closest match
        3676             :     ! (or all matches depending on the value of findClosest)
        3677           0 :     minind = -1
        3678           0 :     londeg_min = 361.0_r8
        3679           0 :     latdeg_min = 91.0_r8
        3680           0 :     mindist = 2.0_r8 * pi
        3681             :
        3682           0 :     do mapind = 1, patch%mask%num_elem()
        3683           0 :       call this%get_lon_lat(mapind, londeg, latdeg, isMapped)
        3684           0 :       if (isMapped) then
        3685           0 :         lon = londeg * deg2rad
        3686           0 :         lat = latdeg * deg2rad
        3687           0 :         if (findClosest) then
        3688             :           ! Use the Spherical Law of Cosines to find the great-circle distance.
        3689             :           ! Might as well use the unit sphere since we just want differences
        3690           0 :           if ( (abs(lat - latmin) <= maxangle) .and.                          &
        3691             :                (abs(lon - lonmin) <= maxangle)) then
        3692             :             ! maxangle could be pi but why waste all those trig functions?
        3693             :             ! XXgoldyXX: What should we use for maxangle given coarse Eul grids?
        3694           0 :             if ((lat == latmin) .and. (lon == lonmin)) then
        3695           0 :               dist = 0.0_r8
        3696             :             else
        3697             :               temp1 = (sin(latmin) * sin(lat)) +                              &
        3698           0 :                    (cos(latmin) * cos(lat) * cos(lon - lonmin))
        3699           0 :               if (temp1 > maxtol) then
        3700             :                 ! Use haversine formula
        3701           0 :                 temp1 = sin(latmin - lat)
        3702           0 :                 temp2 = sin((lonmin - lon) / 2.0_r8)
        3703           0 :                 dist = 2.0_r8 * asin((temp1*temp1) + (cos(latmin)*cos(lat)*temp2*temp2))
        3704             :               else
        3705           0 :                 dist = acos(temp1)
        3706             :               end if
        3707             :             end if
        3708           0 :             if ( (dist < mindist) .or.                                        &
        3709             :                  ((dist == mindist) .and.                                     &
        3710             :                   (abs(lon - lonmin) < abs(londeg_min*deg2rad - lonmin)))) then
        3711           0 :               minind = mapind
        3712           0 :               mindist = dist
        3713           0 :               londeg_min = londeg
        3714           0 :               latdeg_min = latdeg
        3715             :             end if
        3716             :           end if
        3717             :         else
        3718             :           if ( (latmin <= lat) .and. (lat <= latmax) .and.                    &
        3719           0 :                (lonmin <= lon) .and. (lon <= lonmax)) then
        3720           0 :             if (patch%mask%num_elem() >= mapind) then
        3721           0 :               if (.not. patch%mask%is_mapped(mapind)) then
        3722           0 :                 call patch%mask%copy_elem(this%map, mapind)
        3723           0 :                 patch%num_points = patch%num_points + 1
        3724           0 :                 if (cco) then
        3725           0 :                   if (patch%num_points > size(patch%latvals, 1)) then
        3726           0 :                     call endrun(subname//': Number of cols larger than mask!?')
        3727             :                   end if
        3728           0 :                   call this%map%coord_dests(mapind, lonind, latind)
        3729           0 :                   if (latind > 0) then
        3730             :                     ! Grid is structured, get unique index
        3731           0 :                     lonind = lonind + (latind * dims(1))
        3732             :                   end if
        3733           0 :                   patch%latmap(patch%num_points) = lonind
        3734           0 :                   patch%latvals(patch%num_points) = latdeg
        3735           0 :                   patch%lonmap(patch%num_points) = lonind
        3736           0 :                   patch%lonvals(patch%num_points) = londeg
        3737           0 :                 else if ((this%block_indexed) .or. unstructured) then
        3738           0 :                   call this%map%coord_dests(mapind, lonind, latind)
        3739           0 :                   if (latind == 0) then
        3740           0 :                     latind = lonind
        3741             :                   end if
        3742           0 :                   if (associated(patch%latmap)) then
        3743           0 :                     patch%latmap(mapind) = latind
        3744             :                   end if
        3745           0 :                   if (associated(patch%lonmap)) then
        3746           0 :                     patch%lonmap(mapind) = lonind
        3747             :                   end if
        3748             :                 else
        3749           0 :                   call this%map%coord_vals(mapind, lonind, latind)
        3750           0 :                   if (associated(patch%latmap)) then
        3751           0 :                     patch%latmap(latind) = latind
        3752             :                   end if
        3753           0 :                   if (associated(patch%lonmap)) then
        3754           0 :                     patch%lonmap(lonind) = lonind
        3755             :                   end if
        3756             :                 end if
        3757             :               ! else do nothing, we already found this point
        3758             :               end if
        3759             :             else
        3760           0 :               call endrun(subname//': PE has patch points but mask too small')
        3761             :             end if
        3762             :           end if
        3763             :         end if ! findClosest
        3764             :       end if ! isMapped
        3765             :     end do
        3766           0 :     if (findClosest) then
        3767             :       ! We need to find the minimum mindist and use only that value
        3768           0 :       dist = mindist
        3769           0 :       call MPI_allreduce(dist, mindist, 1, mpi_real8, mpi_min, mpicom, ierr)
        3770             :       ! Special case for pole points
        3771           0 :       if (latdeg_min > 90.0_r8) then
        3772           0 :         temp1 = 0.0_r8
        3773             :       else
        3774           0 :         temp1 = abs(latdeg_min*deg2rad)
        3775             :       end if
        3776           0 :       call MPI_allreduce(temp1, lat, 1, mpi_real8, mpi_max, mpicom, ierr)
        3777           0 :       if ((abs(latmin) > maxlat) .or. (lat > maxlat)) then
        3778           0 :         if (dist == mindist) then
        3779             :           ! Only distance winners can compete
        3780           0 :           lon = abs(londeg_min - lonl)
        3781             :         else
        3782           0 :           lon = 361.0_r8
        3783             :         end if
        3784           0 :         call MPI_allreduce(lon, minlondist, 1, mpi_real8, mpi_min, mpicom, ierr)
        3785             :         ! Kill the losers
        3786           0 :         if (lon /= minlondist) then
        3787           0 :           dist = dist + 1.0_r8
        3788             :         end if
        3789             :       end if
        3790             :       ! Now, only task(s) which have real minimum distance should set their mask
        3791             :       ! minind test allows for no match
        3792           0 :       if (dist == mindist) then
        3793           0 :         if (minind < 0) then
        3794           0 :           call endrun("cam_grid_get_patch_mask: No closest point found!!")
        3795             :         else
        3796           0 :           if (patch%mask%num_elem() >= minind) then
        3797           0 :             if (.not. patch%mask%is_mapped(minind)) then
        3798           0 :               call patch%mask%copy_elem(this%map, minind)
        3799           0 :               patch%num_points = patch%num_points + 1
        3800           0 :               if (cco) then
        3801           0 :                 if (patch%num_points > size(patch%latvals, 1)) then
        3802           0 :                   call endrun(subname//': Number of columns larger than mask!?')
        3803             :                 end if
        3804           0 :                 call this%map%coord_dests(minind, lonind, latind)
        3805           0 :                 if (latind > 0) then
        3806             :                   ! Grid is structured, get unique index
        3807           0 :                   lonind = lonind + (latind * dims(1))
        3808             :                 end if
        3809           0 :                 patch%latmap(patch%num_points) = lonind
        3810           0 :                 patch%latvals(patch%num_points) = latdeg_min
        3811           0 :                 patch%lonmap(patch%num_points) = lonind
        3812           0 :                 patch%lonvals(patch%num_points) = londeg_min
        3813           0 :               else if ((this%block_indexed) .or. unstructured) then
        3814           0 :                 call this%map%coord_dests(minind, lonind, latind)
        3815           0 :                 if (latind == 0) then
        3816           0 :                   latind = lonind
        3817             :                 end if
        3818           0 :                 if (associated(patch%latmap)) then
        3819           0 :                   patch%latmap(minind) = latind
        3820             :                 end if
        3821           0 :                 if (associated(patch%lonmap)) then
        3822           0 :                   patch%lonmap(minind) = lonind
        3823             :                 end if
        3824             :               else
        3825           0 :                 call this%map%coord_vals(minind, lonind, latind)
        3826           0 :                 if (associated(patch%latmap)) then
        3827           0 :                   patch%latmap(latind) = latind
        3828             :                 end if
        3829           0 :                 if (associated(patch%lonmap)) then
        3830           0 :                   patch%lonmap(lonind) = lonind
        3831             :                 end if
        3832             :               end if
        3833             :               ! else do nothing, we already found this point
        3834             :             end if
        3835             :           else
        3836           0 :             call endrun(subname//': PE has patch closest point but mask too small')
        3837             :           end if
        3838             :         end if
        3839             :       end if
        3840             :     end if ! findClosest
        3841             :
        3842           0 :   end subroutine cam_grid_get_patch_mask
        3843             :
        3844             :   !---------------------------------------------------------------------------
        3845             :   !
        3846             :   !  Grid Patch functions
        3847             :   !
        3848             :   !---------------------------------------------------------------------------
        3849             :
        3850           0 :   integer function cam_grid_patch_get_id(this) result(id)
        3851             :
        3852             :     ! Dummy argument
        3853             :     class(cam_grid_patch_t)                  :: this
        3854             :
        3855           0 :     id = this%grid_id
        3856           0 :   end function cam_grid_patch_get_id
        3857             :
        3858           0 :   subroutine cam_grid_patch_get_global_size_map(this, gsize)
        3859             :
        3860             :     ! Dummy arguments
        3861             :     class(cam_grid_patch_t),   intent(in)    :: this
        3862             :     integer,                   intent(out)   :: gsize
        3863             :
        3864           0 :     gsize = this%global_size
        3865             :
        3866           0 :   end subroutine cam_grid_patch_get_global_size_map
        3867             :
        3868           0 :   subroutine cam_grid_patch_get_global_size_axes(this, latsize, lonsize)
        3869             :
        3870             :     ! Dummy arguments
        3871             :     class(cam_grid_patch_t),   intent(in)    :: this
        3872             :     integer,                   intent(out)   :: latsize
        3873             :     integer,                   intent(out)   :: lonsize
        3874             :
        3875           0 :     latsize = this%global_lat_size
        3876           0 :     lonsize = this%global_lon_size
        3877             :
        3878           0 :   end subroutine cam_grid_patch_get_global_size_axes
        3879             :
        3880             :   ! cam_grid_patch_get_axis_names
        3881             :   !   Collect or compute unique names for the latitude and longitude axes
        3882             :   !   If the grid is unstructured or col_output is .true., the column
        3883             :   !     dimension name is also generated (e.g., ncol)
        3884           0 :   subroutine cam_grid_patch_get_axis_names(this, lat_name, lon_name,          &
        3885             :        col_name, col_output)
        3886             :
        3887             :     ! Dummy arguments
        3888             :     class(cam_grid_patch_t)                  :: this
        3889             :     character(len=*),          intent(out)   :: lat_name
        3890             :     character(len=*),          intent(out)   :: lon_name
        3891             :     character(len=*),          intent(out)   :: col_name
        3892             :     logical,                   intent(in)    :: col_output
        3893             :
        3894             :     ! Local variable
        3895             :     integer                                  :: index
        3896             :     character(len=120)                       :: errormsg
        3897             :     character(len=max_hcoordname_len)        :: grid_name
        3898             :     logical                                  :: unstruct
        3899             :
        3900           0 :     if (cam_grid_check(this%grid_id)) then
        3901           0 :       index = this%grid_index()
        3902           0 :       unstruct = cam_grids(index)%is_unstructured()
        3903             :       ! Get coordinate and dim names
        3904           0 :       call cam_grids(index)%lat_coord%get_coord_name(lat_name)
        3905           0 :       call cam_grids(index)%lon_coord%get_coord_name(lon_name)
        3906           0 :       grid_name = cam_grids(index)%name
        3907           0 :       if (col_output .or. unstruct) then
        3908             :         ! In this case, we are using collect_column_output on a lat/lon grid
        3909           0 :         col_name = 'ncol_'//trim(grid_name)
        3910           0 :         lat_name = trim(lat_name)//'_'//trim(grid_name)
        3911           0 :         lon_name = trim(lon_name)//'_'//trim(grid_name)
        3912             :       else
        3913             :         ! Separate patch output for a lat/lon grid
        3914           0 :         col_name = ''
        3915           0 :         lat_name = trim(lat_name)//'_'//trim(grid_name)
        3916           0 :         lon_name = trim(lon_name)//'_'//trim(grid_name)
        3917             :       end if
        3918             :     else
        3919           0 :       write(errormsg, *) 'Bad grid ID:', this%grid_id
        3920           0 :       call endrun('cam_grid_patch_get_axis_names: '//errormsg)
        3921             :     end if
        3922             :
        3923           0 :   end subroutine cam_grid_patch_get_axis_names
        3924             :
        3925           0 :   subroutine cam_grid_patch_get_coord_long_name(this, axis, name)
        3926             :
        3927             :     ! Dummy arguments
        3928             :     class(cam_grid_patch_t)                  :: this
        3929             :     character(len=*),          intent(in)    :: axis
        3930             :     character(len=*),          intent(out)   :: name
        3931             :
        3932             :     ! Local variable
        3933             :     character(len=120)               :: errormsg
        3934             :     integer                          :: index
        3935             :
        3936           0 :     if (cam_grid_check(this%grid_id)) then
        3937           0 :       index = this%grid_index()
        3938           0 :       if (trim(axis) == 'lat') then
        3939           0 :         call cam_grids(index)%lat_coord%get_long_name(name)
        3940           0 :       else if (trim(axis) == 'lon') then
        3941           0 :         call cam_grids(index)%lon_coord%get_long_name(name)
        3942             :       else
        3943           0 :         write(errormsg, *) 'Bad axis name:', axis
        3944           0 :         call endrun('cam_grid_patch_get_coord_long_name: '//errormsg)
        3945             :       end if
        3946             :     else
        3947           0 :       write(errormsg, *) 'Bad grid ID:', this%grid_id
        3948           0 :       call endrun('cam_grid_patch_get_coord_long_name: '//errormsg)
        3949             :     end if
        3950             :
        3951           0 :   end subroutine cam_grid_patch_get_coord_long_name
        3952             :
        3953           0 :   subroutine cam_grid_patch_get_coord_units(this, axis, units)
        3954             :
        3955             :     ! Dummy arguments
        3956             :     class(cam_grid_patch_t)                  :: this
        3957             :     character(len=*),          intent(in)    :: axis
        3958             :     character(len=*),          intent(out)   :: units
        3959             :
        3960             :     ! Local variable
        3961             :     character(len=120)               :: errormsg
        3962             :     integer                          :: index
        3963             :
        3964           0 :     if (cam_grid_check(this%grid_id)) then
        3965           0 :       index = this%grid_index()
        3966           0 :       if (trim(axis) == 'lat') then
        3967           0 :         call cam_grids(index)%lat_coord%get_units(units)
        3968           0 :       else if (trim(axis) == 'lon') then
        3969           0 :         call cam_grids(index)%lon_coord%get_units(units)
        3970             :       else
        3971           0 :         write(errormsg, *) 'Bad axis name:', axis
        3972           0 :         call endrun('cam_grid_patch_get_coord_units: '//errormsg)
        3973             :       end if
        3974             :     else
        3975           0 :       write(errormsg, *) 'Bad grid ID:', this%grid_id
        3976           0 :       call endrun('cam_grid_patch_get_coord_units: '//errormsg)
        3977             :     end if
        3978             :
        3979           0 :   end subroutine cam_grid_patch_get_coord_units
        3980             :
        3981           0 :   subroutine cam_grid_patch_set_patch(this, lonl, lonu, latl, latu, cco, id, map)
        3982             :
        3983             :     ! Dummy arguments
        3984             :     class(cam_grid_patch_t)            :: this
        3985             :     real(r8),               intent(in) :: lonl, lonu ! Longitude bounds
        3986             :     real(r8),               intent(in) :: latl, latu ! Latitude bounds
        3987             :     logical,                intent(in) :: cco        ! Collect columns?
        3988             :     integer,                intent(in) :: id
        3989             :     type(cam_filemap_t),    intent(in) :: map
        3990             :
        3991           0 :     this%grid_id           = id
        3992           0 :     this%lon_range(1)      = lonl
        3993           0 :     this%lon_range(2)      = lonu
        3994           0 :     this%lat_range(1)      = latl
        3995           0 :     this%lat_range(2)      = latu
        3996           0 :     this%collected_columns = cco
        3997           0 :     if (.not. associated(this%mask)) then
        3998           0 :       allocate(this%mask)
        3999             :     end if
        4000           0 :     call this%mask%copy(map)
        4001           0 :     call this%mask%new_index()
        4002             :
        4003           0 :   end subroutine cam_grid_patch_set_patch
        4004             :
        4005           0 :   subroutine cam_grid_patch_get_decomp(this, field_lens, file_lens, dtype,    &
        4006           0 :        iodesc, file_dest_in)
        4007             :     use pio,                only: io_desc_t
        4008             :     use cam_pio_utils,      only: cam_pio_get_decomp
        4009             :
        4010             :     ! Dummy arguments
        4011             :     class(cam_grid_patch_t)                  :: this
        4012             :     integer,                   intent(in)    :: field_lens(:)
        4013             :     integer,                   intent(in)    :: file_lens(:)
        4014             :     integer,                   intent(in)    :: dtype
        4015             :     type(io_desc_t), pointer,  intent(out)   :: iodesc
        4016             :     integer,         optional, intent(in)    :: file_dest_in(:)
        4017             :
        4018             :     call cam_pio_get_decomp(iodesc, field_lens, file_lens, dtype, this%mask,  &
        4019           0 :          file_dist_in=file_dest_in)
        4020             :
        4021           0 :   end subroutine cam_grid_patch_get_decomp
        4022             :
        4023           0 :   subroutine cam_grid_patch_compact(this, collected_output)
        4024             :
        4025             :     ! Dummy arguments
        4026             :     class(cam_grid_patch_t)               :: this
        4027             :     logical,         optional, intent(in) :: collected_output
        4028             :
        4029             :     ! Local variables
        4030             :     integer                               :: index ! Our grid's index
        4031             :     logical                               :: dups_ok
        4032             :
        4033           0 :     index = this%grid_index()
        4034           0 :     if (index > 0) then
        4035           0 :       dups_ok = cam_grids(index)%is_unstructured()
        4036             :     else
        4037             :       ! This is probably an error condition but someone else will catch it first
        4038           0 :       dups_ok = .false.
        4039             :     end if
        4040           0 :     if (present(collected_output)) then
        4041           0 :       dups_ok = dups_ok .or. collected_output
        4042             :     end if
        4043             :     call this%mask%compact(this%lonmap, this%latmap,                          &
        4044             :          num_lons=this%global_lon_size, num_lats=this%global_lat_size,        &
        4045             :          num_mapped=this%global_size, columnize=collected_output,             &
        4046           0 :          dups_ok_in=dups_ok)
        4047             :
        4048           0 :   end subroutine cam_grid_patch_compact
        4049             :
        4050           0 :   subroutine cam_grid_patch_get_active_cols(this, lchnk, active, srcdim_in)
        4051             :
        4052             :     ! Dummy arguments
        4053             :     class(cam_grid_patch_t)                    :: this
        4054             :     integer,                    intent(in)     :: lchnk
        4055             :     logical,                    intent(out)    :: active(:)
        4056             :     integer, optional,          intent(in)     :: srcdim_in
        4057             :
        4058           0 :     if (.not. associated(this%mask)) then
        4059           0 :       call endrun('cam_grid_patch_get_active_cols: No mask')
        4060             :     else
        4061           0 :       call this%mask%active_cols(lchnk, active, srcdim_in)
        4062             :     end if
        4063             :
        4064           0 :   end subroutine cam_grid_patch_get_active_cols
        4065             :
        4066             :   ! cam_grid_patch_write_vals: Write lat and lon coord values to File
        4067           0 :   subroutine cam_grid_patch_write_vals(this, File, header_info)
        4068             :     use pio,           only: file_desc_t, io_desc_t
        4069             :     use pio,           only: pio_write_darray, PIO_DOUBLE
        4070             :     use pio,           only: pio_initdecomp, pio_freedecomp
        4071             :     use cam_pio_utils, only: cam_pio_handle_error, pio_subsystem
        4072             :
        4073             :     ! Dummy arguments
        4074             :     class(cam_grid_patch_t)                     :: this
        4075             :     type(file_desc_t),            intent(inout) :: File       ! PIO file handle
        4076             :     type(cam_grid_header_info_t), intent(inout) :: header_info
        4077             :
        4078             :     ! Local variables
        4079             :     type(io_desc_t)                             :: iodesc
        4080             :     type(var_desc_t), pointer                   :: vdesc
        4081           0 :     real(r8),         pointer                   :: coord_p(:)
        4082           0 :     real(r8),         pointer                   :: coord(:)
        4083           0 :     integer(iMap),    pointer                   :: map(:)
        4084             :     integer                                     :: field_lens(1)
        4085             :     integer                                     :: file_lens(1)
        4086             :     integer                                     :: ierr
        4087             :
        4088           0 :     nullify(vdesc)
        4089           0 :     nullify(coord_p)
        4090           0 :     nullify(coord)
        4091           0 :     nullify(map)
        4092           0 :     if (this%grid_id /= header_info%get_gridid()) then
        4093           0 :       call endrun('CAM_GRID_PATCH_WRITE_VALS: Grid id mismatch')
        4094             :     end if
        4095             :     ! Write out lon
        4096           0 :     if (associated(this%lonmap)) then
        4097           0 :       field_lens(1) = size(this%lonmap, 1)
        4098           0 :       map => this%lonmap
        4099             :     else
        4100           0 :       field_lens(1) = 0
        4101           0 :       allocate(map(0))
        4102             :     end if
        4103           0 :     file_lens(1) = this%global_lon_size
        4104             :     !! XXgoldyXX: Think about caching these decomps
        4105           0 :     call pio_initdecomp(pio_subsystem, pio_double, file_lens, map, iodesc)
        4106           0 :     if (associated(this%lonvals)) then
        4107           0 :       coord => this%lonvals
        4108             :     else
        4109           0 :       coord_p => cam_grid_get_lonvals(this%grid_id)
        4110           0 :       if (associated(coord_p)) then
        4111           0 :         coord => coord_p
        4112             :       else
        4113           0 :         allocate(coord(0))
        4114             :       end if
        4115             :     end if
        4116           0 :     vdesc => header_info%get_lon_varid()
        4117           0 :     call pio_write_darray(File, vdesc, iodesc, coord, ierr)
        4118           0 :     call cam_pio_handle_error(ierr, 'cam_grid_patch_write_vals: Error writing longitude')
        4119           0 :     if (.not. associated(this%lonmap)) then
        4120           0 :       deallocate(map)
        4121             :       nullify(map)
        4122             :     end if
        4123           0 :     if (.not. (associated(coord_p) .or. associated(this%lonvals))) then
        4124           0 :       deallocate(coord)
        4125             :       nullify(coord)
        4126             :     end if
        4127           0 :     call pio_freedecomp(File, iodesc)
        4128             :     ! Write out lat
        4129           0 :     if (associated(this%latmap)) then
        4130           0 :       field_lens(1) = size(this%latmap, 1)
        4131           0 :       map => this%latmap
        4132             :     else
        4133           0 :       field_lens(1) = 0
        4134           0 :       allocate(map(0))
        4135             :     end if
        4136           0 :     file_lens(1) = this%global_lat_size
        4137             :     !! XXgoldyXX: Think about caching these decomps
        4138           0 :     call pio_initdecomp(pio_subsystem, pio_double, file_lens, map, iodesc)
        4139             :
        4140           0 :     if (associated(this%latvals)) then
        4141           0 :       coord => this%latvals
        4142             :     else
        4143           0 :       coord_p => cam_grid_get_latvals(this%grid_id)
        4144           0 :       if (associated(coord_p)) then
        4145           0 :         coord => coord_p
        4146             :       else
        4147           0 :         allocate(coord(0))
        4148             :       end if
        4149             :     end if
        4150           0 :     vdesc => header_info%get_lat_varid()
        4151           0 :     call pio_write_darray(File, vdesc, iodesc, coord, ierr)
        4152           0 :     call cam_pio_handle_error(ierr, 'cam_grid_patch_write_vals: Error writing latitude')
        4153           0 :     if (.not. associated(this%latmap)) then
        4154           0 :       deallocate(map)
        4155             :       nullify(map)
        4156             :     end if
        4157           0 :     if (.not. (associated(coord_p) .or. associated(this%latvals))) then
        4158           0 :       deallocate(coord)
        4159             :       nullify(coord)
        4160             :     end if
        4161           0 :     call pio_freedecomp(File, iodesc)
        4162             :
        4163           0 :   end subroutine cam_grid_patch_write_vals
        4164             :
        4165           0 :   integer function cam_grid_patch_get_grid_index(this) result(index)
        4166             :     ! Dummy argument
        4167             :     class(cam_grid_patch_t)                  :: this
        4168             :
        4169             :     ! Local variable
        4170             :     integer                                  :: i
        4171             :
        4172           0 :     index = -1
        4173             :     ! Find the grid index associated with our grid_id which is a decomp
        4174           0 :     do i = 1, cam_grid_num_grids()
        4175           0 :       if (cam_grids(i)%id == this%grid_id) then
        4176             :         index = i
        4177             :         exit
        4178             :       end if
        4179             :     end do
        4180             :
        4181           0 :   end function cam_grid_patch_get_grid_index
        4182             :
        4183           0 :   subroutine cam_grid_patch_deallocate(this)
        4184             :     ! Dummy argument
        4185             :     class(cam_grid_patch_t)                  :: this
        4186             :
        4187           0 :     if (associated(this%mask)) then
        4188           0 :       deallocate(this%mask)
        4189           0 :       nullify(this%mask)
        4190             :     end if
        4191             :
        4192           0 :   end subroutine cam_grid_patch_deallocate
        4193             :
        4194    42762240 :   integer function cam_grid_header_info_get_gridid(this) result(id)
        4195             :     ! Dummy argument
        4196             :     class(cam_grid_header_info_t)           :: this
        4197             :
        4198    42762240 :     id = this%grid_id
        4199             :
        4200    42762240 :   end function cam_grid_header_info_get_gridid
        4201             :
        4202           0 :   subroutine cam_grid_header_info_set_gridid(this, id)
        4203             :     ! Dummy argument
        4204             :     class(cam_grid_header_info_t)            :: this
        4205             :     integer,                      intent(in) :: id
        4206             :
        4207           0 :     this%grid_id = id
        4208             :
        4209           0 :   end subroutine cam_grid_header_info_set_gridid
        4210             :
        4211           0 :   subroutine cam_grid_header_info_set_hdims(this, hdim1, hdim2)
        4212             :     ! Dummy arguments
        4213             :     class(cam_grid_header_info_t)                :: this
        4214             :     integer,                       intent(in)    :: hdim1
        4215             :     integer, optional,             intent(in)    :: hdim2
        4216             :
        4217             :     ! Local variables
        4218             :     integer                                      :: hdsize
        4219             :
        4220           0 :     if (present(hdim2)) then
        4221             :       hdsize = 2
        4222             :     else
        4223           0 :       hdsize = 1
        4224             :     end if
        4225             :
        4226           0 :     if (allocated(this%hdims)) then
        4227             :       ! This can happen, for instance on opening a new version of the file
        4228           0 :       if (size(this%hdims) /= hdsize) then
        4229           0 :         call endrun('cam_grid_header_info_set_hdims: hdims is wrong size')
        4230             :       end if
        4231             :     else
        4232           0 :       allocate(this%hdims(hdsize))
        4233             :     end if
        4234           0 :     this%hdims(1) = hdim1
        4235           0 :     if (present(hdim2)) then
        4236           0 :       this%hdims(2) = hdim2
        4237             :     end if
        4238             :
        4239           0 :   end subroutine cam_grid_header_info_set_hdims
        4240             :
        4241    42763776 :   integer function cam_grid_header_info_num_hdims(this) result(num)
        4242             :     ! Dummy argument
        4243             :     class(cam_grid_header_info_t)           :: this
        4244             :
        4245    42763776 :     if (allocated(this%hdims)) then
        4246    42763776 :       num = size(this%hdims)
        4247             :     else
        4248             :       num = 0
        4249             :     end if
        4250             :
        4251    42763776 :   end function cam_grid_header_info_num_hdims
        4252             :
        4253    42765312 :   integer function cam_grid_header_info_hdim(this, index) result(id)
        4254             :     ! Dummy arguments
        4255             :     class(cam_grid_header_info_t)               :: this
        4256             :     integer,                      intent(in)    :: index
        4257             :
        4258             :     ! Local variable
        4259             :     character(len=120)               :: errormsg
        4260             :
        4261    42765312 :     if (allocated(this%hdims)) then
        4262    42765312 :       if ((index >= 1) .and. (index <= size(this%hdims))) then
        4263    42765312 :         id = this%hdims(index)
        4264             :       else
        4265           0 :         write(errormsg, '(a,i0,a)') 'Index out of range, (',index,')'
        4266           0 :         call endrun('cam_grid_header_info_hdim: '//errormsg)
        4267             :       end if
        4268             :     else
        4269           0 :       write(errormsg, '(a)') 'No hdims allocated'
        4270           0 :       call endrun('cam_grid_header_info_hdim: '//errormsg)
        4271             :     end if
        4272             :
        4273    42765312 :   end function cam_grid_header_info_hdim
        4274             :
        4275           0 :   subroutine cam_grid_header_info_set_varids(this, lon_varid, lat_varid)
        4276             :
        4277             :     ! Dummy arguments
        4278             :     class(cam_grid_header_info_t)             :: this
        4279             :     type(var_desc_t),              pointer    :: lon_varid
        4280             :     type(var_desc_t),              pointer    :: lat_varid
        4281             :
        4282           0 :     if (associated(this%lon_varid)) then
        4283           0 :       deallocate(this%lon_varid)
        4284           0 :       nullify(this%lon_varid)
        4285             :     end if
        4286           0 :     this%lon_varid => lon_varid
        4287           0 :     if (associated(this%lat_varid)) then
        4288           0 :       deallocate(this%lat_varid)
        4289           0 :       nullify(this%lat_varid)
        4290             :     end if
        4291           0 :     this%lat_varid => lat_varid
        4292             :
        4293           0 :   end subroutine cam_grid_header_info_set_varids
        4294             :
        4295           0 :   function cam_grid_header_info_lon_varid(this) result(id)
        4296             :
        4297             :     ! Dummy arguments
        4298             :     class(cam_grid_header_info_t)               :: this
        4299             :     type(var_desc_t),   pointer                 :: id
        4300             :
        4301           0 :     id => this%lon_varid
        4302             :
        4303           0 :   end function cam_grid_header_info_lon_varid
        4304             :
        4305           0 :   function cam_grid_header_info_lat_varid(this) result(id)
        4306             :
        4307             :     ! Dummy arguments
        4308             :     class(cam_grid_header_info_t)               :: this
        4309             :     type(var_desc_t),   pointer                 :: id
        4310             :
        4311           0 :     id => this%lat_varid
        4312             :
        4313           0 :   end function cam_grid_header_info_lat_varid
        4314             :
        4315      122880 :   subroutine cam_grid_header_info_deallocate(this)
        4316             :     ! Dummy argument
        4317             :     class(cam_grid_header_info_t)           :: this
        4318             :
        4319      122880 :     this%grid_id = -1
        4320      122880 :     if (allocated(this%hdims)) then
        4321      122880 :       deallocate(this%hdims)
        4322             :     end if
        4323      122880 :     if (associated(this%lon_varid)) then
        4324           0 :       deallocate(this%lon_varid)
        4325           0 :       nullify(this%lon_varid)
        4326             :     end if
        4327      122880 :     if (associated(this%lat_varid)) then
        4328           0 :       deallocate(this%lat_varid)
        4329           0 :       nullify(this%lat_varid)
        4330             :     end if
        4331             :
        4332      122880 :   end subroutine cam_grid_header_info_deallocate
        4333             :
        4334           0 : end module cam_grid_support

Generated by: LCOV version 1.14