Home

Context Navigation

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

Last change on this file since 4506 was 4502, checked in by schwenkel, 5 years ago
Implementation of ice microphysics
Property svn:keywords set to `Id`
File size: 23.8 KB

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

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |