LCOV - code coverage report
Current view: | top level - chemistry/mozart - short_lived_species.F90 (source / functions) |  |  | Hit | Total | Coverage
Test: | coverage.info |  | Lines: | 23 | 30 | 76.7 %
Date: | 2024-12-17 22:39:59 |  | Functions: | 8 | 10 | 80.0 %

              Line data    Source code
           1             : !---------------------------------------------------------------------
           2             : ! Manages the storage of non-transported short-lived chemical species
           3             : ! in the physics buffer.
           4             : !
           5             : ! Created by: Francis Vitt -- 20 Aug 2008
           6             : !---------------------------------------------------------------------
           7             : module short_lived_species
           8             :
           9             :   use shr_kind_mod, only : r8 => shr_kind_r8
          10             :   use chem_mods,    only : slvd_lst, nslvd, gas_pcnst
          11             :   use cam_logfile,  only : iulog
          12             :   use ppgrid,       only : pcols, pver, begchunk, endchunk
          13             :   use spmd_utils,   only : masterproc
          14             :
          15             :   implicit none
          16             :
          17             :   save
          18             :   private
          19             :   public :: map
          20             :   public :: register_short_lived_species
          21             :   public :: short_lived_species_initic
          22             :   public :: short_lived_species_writeic
          23             :   public :: initialize_short_lived_species
          24             :   public :: set_short_lived_species
          25             :   public :: set_short_lived_species_gc ! for GEOS-Chem chemistry
          26             :   public :: get_short_lived_species
          27             :   public :: get_short_lived_species_gc ! for GEOS-Chem chemistry
          28             :   public :: slvd_index
          29             :   public :: pbf_idx
          30             :   public :: short_lived_species_final
          31             :
          32             :   integer :: pbf_idx
          33             :   integer :: map(nslvd)
          34             :
          35             :   character(len=*), parameter :: pbufname = 'ShortLivedSpecies'
          36             :
          37             :   real(r8), allocatable :: slvd_ref_mmr(:)
          38             :
          39             : contains
          40             :
          41             : !---------------------------------------------------------------------
          42             : !---------------------------------------------------------------------
          43        1536 :   subroutine register_short_lived_species (ref_mmr)
          44             :     use physics_buffer, only : pbuf_add_field, dtype_r8
          45             :
          46             :     real(r8), optional :: ref_mmr(nslvd)
          47             :
          48             :     if ( nslvd < 1 ) return
          49             :
          50             :     if ( present(ref_mmr) ) then
          51             :        allocate(slvd_ref_mmr(nslvd))
          52             :        slvd_ref_mmr = ref_mmr
          53             :     endif
          54             :
          55             :     call pbuf_add_field(pbufname,'global',dtype_r8,(/pcols,pver,nslvd/),pbf_idx)
          56             :
          57        1536 :   end subroutine register_short_lived_species
          58             :
          59             : !---------------------------------------------------------------------
          60             : !---------------------------------------------------------------------
          61        1536 :   subroutine short_lived_species_initic
          62             : #ifdef WACCMX_PHYS
          63             :     use cam_history, only : addfld, add_default
          64             :
          65             :     integer :: m
          66             :     character(len=24) :: varname
          67             :
          68             :     do m=1,nslvd
          69             :        varname = trim(slvd_lst(m))//'&IC'
          70             :        call addfld (varname, (/ 'lev' /),'I','kg/kg',trim(varname)//' not-transported species',gridname='physgrid')
          71             :        call add_default (varname,0, 'I')
          72             :     enddo
          73             : #endif
          74        1536 :   end subroutine short_lived_species_initic
          75             :
          76             : !---------------------------------------------------------------------
          77             : !---------------------------------------------------------------------
          78     1489176 :   subroutine short_lived_species_writeic( lchnk, pbuf )
          79             :     use cam_history,    only : outfld, write_inithist
          80             :     use physics_buffer, only : physics_buffer_desc, pbuf_get_field
          81             :
          82             :     integer       , intent(in) :: lchnk  ! chunk identifier
          83             :     type(physics_buffer_desc), pointer :: pbuf(:)
          84             : #ifdef WACCMX_PHYS
          85             :     real(r8),pointer :: tmpptr(:,:)
          86             :     integer :: m
          87             :     character(len=24) :: varname
          88             :
          89             :     if ( write_inithist() ) then
          90             :        do m=1,nslvd
          91             :           varname = trim(slvd_lst(m))//'&IC'
          92             :           call pbuf_get_field(pbuf, pbf_idx, tmpptr, start=(/1,1,m/), kount=(/ pcols,pver,1 /))
          93             :           call outfld(varname, tmpptr, pcols,lchnk)
          94             :        enddo
          95             :     endif
          96             : #endif
          97     1489176 :   end subroutine short_lived_species_writeic
          98             :
          99             : !---------------------------------------------------------------------
         100             : !---------------------------------------------------------------------
         101         768 :   subroutine initialize_short_lived_species(ncid_ini, pbuf2d)
         102     1489176 :     use cam_grid_support, only : cam_grid_check, cam_grid_id
         103             :     use cam_grid_support, only : cam_grid_get_dim_names
         104             :     use cam_abortutils,   only : endrun
         105             :     use mo_tracname,      only : solsym
         106             :     use ncdio_atm,        only : infld
         107             :     use pio,              only : file_desc_t
         108             :     use phys_control,     only : cam_chempkg_is
         109             :     use physics_buffer,   only : physics_buffer_desc, pbuf_set_field
         110             :
         111             :     implicit none
         112             :
         113             :     type(file_desc_t), intent(inout) :: ncid_ini
         114             :     type(physics_buffer_desc), pointer :: pbuf2d(:,:)
         115             :
         116             :     integer          :: m,n
         117             :     integer          :: grid_id
         118             :     character(len=8) :: fieldname
         119             :     character(len=4) :: dim1name, dim2name
         120             :     logical          :: found
         121         768 :     real(r8),pointer :: tmpptr(:,:,:)   ! temporary pointer
         122             :     character(len=*), parameter :: subname='INITIALIZE_SHORT_LIVED_SPECIES'
         123             :
         124             :     if ( nslvd < 1 ) return
         125             :
         126             :     found = .false.
         127             :
         128             :     grid_id = cam_grid_id('physgrid')
         129             :     if (.not. cam_grid_check(grid_id)) then
         130             :       call endrun(trim(subname)//': Internal error, no "physgrid" grid')
         131             :     end if
         132             :     call cam_grid_get_dim_names(grid_id, dim1name, dim2name)
         133             :
         134             :     call pbuf_set_field(pbuf2d, pbf_idx, 0._r8)
         135             :
         136             :     allocate(tmpptr(pcols,pver,begchunk:endchunk))
         137             :
         138             :     do m=1,nslvd
         139             :
         140             :        if (cam_chempkg_is('geoschem_mam4')) then
         141             :           fieldname = trim(slvd_lst(m))
         142             :        else
         143             :           n = map(m)
         144             :           fieldname = solsym(n)
         145             :        end if
         146             :
         147             :        call infld( fieldname,ncid_ini,dim1name, 'lev', dim2name, 1, pcols, 1, pver, begchunk, endchunk, &
         148             :                    tmpptr, found, gridname='physgrid')
         149             :
         150             :        if (.not.found) then
         151             :           if ( allocated(slvd_ref_mmr) ) then
         152             :              tmpptr(:,:,:) = slvd_ref_mmr(m)
         153             :           else
         154             :              tmpptr(:,:,:) = 1.e-36_r8
         155             :           endif
         156             :        endif
         157             :
         158             :        call pbuf_set_field(pbuf2d, pbf_idx, tmpptr, start=(/1,1,m/),kount=(/pcols,pver,1/))
         159             :
         160             :        if (masterproc) write(iulog,*)  fieldname, ' is set to short-lived'
         161             :
         162             :        if ( allocated(slvd_ref_mmr) .and. masterproc) write(iulog,'(a, E16.5E4)') ' --> reference MMR: ', slvd_ref_mmr(m)
         163             :
         164             :     enddo
         165             :
         166             :     deallocate(tmpptr)
         167             :
         168         768 :   end subroutine initialize_short_lived_species
         169             :
         170             : !---------------------------------------------------------------------
         171             : !---------------------------------------------------------------------
         172     1489176 :   subroutine set_short_lived_species( q, lchnk, ncol, pbuf )
         173             :
         174         768 :     use physics_buffer, only : physics_buffer_desc, pbuf_set_field
         175             :
         176             :     implicit none
         177             :
         178             :     real(r8), intent(in)               :: q(pcols,pver,gas_pcnst)
         179             :     integer,  intent(in)               :: lchnk, ncol
         180             :     type(physics_buffer_desc), pointer :: pbuf(:)
         181             :
         182             :     integer :: m,n
         183             :
         184             :     if ( nslvd < 1 ) return
         185             :
         186             :     do m=1,nslvd
         187             :        n = map(m)
         188             :        call pbuf_set_field(pbuf, pbf_idx, q(:,:,n), start=(/1,1,m/),kount=(/pcols,pver,1/))
         189             :     enddo
         190             :
         191     1489176 :   end subroutine set_short_lived_species
         192             :
         193             : !---------------------------------------------------------------------
         194             : !---------------------------------------------------------------------
         195           0 :   subroutine set_short_lived_species_gc( q, lchnk, ncol, pbuf )
         196             :
         197     1489176 :     use physics_buffer, only : physics_buffer_desc, pbuf_set_field
         198             :
         199             :     implicit none
         200             :
         201             :     ! 3rd dimension of out array is nslvd if using GEOS-Chem chemistry
         202             :     real(r8), intent(in)               :: q(pcols,pver,nslvd)
         203             :     integer,  intent(in)               :: lchnk, ncol
         204             :     type(physics_buffer_desc), pointer :: pbuf(:)
         205             :
         206             :     integer :: m
         207             :
         208             :     if ( nslvd < 1 ) return
         209             :
         210             :     do m=1,nslvd
         211             :        call pbuf_set_field(pbuf, pbf_idx, q(:,:,m), start=(/1,1,m/),kount=(/pcols,pver,1/))
         212             :     enddo
         213             :
         214           0 :   end subroutine set_short_lived_species_gc
         215             :
         216             : !---------------------------------------------------------------------
         217             : !---------------------------------------------------------------------
         218     1489176 :   subroutine get_short_lived_species( q, lchnk, ncol, pbuf )
         219           0 :     use physics_buffer, only : physics_buffer_desc, pbuf_get_field
         220             :
         221             :     implicit none
         222             :
         223             :     real(r8), intent(inout)            :: q(pcols,pver,gas_pcnst)
         224             :     integer,  intent(in)               :: lchnk, ncol
         225             :     type(physics_buffer_desc), pointer :: pbuf(:)
         226     1489176 :     real(r8),pointer                   :: tmpptr(:,:)
         227             :
         228             :
         229             :     integer :: m,n
         230             :
         231             :     if ( nslvd < 1 ) return
         232             :
         233             :     do m=1,nslvd
         234             :        n = map(m)
         235             :        call pbuf_get_field(pbuf, pbf_idx, tmpptr, start=(/1,1,m/), kount=(/ pcols,pver,1 /))
         236             :        q(:ncol,:,n) = tmpptr(:ncol,:)
         237             :     enddo
         238             :
         239     1489176 :   endsubroutine get_short_lived_species
         240             :
         241             : !---------------------------------------------------------------------
         242             : !---------------------------------------------------------------------
         243           0 :   subroutine get_short_lived_species_gc( q, lchnk, ncol, pbuf )
         244     1489176 :     use physics_buffer, only : physics_buffer_desc, pbuf_get_field
         245             :
         246             :     implicit none
         247             :
         248             :     ! 3rd dimension of out array is nslvd if using GEOS-Chem chemistry
         249             :     real(r8), intent(inout)            :: q(pcols,pver,nslvd)
         250             :     integer,  intent(in)               :: lchnk, ncol
         251             :     type(physics_buffer_desc), pointer :: pbuf(:)
         252           0 :     real(r8),pointer                   :: tmpptr(:,:)
         253             :
         254             :
         255             :     integer :: m
         256             :
         257             :     if ( nslvd < 1 ) return
         258             :
         259             :     do m=1,nslvd
         260             :        call pbuf_get_field(pbuf, pbf_idx, tmpptr, start=(/1,1,m/), kount=(/ pcols,pver,1 /))
         261             :        q(:ncol,:,m) = tmpptr(:ncol,:)
         262             :     enddo
         263             :
         264           0 :   endsubroutine get_short_lived_species_gc
         265             :
         266             : !---------------------------------------------------------------------
         267             : !---------------------------------------------------------------------
         268       46080 :   function slvd_index( name )
         269             :     implicit none
         270             :
         271             :     character(len=*) :: name
         272             :     integer :: slvd_index
         273             :
         274             :     integer :: m
         275             :
         276       46080 :     slvd_index = -1
         277             :
         278             :     if ( nslvd < 1 ) return
         279             :
         280             :     do m=1,nslvd
         281             :        if ( name == slvd_lst(m) ) then
         282             :           slvd_index = m
         283             :           return
         284             :        endif
         285             :     enddo
         286             :
         287           0 :   endfunction slvd_index
         288             :
         289             : !---------------------------------------------------------------------
         290             : !---------------------------------------------------------------------
         291        1536 :   subroutine short_lived_species_final
         292             :
         293        1536 :     if ( allocated(slvd_ref_mmr) ) deallocate(slvd_ref_mmr)
         294             :
         295        1536 :   end subroutine short_lived_species_final
         296             :
         297             : end module short_lived_species

Generated by: LCOV version 1.14