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