LCOV - code coverage report
Current view: | top level - chemistry/mozart - mo_setinv.F90 (source / functions) |  |  | Hit | Total | Coverage
Test: | coverage.info |  | Lines: | 45 | 51 | 88.2 %
Date: | 2024-12-17 22:39:59 |  | Functions: | 2 | 2 | 100.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     1490712 :   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        1536 :     m_ndx   = get_inv_ndx( 'M' )
          36        1536 :     n2_ndx  = get_inv_ndx( 'N2' )
          37        1536 :     o2_ndx  = get_inv_ndx( 'O2' )
          38        1536 :     h2o_ndx = get_inv_ndx( 'H2O' )
          39        1536 :     o3_ndx  = get_inv_ndx( 'O3' )
          40             :
          41        1536 :     id_o  = get_spc_ndx('O')
          42        1536 :     id_o2 = get_spc_ndx('O2')
          43        1536 :     id_h  = get_spc_ndx('H')
          44             :
          45        1536 :     has_var_o2 = id_o2>0 .and. id_o>0 .and. id_h>0
          46             :
          47        1536 :     has_n2  = n2_ndx > 0
          48        1536 :     has_o2  = o2_ndx > 0
          49        1536 :     has_h2o = h2o_ndx > 0
          50        1536 :     has_o3  = o3_ndx > 0
          51             :
          52        1536 :     if (masterproc) write(iulog,*) 'setinv_inti: m,n2,o2,h2o ndx = ',m_ndx,n2_ndx,o2_ndx,h2o_ndx
          53             :
          54       13824 :     do i = 1,nfs
          55       24576 :       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       26112 :       call addfld( trim(inv_lst(i))//'_vmr',  (/ 'lev' /),'A', 'mole/mole', 'invariant density' )
          58             :     enddo
          59             :
          60        1536 :   end subroutine setinv_inti
          61             :
          62     1489176 :   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     2978352 :     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     2978352 :     real(r8) :: n2vmr(ncol)
          95     1489176 :     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 18513539928 :     invariants(:,:,:) = 0._r8
         103             :     !-----------------------------------------------------------------
         104             :     !   ... set m, n2, o2, and h2o densities
         105             :     !-----------------------------------------------------------------
         106   139982544 :     do k = 1,pver
         107  2314006344 :        invariants(:ncol,k,m_ndx) = Pa_xfac * pmid(:ncol,k) / (boltz_cgs*tfld(:ncol,k))
         108             :     end do
         109             :
         110     1489176 :     if( has_n2 ) then
         111     1489176 :        if ( has_var_o2 ) then
         112           0 :           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           0 :              where (n2vmr(:ncol)<n2min)
         115             :                 n2vmr = n2min
         116             :              end where
         117           0 :              invariants(:ncol,k,n2_ndx) = n2vmr(:ncol) * invariants(:ncol,k,m_ndx)
         118             :           end do
         119             :        else
         120   139982544 :           do k = 1,pver
         121  2314006344 :              invariants(:ncol,k,n2_ndx) = .79_r8 * invariants(:ncol,k,m_ndx)
         122             :           end do
         123             :        endif
         124             :     end if
         125     1489176 :     if( has_o2 ) then
         126   139982544 :        do k = 1,pver
         127  2314006344 :           invariants(:ncol,k,o2_ndx) = .21_r8 * invariants(:ncol,k,m_ndx)
         128             :        end do
         129             :     end if
         130     1489176 :     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     8935056 :     do i = 1,num_tracer_cnst
         137             :
         138     7445880 :        call get_cnst_data( tracer_cnst_flds(i), cnst_offline,  ncol, lchnk, pbuf )
         139     7445880 :        ndx =  get_inv_ndx( tracer_cnst_flds(i) )
         140             :
         141   701401896 :        do k = 1,pver
         142 11570031720 :           invariants(:ncol,k,ndx) = cnst_offline(:ncol,k)*invariants(:ncol,k,m_ndx)
         143             :        enddo
         144             :
         145             :     enddo
         146             :
         147    13402584 :     do i = 1,nfs
         148 18512050752 :       tmp_out(:ncol,:) =  invariants(:ncol,:,i)
         149    11913408 :       call outfld( trim(inv_lst(i))//'_dens', tmp_out(:ncol,:), ncol, lchnk )
         150 18512050752 :       tmp_out(:ncol,:) =  invariants(:ncol,:,i) / invariants(:ncol,:,m_ndx)
         151    13402584 :       call outfld( trim(inv_lst(i))//'_vmr',  tmp_out(:ncol,:), ncol, lchnk )
         152             :     enddo
         153             :
         154     1489176 :   end subroutine setinv
         155             :
         156             : end module mo_setinv

Generated by: LCOV version 1.14