LCOV - code coverage report
Current view: | top level - utils - physconst.F90 (source / functions) |  |  | Hit | Total | Coverage
Test: | coverage.info |  | Lines: | 85 | 92 | 92.4 %
Date: | 2025-01-13 21:54:50 |  | Functions: | 1 | 1 | 100.0 %

              Line data    Source code
           1             : module physconst
           2             :
           3             :    ! Physical constants.  Use csm_share values whenever available.
           4             :    use shr_kind_mod,   only: r8 => shr_kind_r8
           5             :    use shr_const_mod,  only: shr_const_g
           6             :    use shr_const_mod,  only: shr_const_stebol
           7             :    use shr_const_mod,  only: shr_const_tkfrz
           8             :    use shr_const_mod,  only: shr_const_mwdair
           9             :    use shr_const_mod,  only: shr_const_rdair
          10             :    use shr_const_mod,  only: shr_const_mwwv
          11             :    use shr_const_mod,  only: shr_const_latice
          12             :    use shr_const_mod,  only: shr_const_latvap
          13             :    use shr_const_mod,  only: shr_const_cpdair
          14             :    use shr_const_mod,  only: shr_const_rhofw
          15             :    use shr_const_mod,  only: shr_const_cpwv
          16             :    use shr_const_mod,  only: shr_const_rgas
          17             :    use shr_const_mod,  only: shr_const_karman
          18             :    use shr_const_mod,  only: shr_const_pstd
          19             :    use shr_const_mod,  only: shr_const_rhodair
          20             :    use shr_const_mod,  only: shr_const_avogad
          21             :    use shr_const_mod,  only: shr_const_boltz
          22             :    use shr_const_mod,  only: shr_const_cpfw
          23             :    use shr_const_mod,  only: shr_const_rwv
          24             :    use shr_const_mod,  only: shr_const_zvir
          25             :    use shr_const_mod,  only: shr_const_pi
          26             :    use shr_const_mod,  only: shr_const_rearth
          27             :    use shr_const_mod,  only: shr_const_sday
          28             :    use shr_const_mod,  only: shr_const_cday
          29             :    use shr_const_mod,  only: shr_const_spval
          30             :    use shr_const_mod,  only: shr_const_omega
          31             :    use shr_const_mod,  only: shr_const_cpvir
          32             :    use shr_const_mod,  only: shr_const_tktrip
          33             :    use shr_const_mod,  only: shr_const_cpice
          34             :    use shr_flux_mod,   only: shr_flux_adjust_constants
          35             :    use cam_abortutils, only: endrun
          36             :    use constituents,   only: pcnst
          37             :
          38             :    implicit none
          39             :    private
          40             :    save
          41             :
          42             :    public :: physconst_readnl
          43             :
          44             :    ! Constants based off share code or defined in physconst
          45             :
          46             :    real(r8), public, parameter :: avogad      = shr_const_avogad     ! Avogadro's number (molecules kmole-1)
          47             :    real(r8), public, parameter :: boltz       = shr_const_boltz      ! Boltzman's constant (J K-1 molecule-1)
          48             :    real(r8), public, parameter :: cday        = shr_const_cday       ! sec in calendar day (seconds)
          49             :    real(r8), public, parameter :: cpliq       = shr_const_cpfw       ! specific heat of fresh h2o (J K-1 kg-1)
          50             :    real(r8), public, parameter :: cpice       = shr_const_cpice      ! specific heat of ice (J K-1 kg-1)
          51             :    real(r8), public, parameter :: karman      = shr_const_karman     ! Von Karman constant
          52             :    real(r8), public, parameter :: latice      = shr_const_latice     ! Latent heat of fusion (J kg-1)
          53             :    real(r8), public, parameter :: latvap      = shr_const_latvap     ! Latent heat of vaporization (J kg-1)
          54             :    real(r8), public, parameter :: pi          = shr_const_pi         ! 3.14...
          55             : #ifdef planet_mars
          56             :    real(r8), public, parameter :: pstd        = 6.0E1_r8             ! Standard pressure (Pascals)
          57             : #else
          58             :    real(r8), public, parameter :: pstd        = shr_const_pstd       ! Standard pressure (Pascals)
          59             :    real(r8), public, parameter :: tref        = 288._r8              ! Reference temperature (K)
          60             :    real(r8), public, parameter :: lapse_rate  = 0.0065_r8            ! reference lapse rate (K m-1)
          61             : #endif
          62             :    real(r8), public, parameter :: r_universal = shr_const_rgas       ! Universal gas constant (J K-1 kmol-1)
          63             :    real(r8), public, parameter :: rhoh2o      = shr_const_rhofw      ! Density of liquid water at STP (kg m-3)
          64             :    real(r8), public, parameter :: spval       = shr_const_spval      !special value
          65             :    real(r8), public, parameter :: stebol      = shr_const_stebol     ! Stefan-Boltzmann's constant (W m-2 K-4)
          66             :    real(r8), public, parameter :: h2otrip     = shr_const_tktrip     ! Triple point temperature of water (K)
          67             :
          68             :    real(r8), public, parameter :: c0          = 2.99792458e8_r8      ! Speed of light in a vacuum (m s-1)
          69             :    real(r8), public, parameter :: planck      = 6.6260755e-34_r8     ! Planck's constant (J.s)
          70             :    real(r8), public, parameter :: amu         = 1.66053886e-27_r8    ! Atomic Mass Unit (kg)
          71             :
          72             :    ! Molecular weights (g mol-1)
          73             :    real(r8), public, parameter :: mwco2       =  44._r8             ! molecular weight co2
          74             :    real(r8), public, parameter :: mwn2o       =  44._r8             ! molecular weight n2o
          75             :    real(r8), public, parameter :: mwch4       =  16._r8             ! molecular weight ch4
          76             :    real(r8), public, parameter :: mwf11       = 136._r8             ! molecular weight cfc11
          77             :    real(r8), public, parameter :: mwf12       = 120._r8             ! molecular weight cfc12
          78             :    real(r8), public, parameter :: mwo3        =  48._r8             ! molecular weight O3
          79             :    real(r8), public, parameter :: mwso2       =  64._r8             ! molecular weight so2
          80             :    real(r8), public, parameter :: mwso4       =  96._r8             ! molecular weight so4
          81             :    real(r8), public, parameter :: mwh2o2      =  34._r8             ! molecular weight h2o2
          82             :    real(r8), public, parameter :: mwdms       =  62._r8             ! molecular weight dms
          83             :    real(r8), public, parameter :: mwnh4       =  18._r8             ! molecular wieght nh4
          84             :    real(r8), public, protected :: mwh2o       =  shr_const_mwwv     ! molecular weight h2o
          85             :    real(r8), public, protected :: mwdry       =  shr_const_mwdair   ! molecular weight dry air
          86             :
          87             :    ! modifiable physical constants for  other planets (including aquaplanet)
          88             :    real(r8), public, protected :: gravit  = shr_const_g            ! gravitational acceleration (m s-2)
          89             :    real(r8), public, protected :: sday    = shr_const_sday         ! sec in sidereal day (seconds)
          90             :    real(r8), public, protected :: cpwv    = shr_const_cpwv         ! specific heat of water vapor (J K-1 kg-1)
          91             :    real(r8), public, protected :: cpair   = shr_const_cpdair       ! specific heat of dry air (J K-1 kg-1)
          92             :    real(r8), public, protected :: rearth  = shr_const_rearth       ! radius of earth (m)
          93             :    real(r8), public, protected :: tmelt   = shr_const_tkfrz        ! Freezing point of water (K)
          94             :
          95             :    !-----  Variables below here are derived from those above -----------------
          96             :
          97             :    real(r8), public, protected :: rga        = 1._r8/shr_const_g         ! reciprocal of gravit (s2 m-1)
          98             :    real(r8), public, protected :: ra         = 1._r8/shr_const_rearth    ! reciprocal of earth radius (m-1)
          99             :    real(r8), public, protected :: omega      = shr_const_omega           ! earth rot (rad sec-1)
         100             :    real(r8), public, protected :: rh2o       = shr_const_rwv             ! Water vapor gas constant (J K-1 kg-1)
         101             :    real(r8), public, protected :: rair       = shr_const_rdair           ! Dry air gas constant     (J K-1 kg-1)
         102             :    real(r8), public, protected :: epsilo     = shr_const_mwwv/shr_const_mwdair   ! ratio of h2o to dry air molecular weights
         103             :    real(r8), public, protected :: zvir       = shr_const_zvir            ! (rh2o/rair) - 1
         104             :    real(r8), public, protected :: cpvir      = shr_const_cpvir           ! CPWV/CPDAIR - 1.0
         105             :    real(r8), public, protected :: rhodair    = shr_const_rhodair         ! density of dry air at STP (kg m-3)
         106             :    real(r8), public, protected :: cappa      = (shr_const_rgas/shr_const_mwdair)/shr_const_cpdair  ! R/Cp
         107             :    real(r8), public, protected :: ez                                     ! Coriolis expansion coeff -> omega/sqrt(0.375)
         108             :    real(r8), public, protected :: Cpd_on_Cpv = shr_const_cpdair/shr_const_cpwv
         109             :
         110             : !==============================================================================
         111             : CONTAINS
         112             : !==============================================================================
         113             :
         114             :    ! Read namelist variables.
         115        1536 :    subroutine physconst_readnl(nlfile)
         116             :       use namelist_utils,  only: find_group_name
         117             :       use spmd_utils,      only: masterproc, mpicom, masterprocid
         118             :       use spmd_utils,      only: mpi_real8
         119             :       use cam_logfile,     only: iulog
         120             :       use dyn_tests_utils, only: vc_physics, vc_moist_pressure
         121             :       use dyn_tests_utils, only: string_vc, vc_str_lgth
         122             :
         123             :       ! Dummy argument: filepath for file containing namelist input
         124             :       character(len=*), intent(in) :: nlfile
         125             :
         126             :       ! Local variables
         127             :       integer                     :: unitn, ierr
         128             :       logical                     :: newg
         129             :       logical                     :: newsday
         130             :       logical                     :: newmwh2o
         131             :       logical                     :: newcpwv
         132             :       logical                     :: newmwdry
         133             :       logical                     :: newcpair
         134             :       logical                     :: newrearth
         135             :       logical                     :: newtmelt
         136             :       logical                     :: newomega
         137             :       integer,          parameter :: lsize = 76
         138             :       integer,          parameter :: fsize = 23
         139             :       character(len=*), parameter :: subname = 'physconst_readnl :: '
         140             :       character(len=vc_str_lgth)  :: str
         141             :       character(len=lsize)        :: banner
         142             :       character(len=lsize)        :: bline
         143             :       character(len=fsize)        :: field
         144             :
         145             :       ! Physical constants needing to be reset
         146             :       !    (e.g., for aqua planet experiments)
         147             :       namelist /physconst_nl/  gravit, sday, mwh2o, cpwv, mwdry,              &
         148             :            cpair, rearth, tmelt, omega
         149             :       !-----------------------------------------------------------------------
         150             :
         151        1536 :       banner = repeat('*', lsize)
         152        1536 :       bline = "***"//repeat(' ', lsize - 6)//"***"
         153             : 2000  format("*** ",a,2("   ",E18.10),"  ***")
         154        1536 :       if (masterproc) then
         155           2 :          open(newunit=unitn, file=trim(nlfile), status='old')
         156           2 :          call find_group_name(unitn, 'physconst_nl', status=ierr)
         157           2 :          if (ierr == 0) then
         158           2 :             read(unitn, physconst_nl, iostat=ierr)
         159           2 :             if (ierr /= 0) then
         160           0 :                call endrun(subname//'ERROR reading namelist, physconst_nl')
         161             :             end if
         162             :          end if
         163           2 :          close(unitn)
         164             :       end if
         165             :
         166             :       ! Broadcast namelist variables
         167        1536 :       call MPI_bcast(gravit, 1, mpi_real8, masterprocid, mpicom, ierr)
         168        1536 :       if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: gravit")
         169        1536 :       call MPI_bcast(sday,   1, mpi_real8, masterprocid, mpicom, ierr)
         170        1536 :       if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: sday")
         171        1536 :       call MPI_bcast(mwh2o,  1, mpi_real8, masterprocid, mpicom, ierr)
         172        1536 :       if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: mwh20")
         173        1536 :       call MPI_bcast(cpwv,   1, mpi_real8, masterprocid, mpicom, ierr)
         174        1536 :       if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: cpwv")
         175        1536 :       call MPI_bcast(mwdry,  1, mpi_real8, masterprocid, mpicom, ierr)
         176        1536 :       if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: mwdry")
         177        1536 :       call MPI_bcast(cpair,  1, mpi_real8, masterprocid, mpicom, ierr)
         178        1536 :       if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: cpair")
         179        1536 :       call MPI_bcast(rearth, 1, mpi_real8, masterprocid, mpicom, ierr)
         180        1536 :       if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: rearth")
         181        1536 :       call MPI_bcast(tmelt,  1, mpi_real8, masterprocid, mpicom, ierr)
         182        1536 :       if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: tmelt")
         183        1536 :       call MPI_bcast(omega,  1, mpi_real8, masterprocid, mpicom, ierr)
         184        1536 :       if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: omega")
         185             :
         186        1536 :       newg     =  gravit /= shr_const_g
         187        1536 :       newsday  =  sday   /= shr_const_sday
         188        1536 :       newmwh2o =  mwh2o  /= shr_const_mwwv
         189        1536 :       newcpwv  =  cpwv   /= shr_const_cpwv
         190        1536 :       newmwdry =  mwdry  /= shr_const_mwdair
         191        1536 :       newcpair =  cpair  /= shr_const_cpdair
         192        1536 :       newrearth=  rearth /= shr_const_rearth
         193        1536 :       newtmelt =  tmelt  /= shr_const_tkfrz
         194        1536 :       newomega =  omega  /= shr_const_omega
         195             :
         196             :       if (newg .or. newsday .or. newmwh2o .or. newcpwv .or. newmwdry .or.     &
         197        1536 :            newrearth .or. newtmelt .or. newomega) then
         198        1536 :          if (masterproc) then
         199           2 :             write(iulog, *) banner
         200           2 :             write(iulog, *) '***    New Physical Constant Values set ',       &
         201           4 :                  'via namelist                     ***'
         202           2 :             write(iulog, *) bline
         203           2 :             write(iulog, *) '*** Physical Constant    Old Value                  New Value         ***'
         204           2 :             if (newg) then
         205           2 :                field = 'GRAVIT'
         206           2 :                write(iulog, 2000) field, shr_const_g, gravit
         207             :             end if
         208           2 :             if (newsday) then
         209           2 :                field = 'SDAY'
         210           2 :                write(iulog, 2000) field, shr_const_sday, sday
         211             :             end if
         212           2 :             if (newmwh2o) then
         213           2 :                field = 'MWH20'
         214           2 :                write(iulog, 2000) field, shr_const_mwwv, mwh2o
         215             :             end if
         216           2 :             if (newcpwv) then
         217           2 :                field = 'CPWV'
         218           2 :                write(iulog, 2000) field, shr_const_cpwv, cpwv
         219             :             end if
         220           2 :             if (newmwdry) then
         221           2 :                field = 'MWDRY'
         222           2 :                write(iulog, 2000) field, shr_const_mwdair, mwdry
         223             :             end if
         224           2 :             if (newcpair) then
         225           0 :                field = 'CPAIR'
         226           0 :                write(iulog, 2000) field, shr_const_cpdair, cpair
         227             :             end if
         228           2 :             if (newrearth) then
         229           2 :                field = 'REARTH'
         230           2 :                write(iulog, 2000) field, shr_const_rearth, rearth
         231             :             end if
         232           2 :             if (newtmelt) then
         233           0 :                field = 'TMELT'
         234           0 :                write(iulog, 2000) field, shr_const_tkfrz, tmelt
         235             :             end if
         236           2 :             if (newomega) then
         237           0 :                field = 'OMEGA'
         238           0 :                write(iulog, 2000) field, shr_const_omega, omega
         239             :             end if
         240           2 :             write(iulog,*) banner
         241             :          end if
         242        1536 :          rga = 1._r8 / gravit
         243        1536 :          ra  = 1._r8 / rearth
         244        1536 :          if (.not. newomega) then
         245        1536 :             omega = 2.0_r8 * pi / sday
         246             :          end if
         247        1536 :          cpvir  = (cpwv / cpair) - 1._r8
         248        1536 :          epsilo = mwh2o / mwdry
         249             :
         250             :          !  defined rair and rh2o before any of the variables that use them
         251        1536 :          rair = r_universal / mwdry
         252        1536 :          rh2o = r_universal / mwh2o
         253             :
         254        1536 :          cappa       = rair / cpair
         255        1536 :          rhodair     = pstd / (rair * tmelt)
         256        1536 :          zvir        = (rh2o / rair) - 1.0_r8
         257        1536 :          Cpd_on_Cpv  = cpair / cpwv
         258             :
         259             :          ! Adjust constants in shr_flux_mod.
         260        1536 :          call shr_flux_adjust_constants(zvir=zvir, cpvir=cpvir, gravit=gravit)
         261             :       end if
         262             :
         263        1536 :       ez = omega / sqrt(0.375_r8)
         264             :       !
         265             :       ! vertical coordinate info
         266             :       !
         267        1536 :       vc_physics = vc_moist_pressure
         268        1536 :       if (masterproc) then
         269           2 :          call string_vc(vc_physics, str)
         270           2 :          write(iulog, *) 'vertical coordinate physics : ', trim(str)
         271             :       end if
         272             :
         273        1536 :    end subroutine physconst_readnl
         274             :
         275             : end module physconst

Generated by: LCOV version 1.14