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
|