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

Generated by: LCOV version 1.14