LCOV - code coverage report
Current view: | top level - physics/cam - subcol_pack_mod.F90.in (source / functions) |  |  | Hit | Total | Coverage
Test: | coverage.info |  | Lines: | 8 | 92 | 8.7 %
Date: | 2024-12-17 17:57:11 |  | Functions: | 1 | 43 | 2.3 %

              Line data    Source code
           1             : module subcol_pack_mod
           2             :   !---------------------------------------------------------------------------
           3             :   ! Purpose:
           4             :   !
           5             :   ! Provides utilities to pack and unpack subcolumns
           6             :   !
           7             :   !---------------------------------------------------------------------------
           8             :
           9             :   use shr_kind_mod,    only: r8=>shr_kind_r8, r4=>shr_kind_r4, i4=>shr_kind_i4
          10             :   use infnan,          only: nan, assignment(=)
          11             :   use cam_abortutils,  only: endrun
          12             :   use ppgrid,          only: pcols, psubcols
          13             :   use pio,             only: var_desc_t
          14             :
          15             :   implicit none
          16             :
          17             :   private
          18             :   save
          19             :
          20             :   public :: subcol_unpack           ! Unpack a subcolumn field
          21             :   public :: subcol_pack             ! Pack a subcolumn field
          22             :   public :: subcol_get_nsubcol      ! Copy chunk from nsubcol2d
          23             :   public :: subcol_set_nsubcol      ! Copy chunk to nsubcol2d
          24             :   public :: subcol_get_indcol       ! Copy chunk from indcol2d
          25             :   public :: subcol_pack_allocate    ! Allocate subcol packing arrays
          26             :   public :: subcol_pack_init_restart
          27             :   public :: subcol_pack_write_restart
          28             :   public :: subcol_pack_read_restart
          29             :
          30             :   !! Private variable to provide default packing and unpacking of fields
          31             :   !! for use in restart functionality. Allocated as (pcols, begchunk:endchunk)
          32             :   integer, target, allocatable :: nsubcol2d(:,:)
          33             :   integer, target, allocatable :: indcol2d(:,:)
          34             :
          35             :   interface subcol_pack
          36             :      ! TYPE int,double,real
          37             :      ! DIMS 1,2,3,4,5,6
          38             :      module procedure subcol_pack_{DIMS}d_{TYPE}
          39             :   end interface subcol_pack
          40             :
          41             :   interface subcol_unpack
          42             :      ! TYPE int,double,real
          43             :      ! DIMS 1,2,3,4,5,6
          44             :      module procedure subcol_unpack_{DIMS}d_{TYPE}
          45             :   end interface subcol_unpack
          46             :
          47             :   type(var_desc_t) :: nsubcol_desc
          48             :
          49             : contains
          50             :
          51         768 :   subroutine subcol_pack_allocate()
          52             :     use ppgrid,          only: begchunk, endchunk
          53             :     !-----------------------------------------------------------------------
          54             :     ! Allocate nsubcol2d and indcol2d
          55             :     !-----------------------------------------------------------------------
          56         768 :     if (allocated(nsubcol2d)) then
          57           0 :        deallocate(nsubcol2d)
          58             :     end if
          59        2304 :     allocate(nsubcol2d(pcols, begchunk:endchunk))
          60       53400 :     nsubcol2d = 0
          61             :
          62         768 :     if (allocated(indcol2d)) then
          63           0 :        deallocate(indcol2d)
          64             :     end if
          65        2304 :     allocate(indcol2d(pcols*psubcols, begchunk:endchunk))
          66       53400 :     indcol2d = 0
          67         768 :   end subroutine subcol_pack_allocate
          68             :
          69           0 :   subroutine subcol_pack_init_restart(File, hdimids)
          70             :
          71             :     use pio,           only: file_desc_t, pio_int
          72             :     use cam_pio_utils, only: cam_pio_def_var
          73             :
          74             :     ! Dummy arguments
          75             :     type(file_desc_t), intent(inout) :: File
          76             :     integer,           intent(in)    :: hdimids(:)
          77             :
          78           0 :     call cam_pio_def_var(File, 'NSUBCOL2D', pio_int, hdimids, nsubcol_desc)
          79           0 :   end subroutine subcol_pack_init_restart
          80             :
          81           0 :   subroutine subcol_pack_write_restart(File, grid_id, fdimlens)
          82           0 :     use cam_grid_support, only: cam_grid_write_dist_array
          83             :     use ppgrid,           only: begchunk, endchunk
          84             :     use pio,              only: file_desc_t
          85             :
          86             :     ! Dummy argument
          87             :     type(file_desc_t), intent(inout) :: File
          88             :     integer,           intent(in)    :: grid_id
          89             :     integer,           intent(in)    :: fdimlens(:)
          90             :
          91             :     ! Local variables
          92             :     integer                          :: adimlens(2)
          93             :     character(len=*), parameter      :: subname = 'SUBCOL_PACK_WRITE_RESTART'
          94             :
          95             :     ! Write nsubcol2d
          96           0 :     adimlens(1) = size(nsubcol2d, 1)
          97           0 :     adimlens(2) = endchunk - begchunk + 1
          98             :     call cam_grid_write_dist_array(File, grid_id, adimlens(1:2),              &
          99           0 :          fdimlens(:), nsubcol2d, nsubcol_desc)
         100           0 :   end subroutine subcol_pack_write_restart
         101             :
         102           0 :   subroutine subcol_pack_read_restart(File, grid_id, fdimlens)
         103           0 :     use pio,              only: file_desc_t, pio_inq_varid
         104             :     use cam_pio_utils,    only: cam_pio_handle_error
         105             :     use cam_grid_support, only: cam_grid_read_dist_array
         106             :     use ppgrid,           only: begchunk, endchunk
         107             :     use phys_grid,        only: get_ncols_p
         108             :
         109             :     ! Dummy argument
         110             :     type(file_desc_t), intent(inout) :: File
         111             :     integer,           intent(in)    :: grid_id
         112             :     integer,           intent(in)    :: fdimlens(:)
         113             :
         114             :     integer                          :: ierr, c
         115             :     integer                          :: adimlens(3)
         116             :     integer                          :: ncols
         117             :     character(len=*), parameter      :: subname = 'SUBCOL_PACK_READ_RESTART'
         118             :
         119             :     ! Array dimensions
         120           0 :     adimlens(1) = size(nsubcol2d, 1)
         121           0 :     adimlens(2) = endchunk - begchunk + 1
         122             :     ! Find nsubcol2d and read it in
         123           0 :     ierr = pio_inq_varid(File, 'NSUBCOL2D', nsubcol_desc)
         124           0 :     call cam_pio_handle_error(ierr, trim(subname)//': NSUBCOL2D not found')
         125             :     call cam_grid_read_dist_array(File, grid_id, adimlens(1:2),              &
         126           0 :          fdimlens(:), nsubcol2d, nsubcol_desc)
         127             :
         128             :
         129             :      ! We need to update indcol2d so set nsubcol2d to itself
         130           0 :      do c = begchunk, endchunk
         131           0 :        ncols = get_ncols_p(c)
         132           0 :        if(ncols < pcols) nsubcol2d(ncols+1:pcols,:) = 0
         133           0 :        call subcol_set_nsubcol(c, pcols, nsubcol2d(:, c))
         134             :      end do
         135             :
         136           0 :   end subroutine subcol_pack_read_restart
         137             :
         138           0 :   subroutine subcol_get_nsubcol(lchnk, nsubcol)
         139             :     !-----------------------------------------------------------------------
         140             :     ! Retrieve a chunk from the nsubcol module variable
         141             :     !-----------------------------------------------------------------------
         142             :
         143             :     integer,    intent(in)    :: lchnk
         144             :     integer,    intent(out)   :: nsubcol(:)
         145             :
         146           0 :     if (.not. allocated(nsubcol2d)) then
         147           0 :        call endrun('subcol_get_nsubcol: nsubcol2d not allocated')
         148             :     end if
         149           0 :     nsubcol(:) = nsubcol2d(:,lchnk)
         150           0 :   end subroutine subcol_get_nsubcol
         151             :
         152           0 :   subroutine subcol_get_indcol(lchnk, indcol)
         153             :     !-----------------------------------------------------------------------
         154             :     ! Retrieve a chunk from the nsubcol module variable
         155             :     !-----------------------------------------------------------------------
         156             :
         157             :     integer,    intent(in)    :: lchnk
         158             :     integer,    intent(out)   :: indcol(:)
         159             :
         160           0 :     if (.not. allocated(indcol2d)) then
         161           0 :        call endrun('subcol_get_indcol: indcol2d not allocated')
         162             :     end if
         163           0 :     indcol(:) = indcol2d(:,lchnk)
         164           0 :   end subroutine subcol_get_indcol
         165             :
         166           0 :   subroutine subcol_set_nsubcol(lchnk, ngrdcol, nsubcol)
         167             :     use cam_logfile,      only : iulog
         168             :     !-----------------------------------------------------------------------
         169             :     ! Set a chunk of the nsubcol module variable
         170             :     ! Also, recompute indcol for lchnk
         171             :     !-----------------------------------------------------------------------
         172             :
         173             :     integer,    intent(in)    :: lchnk
         174             :     integer,    intent(in)    :: ngrdcol
         175             :     integer,    intent(in)    :: nsubcol(:)
         176             :
         177             :     integer                   :: i, j, indx
         178             :
         179           0 :     if (any(nsubcol(:) > psubcols)) then
         180           0 :        write(iulog, *) __FILE__,__LINE__,psubcols, nsubcol
         181           0 :        call endrun('subcol_set_nsubcol: psubcols not set large enough to hold the number of subcolumns requested')
         182             :     end if
         183           0 :     if (any(nsubcol(:) < 0)) then
         184           0 :        call endrun('subcol_set_nsubcol: nsubcols must be non-negative')
         185             :     end if
         186           0 :     if (ngrdcol < pcols) then
         187           0 :        if (any(nsubcol(ngrdcol+1:) > 0)) then
         188           0 :           call endrun('subcol_set_nsubcol: Cannot set subcolumns for columns past ngrdcol')
         189             :        end if
         190             :     end if
         191           0 :     nsubcol2d(:, lchnk) = nsubcol(:)
         192             :     ! Recalculate indcol for the chunk
         193             :     indx = 1
         194           0 :     do i = 1, pcols
         195           0 :        do j = 1, nsubcol2d(i, lchnk)
         196           0 :           indcol2d(indx, lchnk) = i
         197           0 :           indx = indx + 1
         198             :        end do
         199             :     end do
         200             :     ! Fill with zeros
         201           0 :     if (indx <= pcols * psubcols) then
         202           0 :        indcol2d(indx:pcols*psubcols, lchnk) = 0
         203             :     end if
         204           0 :   end subroutine subcol_set_nsubcol
         205             :
         206             :   ! TYPE int,double,real
         207             :   ! DIMS 1,2,3,4,5,6
         208           0 :   subroutine subcol_pack_{DIMS}d_{TYPE}(lchnk, field, field_sc)
         209             :     !-----------------------------------------------------------------------
         210             :     ! Pack the field defined on (pcols, psubcols, *) into (pcols*psubcols, *)
         211             :     ! Packing is done accoding to the values in the proper chunk from nsubcol2d
         212             :     !-----------------------------------------------------------------------
         213             :
         214             :     integer, intent(in)                     :: lchnk            ! Chunk index
         215             : #if ({DIMS} == 1)
         216             :     {VTYPE}, intent(in)                     :: field(:,:)           ! grid
         217             : #elif ({DIMS} == 2)
         218             :     {VTYPE}, intent(in)                     :: field(:,:,:)         ! grid
         219             : #elif ({DIMS} == 3)
         220             :     {VTYPE}, intent(in)                     :: field(:,:,:,:)       ! grid
         221             : #elif ({DIMS} == 4)
         222             :     {VTYPE}, intent(in)                     :: field(:,:,:,:,:)     ! grid
         223             : #elif ({DIMS} == 5)
         224             :     {VTYPE}, intent(in)                     :: field(:,:,:,:,:,:)   ! grid
         225             : #elif ({DIMS} == 6)
         226             :     {VTYPE}, intent(in)                     :: field(:,:,:,:,:,:,:) ! grid
         227             : #endif
         228             :     {VTYPE}, intent(out)                    :: field_sc{DIMSTR}     ! subcols
         229             :
         230             :     !
         231             :     ! Local variables
         232             :     !
         233             :     integer           :: indx, i, j
         234             :     integer           :: nsubcol(pcols)
         235             :
         236           0 :     call subcol_get_nsubcol(lchnk, nsubcol)
         237           0 :     indx = 1
         238           0 :     do i=1, pcols
         239           0 :        do j = 1, nsubcol(i)
         240             : #if ({DIMS} == 1)
         241           0 :           field_sc(indx) = field(i, j)
         242             : #elif ({DIMS} == 2)
         243           0 :           field_sc(indx, :) = field(i, j, :)
         244             : #elif ({DIMS} == 3)
         245           0 :           field_sc(indx, :, :) = field(i, j, :, :)
         246             : #elif ({DIMS} == 4)
         247           0 :           field_sc(indx, :, :, :) = field(i, j, :, :, :)
         248             : #elif ({DIMS} == 5)
         249           0 :           field_sc(indx, :, :, :, :) = field(i, j, :, :, :, :)
         250             : #elif ({DIMS} == 6)
         251           0 :           field_sc(indx, :, :, :, :, :) = field(i, j, :, :, :, :, :)
         252             : #endif
         253           0 :           indx = indx + 1
         254             :        end do
         255             :     end do
         256           0 :   end subroutine subcol_pack_{DIMS}d_{TYPE}
         257             :
         258             :   ! TYPE int,double,real
         259             :   ! DIMS 1,2,3,4,5,6
         260           0 :   subroutine subcol_unpack_{DIMS}d_{TYPE}(lchnk, field_sc, field, fillvalue)
         261             :     !-----------------------------------------------------------------------
         262             :     ! UnPack the field defined on (pcols*psubcols, *) into (pcols, psubcols, *)
         263             :     ! Unpacking is done accoding to the values in the proper chunk from nsubcol2d
         264             :     ! If fillvalue is present, unused entries in field are set.
         265             :     ! NB: The output field is not initialized, if fillvalue is not passed, it
         266             :     !     will end up with undefined values for columns where nsubcol < psubcols
         267             :     !-----------------------------------------------------------------------
         268             :
         269             :     integer, intent(in)                     :: lchnk            ! Chunk index
         270             :     {VTYPE}, intent(in)                     :: field_sc{DIMSTR}     ! subcols
         271             : #if ({DIMS} == 1)
         272             :     {VTYPE}, intent(out)                    :: field(:,:)           ! grid
         273             : #elif ({DIMS} == 2)
         274             :     {VTYPE}, intent(out)                    :: field(:,:,:)         ! grid
         275             : #elif ({DIMS} == 3)
         276             :     {VTYPE}, intent(out)                    :: field(:,:,:,:)       ! grid
         277             : #elif ({DIMS} == 4)
         278             :     {VTYPE}, intent(out)                    :: field(:,:,:,:,:)     ! grid
         279             : #elif ({DIMS} == 5)
         280             :     {VTYPE}, intent(out)                    :: field(:,:,:,:,:,:)   ! grid
         281             : #elif ({DIMS} == 6)
         282             :     {VTYPE}, intent(out)                    :: field(:,:,:,:,:,:,:) ! grid
         283             : #endif
         284             :     {VTYPE}, intent(in), optional           :: fillvalue            ! fil
         285             :
         286             :     !
         287             :     ! Local variables
         288             :     !
         289             :     integer           :: indx, i, j
         290             :     integer           :: nsubcol(pcols)
         291             :
         292           0 :     call subcol_get_nsubcol(lchnk, nsubcol)
         293           0 :     indx = 1
         294           0 :     do i=1, pcols
         295           0 :        do j = 1, nsubcol(i)
         296             : #if ({DIMS} == 1)
         297           0 :           field(i, j) = field_sc(indx)
         298             : #elif ({DIMS} == 2)
         299           0 :           field(i, j, :) = field_sc(indx, :)
         300             : #elif ({DIMS} == 3)
         301           0 :           field(i, j, :, :) = field_sc(indx, :, :)
         302             : #elif ({DIMS} == 4)
         303           0 :           field(i, j, :, :, :) = field_sc(indx, :, :, :)
         304             : #elif ({DIMS} == 5)
         305           0 :           field(i, j, :, :, :, :) = field_sc(indx, :, :, :, :)
         306             : #elif ({DIMS} == 6)
         307           0 :           field(i, j, :, :, :, :, :) = field_sc(indx, :, :, :, :, :)
         308             : #endif
         309           0 :           indx = indx + 1
         310             :        end do
         311           0 :        if (present(fillvalue)) then
         312           0 :           do j = nsubcol(i) + 1, psubcols
         313             : #if ({DIMS} == 1)
         314           0 :              field(i, j) = fillvalue
         315             : #elif ({DIMS} == 2)
         316           0 :              field(i, j, :) = fillvalue
         317             : #elif ({DIMS} == 3)
         318           0 :              field(i, j, :, :) = fillvalue
         319             : #elif ({DIMS} == 4)
         320           0 :              field(i, j, :, :, :) = fillvalue
         321             : #elif ({DIMS} == 5)
         322           0 :              field(i, j, :, :, :, :) = fillvalue
         323             : #elif ({DIMS} == 6)
         324           0 :              field(i, j, :, :, :, :, :) = fillvalue
         325             : #endif
         326             :           end do
         327             :        end if
         328             :     end do
         329           0 :   end subroutine subcol_unpack_{DIMS}d_{TYPE}
         330             :
         331             : end module subcol_pack_mod

Generated by: LCOV version 1.14