source: palm/trunk/SOURCE/basic_constants_and_equations_mod.f90 @ 4686

Last change on this file since 4686 was 4509, checked in by raasch, 5 years ago

files re-formatted to follow the PALM coding standard

  • Property svn:keywords set to Id
File size: 25.2 KB
Line 
1!> @file basic_constants_and_equations_mod.f90
2!--------------------------------------------------------------------------------------------------!
3! This file is part of the PALM model system.
4!
5! PALM is free software: you can redistribute it and/or modify it under the terms of the GNU General
6! Public License as published by the Free Software Foundation, either version 3 of the License, or
7! (at your option) any later version.
8!
9! PALM is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the
10! implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General
11! Public License for more details.
12!
13! You should have received a copy of the GNU General Public License along with PALM. If not, see
14! <http://www.gnu.org/licenses/>.
15!
16! Copyright 1997-2020 Leibniz Universitaet Hannover
17!--------------------------------------------------------------------------------------------------!
18!
19! Current revisions:
20! -----------------
21!
22!
23! Former revisions:
24! -----------------
25! $Id: basic_constants_and_equations_mod.f90 4509 2020-04-26 15:57:55Z pavelkrc $
26! file re-formatted to follow the PALM coding standard
27!
28! 4502 2020-04-17 16:14:16Z schwenkel
29! Implementation of ice microphysics
30!
31! 4400 2020-02-10 20:32:41Z suehring
32! Move routine to transform coordinates from netcdf_interface_mod to
33! basic_constants_and_equations_mod
34!
35! 4360 2020-01-07 11:25:50Z suehring
36! Corrected "Former revisions" section
37!
38! 4088 2019-07-11 13:57:56Z Giersch
39! Comment of barometric formula improved, function for ideal gas law revised
40!
41! 4084 2019-07-10 17:09:11Z knoop
42! Changed precomputed fractions to be variable based
43!
44! 4055 2019-06-27 09:47:29Z suehring
45! Added rgas_univ (universal gas constant) (E.C. Chan)
46!
47!
48! 3655 2019-01-07 16:51:22Z knoop
49! OpenACC port for SPEC
50! 3361 2018-10-16 20:39:37Z knoop
51! New module (introduced with modularization of bulk cloud physics model)
52!
53!
54!
55!
56! Description:
57! ------------
58!> This module contains all basic (physical) constants and functions for the calculation of
59!> diagnostic quantities.
60!-                    -----------------------------------------------------------------------------!
61 MODULE basic_constants_and_equations_mod
62
63
64    USE kinds
65
66    IMPLICIT NONE
67
68
69    REAL(wp), PARAMETER ::  c_p = 1005.0_wp                           !< heat capacity of dry air (J kg-1 K-1)
70    REAL(wp), PARAMETER ::  degc_to_k = 273.15_wp                     !< temperature (in K) of 0 deg C (K)
71    REAL(wp), PARAMETER ::  g = 9.81_wp                               !< gravitational acceleration (m s-2)
72    REAL(wp), PARAMETER ::  kappa = 0.4_wp                            !< von Karman constant
73    REAL(wp), PARAMETER ::  l_m = 0.33E+06_wp                         !< latent heat of water melting (J kg-1)
74    REAL(wp), PARAMETER ::  l_v = 2.5E+06_wp                          !< latent heat of water vaporization (J kg-1)
75    REAL(wp), PARAMETER ::  l_s = l_m + l_v                           !< latent heat of water sublimation (J kg-1)
76    REAL(wp), PARAMETER ::  molecular_weight_of_nacl = 0.05844_wp     !< mol. m. NaCl (kg mol-1)
77    REAL(wp), PARAMETER ::  molecular_weight_of_c3h4o4 = 0.10406_wp   !< mol. m. malonic acid (kg mol-1)
78    REAL(wp), PARAMETER ::  molecular_weight_of_nh4no3 = 0.08004_wp   !< mol. m. ammonium sulfate (kg mol-1)
79    REAL(wp), PARAMETER ::  molecular_weight_of_water = 0.01801528_wp !< mol. m. H2O (kg mol-1)
80    REAL(wp), PARAMETER ::  pi = 3.141592654_wp                       !< PI
81    !$ACC DECLARE COPYIN(pi)
82    REAL(wp), PARAMETER ::  rgas_univ = 8.31446261815324_wp           !< universal gas constant (J K-1 mol-1)
83    REAL(wp), PARAMETER ::  rho_l = 1.0E3_wp                          !< density of water (kg m-3)
84    REAL(wp), PARAMETER ::  rho_nacl = 2165.0_wp                      !< density of NaCl (kg m-3)
85    REAL(wp), PARAMETER ::  rho_c3h4o4 = 1600.0_wp                    !< density of malonic acid (kg m-3)
86    REAL(wp), PARAMETER ::  rho_nh4no3 = 1720.0_wp                    !< density of ammonium sulfate (kg m-3)
87    REAL(wp), PARAMETER ::  r_d = 287.0_wp                            !< sp. gas const. dry air (J kg-1 K-1)
88    REAL(wp), PARAMETER ::  r_v = 461.51_wp                           !< sp. gas const. water vapor (J kg-1 K-1)
89    REAL(wp), PARAMETER ::  sigma_sb = 5.67037E-08_wp                 !< Stefan-Boltzmann constant
90    REAL(wp), PARAMETER ::  solar_constant = 1368.0_wp                !< solar constant at top of atmosphere
91    REAL(wp), PARAMETER ::  vanthoff_nacl = 2.0_wp                    !< van't Hoff factor for NaCl
92    REAL(wp), PARAMETER ::  vanthoff_c3h4o4 = 1.37_wp                 !< van't Hoff factor for malonic acid
93    REAL(wp), PARAMETER ::  vanthoff_nh4no3 = 2.31_wp                 !< van't Hoff factor for ammonium sulfate
94
95    REAL(wp), PARAMETER ::  p_0 = 100000.0_wp                         !< standard pressure reference state
96
97    REAL(wp), PARAMETER ::  cp_d_rd = c_p / r_d   !< precomputed c_p / r_d
98    REAL(wp), PARAMETER ::  g_d_cp  = g   / c_p   !< precomputed g / c_p
99    REAL(wp), PARAMETER ::  lv_d_cp = l_v / c_p   !< precomputed l_v / c_p
100    REAL(wp), PARAMETER ::  ls_d_cp = l_s / c_p   !< precomputed l_s / c_p
101    REAL(wp), PARAMETER ::  lv_d_rd = l_v / r_d   !< precomputed l_v / r_d
102    REAL(wp), PARAMETER ::  rd_d_rv = r_d / r_v   !< precomputed r_d / r_v
103    REAL(wp), PARAMETER ::  rd_d_cp = r_d / c_p   !< precomputed r_d / c_p
104
105    REAL(wp) ::  molecular_weight_of_solute = molecular_weight_of_nacl  !< mol. m. NaCl (kg mol-1)
106    REAL(wp) ::  rho_s = rho_nacl                                       !< density of NaCl (kg m-3)
107    REAL(wp) ::  vanthoff = vanthoff_nacl                               !< van't Hoff factor for NaCl
108
109    SAVE
110
111    PRIVATE magnus_0d,                                                                             &
112            magnus_1d,                                                                             &
113            magnus_tl_0d,                                                                          &
114            magnus_tl_1d,                                                                          &
115            magnus_0d_ice,                                                                         &
116            magnus_1d_ice,                                                                         &
117            ideal_gas_law_rho_0d,                                                                  &
118            ideal_gas_law_rho_1d,                                                                  &
119            ideal_gas_law_rho_pt_0d,                                                               &
120            ideal_gas_law_rho_pt_1d,                                                               &
121            exner_function_0d,                                                                     &
122            exner_function_1d,                                                                     &
123            exner_function_invers_0d,                                                              &
124            exner_function_invers_1d,                                                              &
125            barometric_formula_0d,                                                                 &
126            barometric_formula_1d
127
128
129    INTERFACE convert_utm_to_geographic
130       MODULE PROCEDURE convert_utm_to_geographic
131    END INTERFACE convert_utm_to_geographic
132
133    INTERFACE magnus
134       MODULE PROCEDURE magnus_0d
135       MODULE PROCEDURE magnus_1d
136    END INTERFACE magnus
137
138    INTERFACE magnus_tl
139       MODULE PROCEDURE magnus_tl_0d
140       MODULE PROCEDURE magnus_tl_1d
141    END INTERFACE magnus_tl
142
143    INTERFACE magnus_ice
144       MODULE PROCEDURE magnus_0d_ice
145       MODULE PROCEDURE magnus_1d_ice
146    END INTERFACE magnus_ice
147
148    INTERFACE ideal_gas_law_rho
149       MODULE PROCEDURE ideal_gas_law_rho_0d
150       MODULE PROCEDURE ideal_gas_law_rho_1d
151    END INTERFACE ideal_gas_law_rho
152
153    INTERFACE ideal_gas_law_rho_pt
154       MODULE PROCEDURE ideal_gas_law_rho_pt_0d
155       MODULE PROCEDURE ideal_gas_law_rho_pt_1d
156    END INTERFACE ideal_gas_law_rho_pt
157
158    INTERFACE exner_function
159       MODULE PROCEDURE exner_function_0d
160       MODULE PROCEDURE exner_function_1d
161    END INTERFACE exner_function
162
163    INTERFACE exner_function_invers
164       MODULE PROCEDURE exner_function_invers_0d
165       MODULE PROCEDURE exner_function_invers_1d
166    END INTERFACE exner_function_invers
167
168    INTERFACE barometric_formula
169       MODULE PROCEDURE barometric_formula_0d
170       MODULE PROCEDURE barometric_formula_1d
171    END INTERFACE barometric_formula
172!
173!-- Public routines
174    PUBLIC convert_utm_to_geographic
175
176 CONTAINS
177
178
179!--------------------------------------------------------------------------------------------------!
180! Description:
181! ------------
182!> Convert UTM coordinates into geographic latitude and longitude. Conversion is based on the work
183!> of KrÃŒger (1912) DOI: 10.2312/GFZ.b103-krueger28 and Karney (2013) DOI: 10.1007/s00190-012-0578-z
184!> Based on a JavaScript of the geodesy function library written by chrisveness
185!> https://github.com/chrisveness/geodesy
186!--------------------------------------------------------------------------------------------------!
187 SUBROUTINE convert_utm_to_geographic( crs, eutm, nutm, lon, lat )
188
189    INTEGER(iwp) ::  j   !< loop index
190
191    REAL(wp), INTENT(in)  ::  eutm !< easting (UTM)
192    REAL(wp), INTENT(out) ::  lat  !< geographic latitude in degree
193    REAL(wp), INTENT(out) ::  lon  !< geographic longitude in degree
194    REAL(wp), INTENT(in)  ::  nutm !< northing (UTM)
195
196    REAL(wp) ::  a           !< 2*pi*a is the circumference of a meridian
197    REAL(wp) ::  cos_eta_s   !< cos(eta_s)
198    REAL(wp) ::  delta_i     !<
199    REAL(wp) ::  delta_tau_i !<
200    REAL(wp) ::  e           !< eccentricity
201    REAL(wp) ::  eta         !<
202    REAL(wp) ::  eta_s       !<
203    REAL(wp) ::  n           !< 3rd flattening
204    REAL(wp) ::  n2          !< n^2
205    REAL(wp) ::  n3          !< n^3
206    REAL(wp) ::  n4          !< n^4
207    REAL(wp) ::  n5          !< n^5
208    REAL(wp) ::  n6          !< n^6
209    REAL(wp) ::  nu          !<
210    REAL(wp) ::  nu_s        !<
211    REAL(wp) ::  sin_eta_s   !< sin(eta_s)
212    REAL(wp) ::  sinh_nu_s   !< sinush(nu_s)
213    REAL(wp) ::  tau_i       !<
214    REAL(wp) ::  tau_i_s     !<
215    REAL(wp) ::  tau_s       !<
216    REAL(wp) ::  x           !< adjusted easting
217    REAL(wp) ::  y           !< adjusted northing
218
219    REAL(wp), DIMENSION(6) ::  beta !< 6th order KrÃŒger expressions
220
221    REAL(wp), DIMENSION(8), INTENT(in) ::  crs !< coordinate reference system, consists of
222                                               !< (/semi_major_axis,
223                                               !<   inverse_flattening,
224                                               !<   longitude_of_prime_meridian,
225                                               !<   longitude_of_central_meridian,
226                                               !<   scale_factor_at_central_meridian,
227                                               !<   latitude_of_projection_origin,
228                                               !<   false_easting,
229                                               !<   false_northing /)
230
231    x = eutm - crs(7)  ! remove false easting
232    y = nutm - crs(8)  ! remove false northing
233!
234!-- From Karney 2011 Eq 15-22, 36:
235    e = SQRT( 1.0_wp / crs(2) * ( 2.0_wp - 1.0_wp / crs(2) ) )
236    n = 1.0_wp / crs(2) / ( 2.0_wp - 1.0_wp / crs(2) )
237    n2 = n * n
238    n3 = n * n2
239    n4 = n * n3
240    n5 = n * n4
241    n6 = n * n5
242
243    a = crs(1) / ( 1.0_wp + n ) * ( 1.0_wp + 0.25_wp * n2 + 0.015625_wp * n4 + 3.90625E-3_wp * n6 )
244
245    nu  = x / ( crs(5) * a )
246    eta = y / ( crs(5) * a )
247
248!-- According to KrÃŒger (1912), eq. 26*
249    beta(1) =          0.5_wp                  * n                                                 &
250              -        2.0_wp /         3.0_wp * n2                                                &
251              +       37.0_wp /        96.0_wp * n3                                                &
252              -        1.0_wp /       360.0_wp * n4                                                &
253              -       81.0_wp /       512.0_wp * n5                                                &
254              +    96199.0_wp /    604800.0_wp * n6
255
256    beta(2) =          1.0_wp /        48.0_wp * n2                                                &
257              +        1.0_wp /        15.0_wp * n3                                                &
258              -      437.0_wp /      1440.0_wp * n4                                                &
259              +       46.0_wp /       105.0_wp * n5                                                &
260              -  1118711.0_wp /   3870720.0_wp * n6
261
262    beta(3) =         17.0_wp /       480.0_wp * n3                                                &
263              -       37.0_wp /       840.0_wp * n4                                                &
264              -      209.0_wp /      4480.0_wp * n5                                                &
265              +     5569.0_wp /     90720.0_wp * n6
266
267    beta(4) =       4397.0_wp /    161280.0_wp * n4                                                &
268              -       11.0_wp /       504.0_wp * n5                                                &
269              -   830251.0_wp /   7257600.0_wp * n6
270
271    beta(5) =       4583.0_wp /    161280.0_wp * n5                                                &
272              -   108847.0_wp /   3991680.0_wp * n6
273
274    beta(6) =   20648693.0_wp / 638668800.0_wp * n6
275
276    eta_s = eta
277    nu_s  = nu
278    DO  j = 1, 6
279      eta_s = eta_s - beta(j) * SIN(2.0_wp * j * eta) * COSH(2.0_wp * j * nu)
280      nu_s  = nu_s  - beta(j) * COS(2.0_wp * j * eta) * SINH(2.0_wp * j * nu)
281    ENDDO
282
283    sinh_nu_s = SINH( nu_s )
284    sin_eta_s = SIN( eta_s )
285    cos_eta_s = COS( eta_s )
286
287    tau_s = sin_eta_s / SQRT( sinh_nu_s**2 + cos_eta_s**2 )
288
289    tau_i = tau_s
290    delta_tau_i = 1.0_wp
291
292    DO WHILE ( ABS( delta_tau_i ) > 1.0E-12_wp )
293
294      delta_i = SINH( e * ATANH( e * tau_i / SQRT( 1.0_wp + tau_i**2 ) ) )
295
296      tau_i_s = tau_i   * SQRT( 1.0_wp + delta_i**2 ) - delta_i * SQRT( 1.0_wp + tau_i**2 )
297
298      delta_tau_i = ( tau_s - tau_i_s ) / SQRT( 1.0_wp + tau_i_s**2 )                              &
299                    * ( 1.0_wp + ( 1.0_wp - e**2 ) * tau_i**2 )                                    &
300                    / ( ( 1.0_wp - e**2 ) * SQRT( 1.0_wp + tau_i**2 ) )
301
302      tau_i = tau_i + delta_tau_i
303
304    ENDDO
305
306    lat = ATAN( tau_i ) / pi * 180.0_wp
307    lon = ATAN2( sinh_nu_s, cos_eta_s ) / pi * 180.0_wp + crs(4)
308
309 END SUBROUTINE convert_utm_to_geographic
310
311!--------------------------------------------------------------------------------------------------!
312! Description:
313! ------------
314!> This function computes the magnus formula (Press et al., 1992).
315!> The magnus formula is needed to calculate the saturation vapor pressure.
316!--------------------------------------------------------------------------------------------------!
317 FUNCTION magnus_0d( t )
318
319    IMPLICIT NONE
320
321    REAL(wp), INTENT(IN) ::  t  !< temperature (K)
322
323    REAL(wp) ::  magnus_0d
324
325!
326!-- Saturation vapor pressure for a specific temperature:
327    magnus_0d =  611.2_wp * EXP( 17.62_wp * ( t - degc_to_k ) / ( t - 29.65_wp  ) )
328
329 END FUNCTION magnus_0d
330
331!--------------------------------------------------------------------------------------------------!
332! Description:
333! ------------
334!> This function computes the magnus formula (Press et al., 1992).
335!> The magnus formula is needed to calculate the saturation vapor pressure.
336!--------------------------------------------------------------------------------------------------!
337 FUNCTION magnus_1d( t )
338
339    IMPLICIT NONE
340
341    REAL(wp), INTENT(IN), DIMENSION(:) ::  t  !< temperature (K)
342
343    REAL(wp), DIMENSION(size(t)) ::  magnus_1d
344
345!
346!-- Saturation vapor pressure for a specific temperature:
347    magnus_1d =  611.2_wp * EXP( 17.62_wp * ( t - degc_to_k ) / ( t - 29.65_wp  ) )
348
349 END FUNCTION magnus_1d
350
351!--------------------------------------------------------------------------------------------------!
352! Description:
353! ------------
354!> This function computes the magnus formula (Press et al., 1992) using the (ice-) liquid water
355!> potential temperature.
356!> The magnus formula is needed to calculate the saturation vapor pressure over a plane liquid water
357!> surface.
358!--------------------------------------------------------------------------------------------------!
359 FUNCTION magnus_tl_0d( t_l )
360
361    IMPLICIT NONE
362
363    REAL(wp), INTENT(IN) ::  t_l  !< liquid water temperature (K)
364
365    REAL(wp) ::  magnus_tl_0d
366
367!
368!-- Saturation vapor pressure for a specific temperature:
369    magnus_tl_0d =  610.78_wp * EXP( 17.269_wp * ( t_l - 273.16_wp ) / ( t_l - 35.86_wp  ) )
370
371 END FUNCTION magnus_tl_0d
372
373!--------------------------------------------------------------------------------------------------!
374! Description:
375! ------------
376!> This function computes the magnus formula (Press et al., 1992) using the (ice-) liquid water
377!> potential temperature.
378!> The magnus formula is needed to calculate the saturation vapor pressure over a plane liquid water
379!> surface.
380!--------------------------------------------------------------------------------------------------!
381 FUNCTION magnus_tl_1d( t_l )
382
383    IMPLICIT NONE
384
385    REAL(wp), INTENT(IN), DIMENSION(:) ::  t_l  !< liquid water temperature (K)
386
387    REAL(wp), DIMENSION(size(t_l)) ::  magnus_tl_1d
388!
389!-- Saturation vapor pressure for a specific temperature:
390    magnus_tl_1d =  610.78_wp * EXP( 17.269_wp * ( t_l - 273.16_wp ) / ( t_l - 35.86_wp  ) )
391
392 END FUNCTION magnus_tl_1d
393
394!--------------------------------------------------------------------------------------------------!
395! Description:
396! ------------
397!> This function computes the magnus formula (Press et al., 1992).
398!> The magnus formula is needed to calculate the saturation vapor pressure over a plane ice surface.
399!--------------------------------------------------------------------------------------------------!
400 FUNCTION magnus_0d_ice( t )
401
402    IMPLICIT NONE
403
404    REAL(wp), INTENT(IN) ::  t  !< temperature (K)
405
406    REAL(wp) ::  magnus_0d_ice
407
408!
409!--    Saturation vapor pressure for a specific temperature:
410    magnus_0d_ice =  611.2_wp * EXP( 22.46_wp * ( t - degc_to_k ) / ( t - 0.53_wp  ) )
411
412 END FUNCTION magnus_0d_ice
413
414!--------------------------------------------------------------------------------------------------!
415! Description:
416! ------------
417!> This function computes the magnus formula (Press et al., 1992).
418!> The magnus formula is needed to calculate the saturation vapor pressure over a plane ice surface.
419!--------------------------------------------------------------------------------------------------!
420 FUNCTION magnus_1d_ice( t )
421
422    IMPLICIT NONE
423
424    REAL(wp), INTENT(IN), DIMENSION(:) ::  t  !< temperature (K)
425
426    REAL(wp), DIMENSION(size(t)) ::  magnus_1d_ice
427
428!
429!-- Saturation vapor pressure for a specific temperature:
430    magnus_1d_ice =  611.2_wp * EXP( 22.46_wp * ( t - degc_to_k ) / ( t - 0.53_wp  ) )
431
432 END FUNCTION magnus_1d_ice
433
434!--------------------------------------------------------------------------------------------------!
435! Description:
436! ------------
437!> Compute the ideal gas law for scalar arguments.
438!--------------------------------------------------------------------------------------------------!
439 FUNCTION ideal_gas_law_rho_0d( p, t )
440
441    IMPLICIT NONE
442
443    REAL(wp), INTENT(IN) ::  p  !< pressure (Pa)
444    REAL(wp), INTENT(IN) ::  t  !< temperature (K)
445
446    REAL(wp) ::  ideal_gas_law_rho_0d
447
448!
449!-- Compute density according to ideal gas law:
450    ideal_gas_law_rho_0d = p / (r_d * t)
451
452 END FUNCTION ideal_gas_law_rho_0d
453
454!--------------------------------------------------------------------------------------------------!
455! Description:
456! ------------
457!> Compute the ideal gas law for 1-D array arguments.
458!--------------------------------------------------------------------------------------------------!
459 FUNCTION ideal_gas_law_rho_1d( p, t )
460
461    IMPLICIT NONE
462
463    REAL(wp), INTENT(IN), DIMENSION(:) ::  p  !< pressure (Pa)
464    REAL(wp), INTENT(IN), DIMENSION(:) ::  t  !< temperature (K)
465
466    REAL(wp), DIMENSION(size(p)) ::  ideal_gas_law_rho_1d
467
468!
469!-- Compute density according to ideal gas law:
470    ideal_gas_law_rho_1d = p / (r_d * t)
471
472 END FUNCTION ideal_gas_law_rho_1d
473
474!--------------------------------------------------------------------------------------------------!
475! Description:
476! ------------
477!> Compute the ideal gas law for scalar arguments.
478!--------------------------------------------------------------------------------------------------!
479 FUNCTION ideal_gas_law_rho_pt_0d( p, t )
480
481    IMPLICIT NONE
482
483    REAL(wp), INTENT(IN) ::  p  !< pressure (Pa)
484    REAL(wp), INTENT(IN) ::  t  !< temperature (K)
485
486    REAL(wp) ::  ideal_gas_law_rho_pt_0d
487
488!
489!-- Compute density according to ideal gas law:
490    ideal_gas_law_rho_pt_0d = p / (r_d * exner_function(p) * t)
491
492 END FUNCTION ideal_gas_law_rho_pt_0d
493
494!--------------------------------------------------------------------------------------------------!
495! Description:
496! ------------
497!> Compute the ideal gas law for 1-D array arguments.
498!--------------------------------------------------------------------------------------------------!
499 FUNCTION ideal_gas_law_rho_pt_1d( p, t )
500
501    IMPLICIT NONE
502
503    REAL(wp), INTENT(IN), DIMENSION(:) ::  p  !< pressure (Pa)
504    REAL(wp), INTENT(IN), DIMENSION(:) ::  t  !< temperature (K)
505
506    REAL(wp), DIMENSION(size(p)) ::  ideal_gas_law_rho_pt_1d
507
508!
509!-- Compute density according to ideal gas law:
510    ideal_gas_law_rho_pt_1d = p / (r_d * exner_function(p) * t)
511
512 END FUNCTION ideal_gas_law_rho_pt_1d
513
514!--------------------------------------------------------------------------------------------------!
515! Description:
516! ------------
517!> Compute the exner function for scalar arguments.
518!--------------------------------------------------------------------------------------------------!
519 FUNCTION exner_function_0d( p )
520
521    IMPLICIT NONE
522
523    REAL(wp), INTENT(IN) ::  p    !< pressure (Pa)
524
525    REAL(wp) ::  exner_function_0d
526
527!
528!-- Compute exner function:
529    exner_function_0d = ( p / p_0 )**( rd_d_cp )
530
531 END FUNCTION exner_function_0d
532
533!--------------------------------------------------------------------------------------------------!
534! Description:
535! ------------
536!> Compute the exner function for 1-D array arguments.
537!--------------------------------------------------------------------------------------------------!
538 FUNCTION exner_function_1d( p )
539
540    IMPLICIT NONE
541
542    REAL(wp), INTENT(IN), DIMENSION(:) ::  p  !< pressure (Pa)
543
544    REAL(wp), DIMENSION(size(p)) ::  exner_function_1d
545
546!
547!-- Compute exner function:
548    exner_function_1d = ( p / p_0 )**( rd_d_cp )
549
550 END FUNCTION exner_function_1d
551
552!--------------------------------------------------------------------------------------------------!
553! Description:
554! ------------
555!> Compute the exner function for scalar arguments.
556!--------------------------------------------------------------------------------------------------!
557 FUNCTION exner_function_invers_0d( p )
558
559    IMPLICIT NONE
560
561    REAL(wp), INTENT(IN) ::  p    !< pressure (Pa)
562
563    REAL(wp) ::  exner_function_invers_0d
564
565!
566!-- Compute exner function:
567    exner_function_invers_0d = ( p_0 / p )**( rd_d_cp )
568
569 END FUNCTION exner_function_invers_0d
570
571!--------------------------------------------------------------------------------------------------!
572! Description:
573! ------------
574!> Compute the exner function for 1-D array arguments.
575!--------------------------------------------------------------------------------------------------!
576 FUNCTION exner_function_invers_1d( p )
577
578    IMPLICIT NONE
579
580    REAL(wp), INTENT(IN), DIMENSION(:) ::  p  !< pressure (Pa)
581
582    REAL(wp), DIMENSION(size(p)) ::  exner_function_invers_1d
583
584!
585!-- Compute exner function:
586    exner_function_invers_1d = ( p_0 / p )**( rd_d_cp )
587
588 END FUNCTION exner_function_invers_1d
589
590!--------------------------------------------------------------------------------------------------!
591! Description:
592! ------------
593!> Compute the barometric formula for scalar arguments. The calculation is based on the assumption
594!> of a polytropic atmosphere and neutral stratification, where the temperature lapse rate is g/cp.
595!--------------------------------------------------------------------------------------------------!
596 FUNCTION barometric_formula_0d( z, t_0, p_0)
597
598    IMPLICIT NONE
599
600    REAL(wp), INTENT(IN) ::  z    !< height (m)
601    REAL(wp), INTENT(IN) ::  t_0  !< temperature reference state (K)
602    REAL(wp), INTENT(IN) ::  p_0  !< surface pressure (Pa)
603
604    REAL(wp) ::  barometric_formula_0d
605
606!
607!-- Compute barometric formula:
608    barometric_formula_0d =  p_0 * ( (t_0 - g_d_cp * z) / t_0 )**( cp_d_rd )
609
610 END FUNCTION barometric_formula_0d
611
612!--------------------------------------------------------------------------------------------------!
613! Description:
614! ------------
615!> Compute the barometric formula for 1-D array arguments. The calculation is based on the
616!> assumption of a polytropic atmosphere and neutral stratification, where the temperature lapse
617!> rate is g/cp.
618!--------------------------------------------------------------------------------------------------!
619 FUNCTION barometric_formula_1d( z, t_0, p_0)
620
621    IMPLICIT NONE
622
623    REAL(wp), INTENT(IN), DIMENSION(:) ::  z  !< height (m)
624    REAL(wp), INTENT(IN) ::  t_0              !< temperature reference state (K)
625    REAL(wp), INTENT(IN) ::  p_0              !< surface pressure (Pa)
626
627    REAL(wp), DIMENSION(size(z)) ::  barometric_formula_1d
628
629!
630!-- Compute barometric formula:
631    barometric_formula_1d =  p_0 * ( (t_0 - g_d_cp * z) / t_0 )**( cp_d_rd )
632
633 END FUNCTION barometric_formula_1d
634
635 END MODULE basic_constants_and_equations_mod
Note: See TracBrowser for help on using the repository browser.