LCOV - code coverage report
Current view: | top level - infrastructure - phys_grid.F90 (source / functions) |  |  | Hit | Total | Coverage
Test: | coverage.info |  | Lines: | 210 | 386 | 54.4 %
Date: | 2024-12-17 22:39:59 |  | Functions: | 15 | 31 | 48.4 %

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

Generated by: LCOV version 1.14