LCOV - code coverage report
Current view: | top level - chemistry/mozart - mo_setinv.F90 (source / functions) |  |  | Hit | Total | Coverage
Test: | coverage.info |  | Lines: | 0 | 48 | 0.0 %
Date: | 2024-12-17 17:57:11 |  | Functions: | 0 | 2 | 0.0 %

              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

Generated by: LCOV version 1.14