LCOV - code coverage report
Current view: | top level - physics/cam - ghg_data.F90 (source / functions) |  |  | Hit | Total | Coverage
Test: | coverage.info |  | Lines: | 79 | 79 | 100.0 %
Date: | 2024-12-17 17:57:11 |  | Functions: | 3 | 3 | 100.0 %

              Line data    Source code
           1             :
           2             : module ghg_data
           3             :
           4             : !------------------------------------------------------------------------------------------------
           5             : ! Purpose:
           6             : ! Provide default distributions of CH4, N2O, CFC11 and CFC12 to the radiation routines.
           7             : ! **NOTE** CO2 is assumed by the radiation to a be constant value.  This value is
           8             : !          currently supplied directly by the chem_surfvals module.
           9             : !
          10             : ! Revision history:
          11             : ! 2004-08-29  B. Eaton        Create CAM interface to trcmix.
          12             : !------------------------------------------------------------------------------------------------
          13             :
          14             : use shr_kind_mod,   only: r8 => shr_kind_r8
          15             : use ppgrid,         only: pcols, pver, begchunk, endchunk
          16             : use physics_types,  only: physics_state
          17             : use physconst,      only: mwdry, mwch4, mwn2o, mwf11, mwf12, mwco2
          18             : use chem_surfvals,  only: chem_surfvals_get, chem_surfvals_co2_rad
          19             : use cam_abortutils, only: endrun
          20             : use error_messages, only: handle_err
          21             :
          22             :
          23             : implicit none
          24             : private
          25             : save
          26             :
          27             : ! Public interfaces
          28             : public ::&
          29             :    ghg_data_register, &! register ghg's with pbuf2d
          30             :    ghg_data_timestep_init    ! place data model of ghg's in pbuf2d
          31             :
          32             : ! Private variables
          33             :
          34             : real(r8) :: rmwn2o ! = mwn2o/mwdry ! ratio of molecular weight n2o   to dry air
          35             : real(r8) :: rmwch4 ! = mwch4/mwdry ! ratio of molecular weight ch4   to dry air
          36             : real(r8) :: rmwf11 ! = mwf11/mwdry ! ratio of molecular weight cfc11 to dry air
          37             : real(r8) :: rmwf12 ! = mwf12/mwdry ! ratio of molecular weight cfc12 to dry air
          38             : real(r8) :: rmwco2 ! = mwco2/mwdry ! ratio of molecular weights of co2 to dry air
          39             :
          40             : integer, parameter :: ncnst = 6                        ! number of constituents
          41             : character(len=8), dimension(ncnst), parameter :: &
          42             :    cnst_names = (/'N2O  ', 'CH4  ', 'CFC11', 'CFC12', 'CO2  ', 'O2   '/) ! constituent names
          43             : integer  :: pbuf_idx(ncnst)
          44             :
          45             : !================================================================================================
          46             : contains
          47             : !================================================================================================
          48             :
          49        1536 : subroutine ghg_data_register()
          50             : !-------------------------------------------------------------------------------
          51             : ! register ghg's with pbuf2d
          52             : !-------------------------------------------------------------------------------
          53             :   use physics_buffer, only : pbuf_add_field, dtype_r8
          54             :
          55             :   integer iconst
          56             :
          57             :
          58       10752 :   do iconst = 1,ncnst
          59       10752 :      call pbuf_add_field(cnst_names(iconst),'physpkg',dtype_r8,(/pcols,pver/),pbuf_idx(iconst))
          60             :   enddo
          61             :
          62        1536 : end subroutine ghg_data_register
          63             :
          64      741888 : subroutine ghg_data_timestep_init(pbuf2d, state)
          65             : !-------------------------------------------------------------------------------
          66             : ! place data model of ghg's in pbuf2d at each timestep
          67             : !-------------------------------------------------------------------------------
          68        1536 :   use ppgrid,              only: begchunk, endchunk, pcols, pver
          69             :   use physics_types,       only: physics_state
          70             :   use physics_buffer,      only: physics_buffer_desc, pbuf_get_field, pbuf_get_chunk
          71             :
          72             :
          73             :   type(physics_state), intent(in), dimension(begchunk:endchunk) :: state
          74             :   type(physics_buffer_desc), pointer :: pbuf2d(:,:)
          75             :
          76      370944 :   type(physics_buffer_desc), pointer :: pbuf_chnk(:)
          77      370944 :   real(r8), pointer :: tmpptr(:,:)
          78             :
          79             :   integer iconst
          80             :   integer lchnk
          81             :
          82      370944 :   rmwn2o = mwn2o/mwdry      ! ratio of molecular weight n2o   to dry air
          83      370944 :   rmwch4 = mwch4/mwdry      ! ratio of molecular weight ch4   to dry air
          84      370944 :   rmwf11 = mwf11/mwdry      ! ratio of molecular weight cfc11 to dry air
          85      370944 :   rmwf12 = mwf12/mwdry      ! ratio of molecular weight cfc12 to dry air
          86      370944 :   rmwco2 = mwco2/mwdry      ! ratio of molecular weights of co2 to dry air
          87             :
          88     2596608 :    do iconst = 1,ncnst
          89             : !$OMP PARALLEL DO PRIVATE (LCHNK,tmpptr,pbuf_chnk)
          90    11568816 :      do lchnk = begchunk, endchunk
          91     8972208 :        pbuf_chnk => pbuf_get_chunk(pbuf2d, lchnk)
          92     8972208 :        call pbuf_get_field(pbuf_chnk, pbuf_idx(iconst), tmpptr)
          93     8972208 :        call trcmix(cnst_names(iconst), state(lchnk)%ncol, &
          94             :                    state(lchnk)%lat, state(lchnk)%pmid, &
          95    20170080 :                    tmpptr)
          96             :      enddo
          97             :   enddo
          98             :
          99      741888 : end subroutine ghg_data_timestep_init
         100             :
         101             :
         102             : !================================================================================================
         103             :
         104     8972208 : subroutine trcmix(name, ncol, clat, pmid, q)
         105             : !-----------------------------------------------------------------------
         106             : !
         107             : ! Purpose:
         108             : ! Specify zonal mean mass mixing ratios of CH4, N2O, CFC11 and
         109             : ! CFC12
         110             : !
         111             : ! Method:
         112             : ! Distributions assume constant mixing ratio in the troposphere
         113             : ! and a decrease of mixing ratio in the stratosphere. Tropopause
         114             : ! defined by ptrop. The scale height of the particular trace gas
         115             : ! depends on latitude. This assumption produces a more realistic
         116             : ! stratospheric distribution of the various trace gases.
         117             : !
         118             : ! Author: J. Kiehl
         119             : !
         120             : !-----------------------------------------------------------------------
         121             :
         122             :    ! Arguments
         123             :    character(len=*), intent(in)  :: name              ! constituent name
         124             :    integer,          intent(in)  :: ncol              ! number of columns
         125             :    real(r8),         intent(in)  :: clat(pcols)       ! latitude in radians for columns
         126             :    real(r8),         intent(in)  :: pmid(pcols,pver)  ! model pressures
         127             :    real(r8),         intent(out) :: q(pcols,pver)     ! constituent mass mixing ratio
         128             :
         129             :    integer i                ! longitude loop index
         130             :    integer k                ! level index
         131             :
         132             :    real(r8) coslat(pcols)   ! cosine of latitude
         133             :    real(r8) dlat            ! latitude in degrees
         134             :    real(r8) ptrop           ! pressure level of tropopause
         135             :    real(r8) pratio          ! pressure divided by ptrop
         136             :    real(r8) trop_mmr        ! tropospheric mass mixing ratio
         137             :    real(r8) scale           ! pressure scale height
         138             : !-----------------------------------------------------------------------
         139             :
         140   149815008 :    do i = 1, ncol
         141   149815008 :       coslat(i) = cos(clat(i))
         142             :    end do
         143             :
         144     8972208 :    if (name == 'O2') then
         145             :
         146  2365672176 :       q = chem_surfvals_get('O2MMR')
         147             :
         148     7476840 :    else if (name == 'CO2') then
         149             :
         150  2365672176 :       q = chem_surfvals_co2_rad()
         151             :
         152     5981472 :    else if (name == 'CH4') then
         153             :
         154             :       ! set tropospheric mass mixing ratios
         155     1495368 :       trop_mmr = rmwch4 * chem_surfvals_get('CH4VMR')
         156             :
         157   140564592 :       do k = 1,pver
         158  2323627992 :          do i = 1,ncol
         159             :             ! set stratospheric scale height factor for gases
         160  2183063400 :             dlat = abs(57.2958_r8 * clat(i))
         161  2183063400 :             if(dlat.le.45.0_r8) then
         162             :                scale = 0.2353_r8
         163             :             else
         164   630662760 :                scale = 0.2353_r8 + 0.0225489_r8 * (dlat - 45)
         165             :             end if
         166             :
         167             :             ! pressure of tropopause
         168  2183063400 :             ptrop = 250.0e2_r8 - 150.0e2_r8*coslat(i)**2.0_r8
         169             :
         170             :             ! determine output mass mixing ratios
         171  2322132624 :             if (pmid(i,k) >= ptrop) then
         172   979445837 :                q(i,k) = trop_mmr
         173             :             else
         174  1203617563 :                pratio = pmid(i,k)/ptrop
         175  1203617563 :                q(i,k) = trop_mmr * (pratio)**scale
         176             :             end if
         177             :          end do
         178             :       end do
         179             :
         180     4486104 :    else if (name == 'N2O') then
         181             :
         182             :       ! set tropospheric mass mixing ratios
         183     1495368 :       trop_mmr = rmwn2o * chem_surfvals_get('N2OVMR')
         184             :
         185   140564592 :       do k = 1,pver
         186  2323627992 :          do i = 1,ncol
         187             :             ! set stratospheric scale height factor for gases
         188  2183063400 :             dlat = abs(57.2958_r8 * clat(i))
         189  2183063400 :             if(dlat.le.45.0_r8) then
         190  1552400640 :                scale = 0.3478_r8 + 0.00116_r8 * dlat
         191             :             else
         192   630662760 :                scale = 0.4000_r8 + 0.013333_r8 * (dlat - 45)
         193             :             end if
         194             :
         195             :             ! pressure of tropopause
         196  2183063400 :             ptrop = 250.0e2_r8 - 150.0e2_r8*coslat(i)**2.0_r8
         197             :
         198             :             ! determine output mass mixing ratios
         199  2322132624 :             if (pmid(i,k) >= ptrop) then
         200   979445837 :                q(i,k) = trop_mmr
         201             :             else
         202  1203617563 :                pratio = pmid(i,k)/ptrop
         203  1203617563 :                q(i,k) = trop_mmr * (pratio)**scale
         204             :             end if
         205             :          end do
         206             :       end do
         207             :
         208     2990736 :    else if (name == 'CFC11') then
         209             :
         210             :       ! set tropospheric mass mixing ratios
         211     1495368 :       trop_mmr = rmwf11 * chem_surfvals_get('F11VMR')
         212             :
         213   140564592 :       do k = 1,pver
         214  2323627992 :          do i = 1,ncol
         215             :             ! set stratospheric scale height factor for gases
         216  2183063400 :             dlat = abs(57.2958_r8 * clat(i))
         217  2183063400 :             if(dlat.le.45.0_r8) then
         218  1552400640 :                scale = 0.7273_r8 + 0.00606_r8 * dlat
         219             :             else
         220   630662760 :                scale = 1.00_r8 + 0.013333_r8 * (dlat - 45)
         221             :             end if
         222             :
         223             :             ! pressure of tropopause
         224  2183063400 :             ptrop = 250.0e2_r8 - 150.0e2_r8*coslat(i)**2.0_r8
         225             :
         226             :             ! determine output mass mixing ratios
         227  2322132624 :             if (pmid(i,k) >= ptrop) then
         228   979445837 :                q(i,k) = trop_mmr
         229             :             else
         230  1203617563 :                pratio = pmid(i,k)/ptrop
         231  1203617563 :                q(i,k) = trop_mmr * (pratio)**scale
         232             :             end if
         233             :          end do
         234             :       end do
         235             :
         236     1495368 :    else if (name == 'CFC12') then
         237             :
         238             :       ! set tropospheric mass mixing ratios
         239     1495368 :       trop_mmr = rmwf12 * chem_surfvals_get('F12VMR')
         240             :
         241   140564592 :       do k = 1,pver
         242  2323627992 :          do i = 1,ncol
         243             :             ! set stratospheric scale height factor for gases
         244  2183063400 :             dlat = abs(57.2958_r8 * clat(i))
         245  2183063400 :             if(dlat.le.45.0_r8) then
         246  1552400640 :                scale = 0.4000_r8 + 0.00222_r8 * dlat
         247             :             else
         248   630662760 :                scale = 0.50_r8 + 0.024444_r8 * (dlat - 45)
         249             :             end if
         250             :
         251             :             ! pressure of tropopause
         252  2183063400 :             ptrop = 250.0e2_r8 - 150.0e2_r8*coslat(i)**2.0_r8
         253             :
         254             :             ! determine output mass mixing ratios
         255  2322132624 :             if (pmid(i,k) >= ptrop) then
         256   979445837 :                q(i,k) = trop_mmr
         257             :             else
         258  1203617563 :                pratio = pmid(i,k)/ptrop
         259  1203617563 :                q(i,k) = trop_mmr * (pratio)**scale
         260             :             end if
         261             :          end do
         262             :       end do
         263             :
         264             :    end if
         265             :
         266      370944 : end subroutine trcmix
         267             :
         268             : end module ghg_data

Generated by: LCOV version 1.14