8 REAL(KIND(1d0)),
PARAMETER ::
rad2deg = 57.29577951
9 REAL(KIND(1d0)),
PARAMETER ::
deg2rad = 0.017453292
19 REAL(KIND(1d0)),
PARAMETER ::
epsil = 0.62197
20 REAL(KIND(1d0)),
PARAMETER ::
kb = 1.3807e-25
21 REAL(KIND(1d0)),
PARAMETER ::
avogadro = 6.02252e23
31 REAL(KIND(1d0)) :: TK, P, TC, es, e, f
37 e = 6.1121*exp(((18.729 - tc/227.3)*tc)/(tc + 257.87))
38 f = 1.00072 + p*(3.2e-6 + 5.9e-10*tc**2)
51 REAL(KIND(1d0)) ::TK, P
65 REAL(KIND(1d0)) ::TK, TC
72 REAL(KIND(1d0)) ::TK, TC
79 REAL(KIND(1d0)) ::TK, TC_100, RH
80 tc_100 = (tk - 273.15)/100.
81 spec_heat_vapor = 1859.+0.13*rh + (19.3 + 0.569*rh)*tc_100 + (10.+0.5*rh)*tc_100**2
85 REAL(KIND(1d0)) ::TK, RH, P
86 REAL(KIND(1d0)) ::RHO_D, RHO_V
87 REAL(KIND(1d0)) ::CPD, CPV
99 REAL(KIND(1d0)) ::TVK, P
105 REAL(KIND(1d0)) ::TK, P, RH, EA
111 REAL(KIND(1d0)) ::TK, P
115 REAL(KIND(1d0)) FUNCTION density_gas(TK, PP, MOLMASS)
117 REAL(KIND(1d0)) ::TK, PP, MOLMASS
123 REAL(KIND(1d0)) ::TK, N
148 FUNCTION sat_vap_press_x(Temp_c, PRESS_hPa, from, dectime)
RESULT(es_hPa)
153 REAL(KIND(1d0))::temp_C, press_hpa, dectime
154 REAL(KIND(1d0))::e_mb, f, press_kpa, es_hPA
156 INTEGER,
PARAMETER::notUsedI = -55
161 IF (abs(temp_c) < 0.001000)
THEN 164 CALL errorhint(29,
'Function sat_vap_press: temp_C, dectime,press_Hpa = ', temp_c, dectime, iv)
170 press_kpa = press_hpa/10
172 IF (temp_c < 50 .AND. temp_c > -40)
THEN 176 IF (temp_c >= 0.001000)
THEN 177 e_mb = 6.1121*exp(((18.678 - temp_c/234.5)*temp_c)/(temp_c + 257.14))
178 f = 1.00072 + press_kpa*(3.2e-6 + 5.9e-10*temp_c**2)
181 ELSEIF (temp_c <= -0.001000)
THEN 182 e_mb = 6.1115*exp(((23.036 - temp_c/333.7)*temp_c)/(temp_c + 279.82))
183 f = 1.00022 + press_kpa*(3.83e-6 + 6.4e-10*temp_c**2)
188 CALL errorhint(28,
'FUNCTION sat_vap_press: [Temperature is out of range], Temp_C,dectime', temp_c, dectime, notusedi)
200 REAL(KIND(1d0))::e_mb, f, temp_C, press_hpa, press_kpa, es_hPA, dectime
202 INTEGER,
PARAMETER::notUsedI = -55
208 IF (abs(temp_c) < 0.001000)
THEN 211 CALL errorhint(29,
'Function sat_vap_press: temp_C, dectime,press_Hpa = ', temp_c, dectime, iv)
217 press_kpa = press_hpa/10
219 IF (temp_c < 50 .AND. temp_c > -40)
THEN 220 e_mb = 6.1115*exp(((23.036 - temp_c/333.7)*temp_c)/(temp_c + 279.82))
221 f = 1.00022 + press_kpa*(3.83e-6 + 6.4e-10*temp_c**2)
225 CALL errorhint(28,
'FUNCTION sat_vap_press: [Temperature is out of range], Temp_C,dectime', temp_c, dectime, notusedi)
238 REAL(KIND(1d0)) :: press_hPa, vpd_hPa, dq
239 REAL(KIND(1d0)),
PARAMETER :: epsil_gkg = 621.97
240 dq = epsil_gkg*vpd_hpa/press_hpa
254 REAL(KIND(1d0))::cp, cpd, cpm, rho_v, rho_d, rh, temp_C
257 cpd = 1005.0 + ((temp_c + 23.16)**2)/3364.0
260 cpm = 1859 + 0.13*rh + (19.3 + 0.569*rh)*(temp_c/100.) + &
261 (10.+0.5*rh)*(temp_c/100.)**2
263 IF (abs(rho_d) < 0.000100 .OR. abs(rho_v) < 0.000100 .OR. abs(rho_d + rho_v) < 0.000100)
THEN 264 CALL errorhint(42,
'spec-heat_beer', rho_v, rho_d, int(temp_c))
267 cp = cpd*(rho_d/(rho_d + rho_v)) + cpm*(rho_v/(rho_d + rho_v))
277 FUNCTION lat_vap(Temp_C, Ea_hPa, Press_hPa, cp, dectime)
RESULT(lv_J_kg)
286 REAL(KIND(1d0))::cp, lv_J_kg, ea_fix, tw, &
287 incr, es_tw, psyc, ea_est, press_hPa, ea_HPa, temp_C, dectime
290 LOGICAL:: switch1 = .false., switch2 = .false.
291 INTEGER:: ii, from = 2
292 REAL(KIND(1d0)),
PARAMETER::notUsed = -55.55
300 lv_j_kg = (2500.25 - 2.365*temp_c)*1000
305 IF (press_hpa < 900)
THEN 306 CALL errorhint(45,
'function Lat_vap', press_hpa, notused, ii)
315 IF (press_hpa < 900)
THEN 316 CALL errorhint(45,
'function Lat_vap - 2', press_hpa, notused, ii)
321 IF (press_hpa < 900)
THEN 322 CALL errorhint(45,
'function Lat _vap -31', press_hpa, notused, ii)
325 ea_est = es_tw - psyc*(temp_c - tw)
327 lv_j_kg = (2500.25 - 2.365*tw)*1e3
329 IF (switch1 .AND. switch2)
THEN 334 IF (abs(ea_est - ea_fix) < 0.001000)
THEN 336 ELSEIF (ea_est > ea_fix)
THEN 339 ELSEIF (ea_est < ea_fix)
THEN 348 FUNCTION lat_vapsublim(Temp_C, Ea_hPa, Press_hPa, cp)
RESULT(lvS_J_kg)
356 REAL(KIND(1d0))::lvS_J_kg, temp_C, tw, incr, Ea_hPa, Press_hPa, cp
367 lvs_j_kg = (2834.1 - 0.29*temp_c)*1e3
371 press_hpa = press_hpa
409 FUNCTION psyc_const(cp, Press_hPa, lv_J_kg)
RESULT(psyc_hPa)
413 REAL(KIND(1d0))::cp, lv_J_kg, press_hPa, psyc_hpa
416 IF (cp*press_hpa < 900 .OR. lv_j_kg < 10000)
THEN 418 'in psychrometric constant calculation: cp [J kg-1 K-1], p [hPa], Lv [J kg-1]', &
419 cp, press_hpa, int(lv_j_kg))
422 psyc_hpa = (cp*press_hpa)/(
epsil*lv_j_kg)
433 FUNCTION dewpoint(ea_hPa)
RESULT(Temp_C_dew)
440 REAL(KIND(1d0))::ea_hPa, temp_C_dew
441 temp_c_dew = (237.3*log(ea_hpa/6.1078))/(17.27 - (log(ea_hpa/6.1078)))
450 REAL(KIND(1d0)):: b1, b2, b3, b4, b5, b6, b7, S_hPa, temp_C
457 b7 = -7.090244804d-13
461 s_hpa = b1 + temp_c*(b2 + temp_c*(b3 + temp_c*(b4 + temp_c*(b5 + temp_c*(b6 + b7*temp_c)))))
477 REAL(KIND(1d0)):: b1, b2, b3, b4, b5, b6, b7, S_hPa, temp_C
489 s_hpa = b1 + temp_c*(b2 + temp_c*(b3 + temp_c*(b4 + temp_c*(b5 + temp_c*(b6 + b7*temp_c)))))
495 FUNCTION qsatf(T, PMB)
RESULT(qsat)
500 REAL(KIND(1D0))::T, es, qsat, PMB
502 REAL(KIND(1D0)),
PARAMETER:: &
508 molar_wat_vap = 0.0180153
511 CALL errorhint(34,
'Function qsatf', t, 0.00d0, -55)
514 es = a*dexp(b*t/(c + t))
515 qsat = (molar_wat_vap/molar)*es/pmb
518 FUNCTION rh2qa(RH, pres_hPa, Ta_degC)
RESULT(qa)
522 REAL(KIND(1D0)),
INTENT(in) :: RH
523 REAL(KIND(1D0)),
INTENT(in) :: pres_hPa
524 REAL(KIND(1D0)),
INTENT(in) :: Ta_degC
532 qa = 0.622*ea/(pres_hpa - 0.378*ea)*1000
536 FUNCTION qa2rh(qa, pres_hPa, Ta_degC)
RESULT(RH)
540 REAL(KIND(1d0)),
INTENT(in) :: qa
541 REAL(KIND(1D0)),
INTENT(in) :: pres_hPa
542 REAL(KIND(1D0)),
INTENT(in) :: Ta_degC
543 REAL(KIND(1D0)) :: RH
547 REAL(KIND(1d0)) ::qa_kgkg
551 ea = 500*pres_hpa*qa_kgkg/(311 + 189*qa_kgkg)
real(kind(1d0)), parameter r_dry_mass
real(kind(1d0)) function vaisala_brunt_f(TK)
real(kind(1d0)) function potential_temp(TK, P)
real(kind(1d0)) function heatcapacity_air(TK, RH, P)
real(kind(1d0)), parameter mu_co2
real(kind(1d0)), parameter molmass_h2o
real(kind(1d0)) function density_dryair(TK, P)
real(kind(1d0)) function spec_hum_def(vpd_hPa, press_hPa)
real(kind(1d0)) function slope_svp(temp_C)
real(kind(1d0)) function spec_heat_beer(Temp_C, rh, rho_v, rho_d)
real(kind(1d0)) function latentheat_m(TK)
real(kind(1d0)), parameter epsil
real(kind(1d0)), parameter molmass_co2
real(kind(1d0)) function partial_pressure(TK, N)
real(kind(1d0)), parameter molmass_air
real(kind(1d0)), parameter mu_h2o
real(kind(1d0)) function scale_height(TK)
real(kind(1d0)), parameter avogadro
real(kind(1d0)) function density_vapor(TK, RH, P)
real(kind(1d0)) function latentheat_v(TK)
real(kind(1d0)) function slopeice_svp(temp_C)
real(kind(1d0)) function density_moist(TVK, P)
real(kind(1d0)) function dewpoint(ea_hPa)
real(kind(1d0)) function lat_vapsublim(Temp_C, Ea_hPa, Press_hPa, cp)
real(kind(1d0)), parameter r_dry_mol
real(kind(1d0)), parameter deg2rad
real(kind(1d0)) function density_gas(TK, PP, MOLMASS)
real(kind(1d0)) function rh2qa(RH, pres_hPa, Ta_degC)
real(kind(1d0)) function psyc_const(cp, Press_hPa, lv_J_kg)
real(kind(1d0)) function spec_heat_vapor(TK, RH)
real(kind(1d0)) function sat_vap_pressice(Temp_c, PRESS_hPa, from, dectime)
real(kind(1d0)) function spec_heat_dryair(TK)
real(kind(1d0)) function sat_vap_press_x(Temp_c, PRESS_hPa, from, dectime)
real(kind(1d0)) function qa2rh(qa, pres_hPa, Ta_degC)
real(kind(1d0)) function sos_dryair(TK)
real(kind(1d0)) function lat_vap(Temp_C, Ea_hPa, Press_hPa, cp, dectime)
subroutine errorhint(errh, ProblemFile, VALUE, value2, valueI)
real(kind(1d0)) function qsatf(T, PMB)
real(kind(1d0)), parameter rad2deg
real(kind(1d0)) function sat_vap_press(TK, P)
real(kind(1d0)), parameter kb