Line data    Source code

       1             : 
       2             : module mo_setinv
       3             : 
       4             :   use shr_kind_mod, only : r8 => shr_kind_r8
       5             :   use cam_logfile,  only : iulog
       6             :   use chem_mods,    only : inv_lst, nfs, gas_pcnst
       7             :   use cam_history,  only : addfld, outfld
       8             :   use ppgrid,       only : pcols, pver
       9             : 
      10             :   implicit none
      11             : 
      12             :   save
      13             : 
      14             :   integer :: id_o, id_o2, id_h
      15             :   integer :: m_ndx, o2_ndx, n2_ndx, h2o_ndx, o3_ndx
      16             :   logical :: has_o2, has_n2, has_h2o, has_o3, has_var_o2
      17             : 
      18             :   private
      19             :   public :: setinv_inti, setinv, has_h2o, o2_ndx, h2o_ndx, n2_ndx
      20             : 
      21             : contains
      22             : 
      23           0 :   subroutine setinv_inti
      24             :     !-----------------------------------------------------------------
      25             :     !        ... initialize the module
      26             :     !-----------------------------------------------------------------
      27             : 
      28             :     use mo_chem_utls, only : get_inv_ndx, get_spc_ndx
      29             :     use spmd_utils,   only : masterproc
      30             : 
      31             :     implicit none
      32             : 
      33             :     integer :: i
      34             : 
      35           0 :     m_ndx   = get_inv_ndx( 'M' )
      36           0 :     n2_ndx  = get_inv_ndx( 'N2' )
      37           0 :     o2_ndx  = get_inv_ndx( 'O2' )
      38           0 :     h2o_ndx = get_inv_ndx( 'H2O' )
      39           0 :     o3_ndx  = get_inv_ndx( 'O3' )
      40             : 
      41           0 :     id_o  = get_spc_ndx('O')
      42           0 :     id_o2 = get_spc_ndx('O2')
      43           0 :     id_h  = get_spc_ndx('H')
      44             : 
      45           0 :     has_var_o2 = id_o2>0 .and. id_o>0 .and. id_h>0
      46             : 
      47           0 :     has_n2  = n2_ndx > 0
      48           0 :     has_o2  = o2_ndx > 0
      49           0 :     has_h2o = h2o_ndx > 0
      50           0 :     has_o3  = o3_ndx > 0
      51             : 
      52           0 :     if (masterproc) write(iulog,*) 'setinv_inti: m,n2,o2,h2o ndx = ',m_ndx,n2_ndx,o2_ndx,h2o_ndx
      53             : 
      54           0 :     do i = 1,nfs
      55           0 :       call addfld( trim(inv_lst(i))//'_dens', (/ 'lev' /),'A', 'molecules/cm3', 'invariant density' )
      56             :       !call addfld( trim(inv_lst(i))//'_mmr',  (/ 'lev' /),'A', 'kg/kg', 'invariant density' )
      57           0 :       call addfld( trim(inv_lst(i))//'_vmr',  (/ 'lev' /),'A', 'mole/mole', 'invariant density' )
      58             :     enddo
      59             :       
      60           0 :   end subroutine setinv_inti
      61             : 
      62           0 :   subroutine setinv( invariants, tfld, h2ovmr, vmr, pmid, ncol, lchnk, pbuf )
      63             :     !-----------------------------------------------------------------
      64             :     !        ... set the invariant densities (molecules/cm**3)
      65             :     !-----------------------------------------------------------------
      66             : 
      67             :     use mo_constants,  only : boltz_cgs, n2min
      68             :     use tracer_cnst,   only : num_tracer_cnst, tracer_cnst_flds, get_cnst_data
      69             :     use mo_chem_utls,  only : get_inv_ndx
      70             :     use physics_buffer, only : physics_buffer_desc
      71             : 
      72             :     implicit none
      73             : 
      74             :     !-----------------------------------------------------------------
      75             :     !        ... dummy arguments
      76             :     !-----------------------------------------------------------------
      77             :     integer,  intent(in)  ::      ncol                      ! chunk column count
      78             :     real(r8), intent(in)  ::      tfld(pcols,pver)          ! temperature
      79             :     real(r8), intent(in)  ::      h2ovmr(ncol,pver)         ! water vapor vmr
      80             :     real(r8), intent(in)  ::      pmid(pcols,pver)          ! pressure
      81             :     integer,  intent(in)  ::      lchnk                     ! chunk number
      82             :     real(r8), intent(in)  ::      vmr(ncol,pver,gas_pcnst)  ! vmr
      83             :     real(r8), intent(out) ::      invariants(ncol,pver,nfs) ! invariant array
      84             :     type(physics_buffer_desc), pointer :: pbuf(:)
      85             : 
      86             : 
      87           0 :     real(r8) :: cnst_offline( ncol, pver )
      88             : 
      89             :     !-----------------------------------------------------------------
      90             :     !        .. local variables
      91             :     !-----------------------------------------------------------------
      92             :     integer :: k, i, ndx
      93             :     real(r8), parameter ::  Pa_xfac = 10._r8                 ! Pascals to dyne/cm^2
      94           0 :     real(r8) :: n2vmr(ncol)
      95           0 :     real(r8) :: tmp_out(ncol,pver)
      96             : 
      97             :     !-----------------------------------------------------------------
      98             :     !        note: invariants are in cgs density units.
      99             :     !              the pmid array is in pascals and must be
     100             :     !          mutiplied by 10. to yield dynes/cm**2.
     101             :     !-----------------------------------------------------------------
     102           0 :     invariants(:,:,:) = 0._r8
     103             :     !-----------------------------------------------------------------
     104             :     !   ... set m, n2, o2, and h2o densities
     105             :     !-----------------------------------------------------------------
     106           0 :     do k = 1,pver
     107           0 :        invariants(:ncol,k,m_ndx) = Pa_xfac * pmid(:ncol,k) / (boltz_cgs*tfld(:ncol,k))
     108             :     end do
     109             : 
     110           0 :     if( has_n2 ) then
     111           0 :        if ( has_var_o2 ) then
     112             :           do k = 1,pver
     113           0 :              n2vmr(:ncol) = 1._r8 - (vmr(:ncol,k,id_o) + vmr(:ncol,k,id_o2) + vmr(:ncol,k,id_h))
     114             :              where (n2vmr(:ncol)<n2min)
     115             :                 n2vmr = n2min
     116             :              end where
     117             :              invariants(:ncol,k,n2_ndx) = n2vmr(:ncol) * invariants(:ncol,k,m_ndx)
     118             :           end do
     119             :        else
     120           0 :           do k = 1,pver
     121           0 :              invariants(:ncol,k,n2_ndx) = .79_r8 * invariants(:ncol,k,m_ndx)
     122             :           end do
     123             :        endif
     124             :     end if
     125           0 :     if( has_o2 ) then
     126           0 :        do k = 1,pver
     127           0 :           invariants(:ncol,k,o2_ndx) = .21_r8 * invariants(:ncol,k,m_ndx)
     128             :        end do
     129             :     end if
     130           0 :     if( has_h2o ) then
     131           0 :        do k = 1,pver
     132           0 :           invariants(:ncol,k,h2o_ndx) = h2ovmr(:ncol,k) * invariants(:ncol,k,m_ndx)
     133             :        end do
     134             :     end if
     135             : 
     136           0 :     do i = 1,num_tracer_cnst
     137             : 
     138           0 :        call get_cnst_data( tracer_cnst_flds(i), cnst_offline,  ncol, lchnk, pbuf )
     139           0 :        ndx =  get_inv_ndx( tracer_cnst_flds(i) )
     140             : 
     141           0 :        do k = 1,pver
     142           0 :           invariants(:ncol,k,ndx) = cnst_offline(:ncol,k)*invariants(:ncol,k,m_ndx)
     143             :        enddo
     144             : 
     145             :     enddo
     146             : 
     147           0 :     do i = 1,nfs
     148           0 :       tmp_out(:ncol,:) =  invariants(:ncol,:,i) 
     149           0 :       call outfld( trim(inv_lst(i))//'_dens', tmp_out(:ncol,:), ncol, lchnk )
     150           0 :       tmp_out(:ncol,:) =  invariants(:ncol,:,i) / invariants(:ncol,:,m_ndx)
     151           0 :       call outfld( trim(inv_lst(i))//'_vmr',  tmp_out(:ncol,:), ncol, lchnk )
     152             :     enddo
     153             : 
     154           0 :   end subroutine setinv
     155             : 
     156             : end module mo_setinv