Home

Context Navigation

source: palm/trunk/SOURCE/biometeorology_pt_mod.f90 @ 3448

Last change on this file since 3448 was 3448, checked in by kanani, 5 years ago
Implementation of human thermal indices (from branch biomet_p2 at r3444)
Property svn:executable set to ``*
File size: 38.8 KB

Line
1	!> @file biometeorology_pt_mod.f90
2	!--------------------------------------------------------------------------------!
3	! This file is part of PALM-4U.
4	!
5	! PALM-4U 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-4U 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	!
17	! Copyright 1997-2019, Deutscher Wetterdienst (DWD) /
18	! German Meteorological Service (DWD) and
19	! Leibniz Universitaet Hannover
20	!--------------------------------------------------------------------------------!
21	!
22	! Current revisions: 001
23	! -----------------
24	!
25	!
26	! Former revisions: 001
27	! -----------------
28	! $Id$
29	! Initial revision 001
30	!
31	!
32	!
33	! Authors:
34	! --------
35	! @author Dominik Froehlich <dominik.froehlich@mailbox.org>
36	!
37	!
38	! Description:
39	! ------------
40	!> Module for the calculation of the thermal index perceived temperature (PT).
41	!> The Perceived Temperature is the air temperature in a reference environ-
42	!> ment that results in the same Predicted Mean Vote (Fanger 1972), PMV, as
43	!> the real environment. In the reference environment the mean radiant
44	!> temperature is equal to the air temperature and the wind speed is reduced
45	!> to a value set at 0.1 m/s. The Perceived Temperature is linked to a
46	!> reference individual: male aged 35 years, body height 1.75 m, weight
47	!> 75 kg, walking with 4 km per hour on a horizontal plain (related to an
48	!> internal heat production of 172.5 W). The person varies the thermal
49	!> resistance of clothing (clo) in the range Icl=1.75 clo (winter) and
50	!> Icl=0.50 clo (summer) to achieve thermal comfort (PMV = 0) if possible.
51	!> If not possible the individual perceives cold stress (winter, 1.75 clo)
52	!> or heat load (summer, 0.5 clo).
53	!>
54	!> @todo
55	!>
56	!> @note nothing now
57	!>
58	!> @bug no known bugs by now
59	!------------------------------------------------------------------------------!
60	MODULE biometeorology_pt_mod
61
62	!-- Load required variables from existing modules
63	USE kinds !< to set precision of INTEGER and REAL arrays according to PALM
64
65	IMPLICIT NONE
66
67	PRIVATE !-- no private interfaces --!
68
69	PUBLIC calculate_pt_static, saturation_vapor_pressure, deltapmv, dpmv_adj, &
70	dpmv_cold, fanger, calc_sultr, pt_regression, ireq_neutral, iso_ridder
71
72	!-- PALM interfaces:
73	INTERFACE calculate_pt_static
74	MODULE PROCEDURE calculate_pt_static
75	END INTERFACE calculate_pt_static
76
77	INTERFACE saturation_vapor_pressure
78	MODULE PROCEDURE saturation_vapor_pressure
79	END INTERFACE saturation_vapor_pressure
80
81	INTERFACE deltapmv
82	MODULE PROCEDURE deltapmv
83	END INTERFACE deltapmv
84
85	INTERFACE dpmv_adj
86	MODULE PROCEDURE dpmv_adj
87	END INTERFACE dpmv_adj
88
89	INTERFACE dpmv_cold
90	MODULE PROCEDURE dpmv_cold
91	END INTERFACE dpmv_cold
92
93	INTERFACE fanger
94	MODULE PROCEDURE fanger
95	END INTERFACE fanger
96
97	INTERFACE calc_sultr
98	MODULE PROCEDURE calc_sultr
99	END INTERFACE calc_sultr
100
101	INTERFACE pt_regression
102	MODULE PROCEDURE pt_regression
103	END INTERFACE pt_regression
104
105	INTERFACE ireq_neutral
106	MODULE PROCEDURE ireq_neutral
107	END INTERFACE ireq_neutral
108
109	INTERFACE iso_ridder
110	MODULE PROCEDURE iso_ridder
111	END INTERFACE iso_ridder
112
113	CONTAINS
114
115	!------------------------------------------------------------------------------!
116	! Description:
117	! ------------
118	!> PT_BASIC.F90 Version of perceived temperature (PT, °C) for
119	!> - standard measured/predicted meteorological values and TMRT
120	!> as input;
121	!> - regressions for determination of PT;
122	!> - adjustment to Gagge's PMV* (2-node-model, 1986) as base of PT
123	!> under warm/humid conditions (Icl= 0.50 clo) and under cold
124	!> conditions (Icl= 1.75 clo)
125	!>
126	!> Function value is the Perceived Temperature, degree centigrade
127	!------------------------------------------------------------------------------!
128	SUBROUTINE calculate_pt_static( tt2m, el2m, vau1m, tmrt, pb, clo, pt_basic )
129
130	IMPLICIT NONE
131
132	!-- Type of input of the argument list
133	REAL(wp), INTENT ( IN ) :: tt2m !< Local air temperature (°C)
134	REAL(wp), INTENT ( IN ) :: el2m !< Local vapour pressure (hPa)
135	REAL(wp), INTENT ( IN ) :: tmrt !< Local mean radiant temperature (°C)
136	REAL(wp), INTENT ( IN ) :: vau1m !< Local wind velocitry (m/s)
137	REAL(wp), INTENT ( IN ) :: pb !< Local barometric air pressure (hPa)
138
139	!-- Type of output of the argument list
140	REAL(wp), INTENT ( OUT ) :: pt_basic !< Perceived temperature (°C)
141	REAL(wp), INTENT ( OUT ) :: clo !< Clothing index (dimensionless)
142
143	!-- Parameters for standard "Klima-Michel"
144	REAL(wp), PARAMETER :: eta = 0._wp !< Mechanical work efficiency for walking on flat ground (compare to Fanger (1972) pp 24f)
145	REAL(wp), PARAMETER :: actlev = 134.6862_wp !< Workload by activity per standardized surface (A_Du)
146
147	!-- Type of program variables
148	REAL(wp), PARAMETER :: eps = 0.0005 !< Accuracy in clothing insulation (clo) for evaluation the root of Fanger's PMV (pmva=0)
149	REAL(wp) :: uclo
150	REAL(wp) :: oclo
151	REAL(wp) :: d_pmv
152	REAL(wp) :: svp_tt
153	REAL(wp) :: sult_lim
154	REAL(wp) :: dgtcm
155	REAL(wp) :: dgtcstd
156	REAL(wp) :: clon
157	REAL(wp) :: ireq_minimal
158	REAL(wp) :: clo_fanger
159	REAL(wp) :: pmv_o
160	REAL(wp) :: pmv_u
161	REAL(wp) :: pmva
162	REAL(wp) :: ptc
163	REAL(wp) :: d_std
164	REAL(wp) :: pmvs
165	REAL(wp) :: top
166
167	INTEGER(iwp) :: nzaehl, nerr_kalt, nerr
168
169	LOGICAL :: sultrieness
170
171	!-- Initialise
172	pt_basic = 9999.0_wp
173
174	nerr = 0_iwp
175	nzaehl = 0_iwp
176	sultrieness = .FALSE.
177	!-- Tresholds: clothing insulation (account for model inaccuracies)
178	! summer clothing
179	uclo = 0.44453_wp
180	! winter clothing
181	oclo = 1.76267_wp
182
183	!-- decision: firstly calculate for winter or summer clothing
184	IF ( tt2m <= 10._wp ) THEN
185
186	!-- First guess: winter clothing insulation: cold stress
187	clo = oclo
188	CALL fanger ( tt2m, tmrt, el2m, vau1m, pb, clo, actlev, eta, pmva, top )
189	pmv_o = pmva
190
191	IF ( pmva > 0._wp ) THEN
192
193	!-- Case summer clothing insulation: heat load ?
194	clo = uclo
195	CALL fanger ( tt2m, tmrt, el2m, vau1m, pb, clo, actlev, eta, pmva, &
196	top )
197	pmv_u = pmva
198	IF ( pmva <= 0._wp ) THEN
199	!-- Case: comfort achievable by varying clothing insulation
200	!-- Between winter and summer set values
201	CALL iso_ridder ( tt2m, tmrt, el2m, vau1m, pb, actlev, eta, uclo, &
202	pmv_u, oclo, pmv_o, eps, pmva, top, nzaehl, clo )
203	IF ( nzaehl < 0_iwp ) THEN
204	nerr = -1_iwp
205	RETURN
206	ENDIF
207	ELSE IF ( pmva > 0.06_wp ) THEN
208	clo = 0.5_wp
209	CALL fanger ( tt2m, tmrt, el2m, vau1m, pb, clo, actlev, eta, &
210	pmva, top )
211	ENDIF
212	ELSE IF ( pmva < -0.11_wp ) THEN
213	clo = 1.75_wp
214	CALL fanger ( tt2m, tmrt, el2m, vau1m, pb, clo, actlev, eta, pmva, &
215	top )
216	ENDIF
217	ELSE
218
219	!-- First guess: summer clothing insulation: heat load
220	clo = uclo
221	CALL fanger ( tt2m, tmrt, el2m, vau1m, pb, clo, actlev, eta, pmva, top )
222	pmv_u = pmva
223
224	IF ( pmva < 0._wp ) THEN
225
226	!-- Case winter clothing insulation: cold stress ?
227	clo = oclo
228	CALL fanger ( tt2m, tmrt, el2m, vau1m, pb, clo, actlev, eta, pmva, &
229	top )
230	pmv_o = pmva
231
232	IF ( pmva >= 0._wp ) THEN
233
234	!-- Case: comfort achievable by varying clothing insulation
235	! between winter and summer set values
236	CALL iso_ridder ( tt2m, tmrt, el2m, vau1m, pb, actlev, eta, uclo, &
237	pmv_u, oclo, pmv_o, eps, pmva, top, nzaehl, clo )
238	IF ( nzaehl < 0_iwp ) THEN
239	nerr = -1_iwp
240	RETURN
241	ENDIF
242	ELSE IF ( pmva < -0.11_wp ) THEN
243	clo = 1.75_wp
244	CALL fanger ( tt2m, tmrt, el2m, vau1m, pb, clo, actlev, eta, &
245	pmva, top )
246	ENDIF
247	ELSE IF ( pmva > 0.06_wp ) THEN
248	clo = 0.5_wp
249	CALL fanger ( tt2m, tmrt, el2m, vau1m, pb, clo, actlev, eta, pmva, &
250	top )
251	ENDIF
252
253	ENDIF
254
255	!-- Determine perceived temperature by regression equation + adjustments
256	pmvs = pmva
257	CALL pt_regression ( pmva, clo, pt_basic )
258	ptc = pt_basic
259	IF ( clo >= 1.75_wp .AND. pmva <= -0.11_wp ) THEN
260	!-- Adjust for cold conditions according to Gagge 1986
261	CALL dpmv_cold ( pmva, tt2m, vau1m, tmrt, nerr_kalt, d_pmv )
262	IF ( nerr_kalt > 0_iwp ) nerr = -5_iwp
263	pmvs = pmva - d_pmv
264	IF ( pmvs > -0.11_wp ) THEN
265	d_pmv = 0._wp
266	pmvs = -0.11_wp
267	ENDIF
268	CALL pt_regression ( pmvs, clo, pt_basic )
269	ENDIF
270	clo_fanger = clo
271	clon = clo
272	IF ( clo > 0.5_wp .AND. pt_basic <= 8.73_wp ) THEN
273	!-- Required clothing insulation (ireq) is exclusively defined for
274	! operative temperatures (top) less 10 (C) for a
275	! reference wind of 0.2 m/s according to 8.73 (C) for 0.1 m/s
276	clon = ireq_neutral ( pt_basic, ireq_minimal, nerr )
277	clo = clon
278	ENDIF
279	CALL calc_sultr ( ptc, dgtcm, dgtcstd, sult_lim )
280	sultrieness = .FALSE.
281	d_std = -99._wp
282	IF ( pmva > 0.06_wp .AND. clo <= 0.5_wp ) THEN
283	!-- Adjust for warm/humid conditions according to Gagge 1986
284	CALL saturation_vapor_pressure ( tt2m, svp_tt )
285	d_pmv = deltapmv ( pmva, tt2m, el2m, svp_tt, tmrt, vau1m, nerr )
286	pmvs = pmva + d_pmv
287	CALL pt_regression ( pmvs, clo, pt_basic )
288	IF ( sult_lim < 99._wp ) THEN
289	IF ( (pt_basic - ptc) > sult_lim ) sultrieness = .TRUE.
290	!-- Set factor to threshold for sultriness
291	IF ( dgtcstd /= 0_iwp ) THEN
292	d_std = ( ( pt_basic - ptc ) - dgtcm ) / dgtcstd
293	ENDIF
294	ENDIF
295	ENDIF
296
297	END SUBROUTINE calculate_pt_static
298
299	!------------------------------------------------------------------------------!
300	! Description:
301	! ------------
302	!> The SUBROUTINE calculates the saturation water vapour pressure
303	!> (hPa = hecto Pascal) for a given temperature tt (°C).
304	!> For example, tt can be the air temperature or the dew point temperature.
305	!------------------------------------------------------------------------------!
306	SUBROUTINE saturation_vapor_pressure( tt, p_st )
307
308	IMPLICIT NONE
309
310	REAL(wp), INTENT ( IN ) :: tt !< ambient air temperature (°C)
311	REAL(wp), INTENT ( OUT ) :: p_st !< saturation water vapour pressure (hPa)
312
313	REAL(wp) :: b
314	REAL(wp) :: c
315
316
317	IF ( tt < 0._wp ) THEN
318	!-- tt < 0 (°C): saturation water vapour pressure over ice
319	b = 17.84362_wp
320	c = 245.425_wp
321	ELSE
322	!-- tt >= 0 (°C): saturation water vapour pressure over water
323	b = 17.08085_wp
324	c = 234.175_wp
325	ENDIF
326
327	!-- Saturation water vapour pressure
328	p_st = 6.1078_wp * EXP ( b * tt / ( c + tt ) )
329
330	END SUBROUTINE saturation_vapor_pressure
331
332	!------------------------------------------------------------------------------!
333	! Description:
334	! ------------
335	! Find the clothing insulation value clo_res (clo) to make Fanger's Predicted
336	! Mean Vote (PMV) equal comfort (pmva=0) for actual meteorological conditions
337	! (tt2m,tmrt, el2m, vau1m, pb) and values of individual's activity level
338	! (Klima-Michel: 134.682 W/m2 = 2.3 met, mechanincal work load eta= 0 W/m2),
339	! i.e. find the root of Fanger's comfort equation
340	!------------------------------------------------------------------------------!
341	SUBROUTINE iso_ridder( tt2m, tmrt, el2m, vau1m, pb, actlev, eta, uclo, &
342	pmv_u, oclo, pmv_o, eps, pmva, top, nerr, &
343	clo_res )
344
345	IMPLICIT NONE
346
347	!-- Input variables of argument list:
348	REAL(wp), INTENT ( IN ) :: tt2m !< Ambient temperature (°C)
349	REAL(wp), INTENT ( IN ) :: tmrt !< Mean radiant temperature (°C)
350	REAL(wp), INTENT ( IN ) :: el2m !< Water vapour pressure (hPa)
351	REAL(wp), INTENT ( IN ) :: vau1m !< Wind speed (m/s) 1 m above ground
352	REAL(wp), INTENT ( IN ) :: pb !< Barometric pressure (hPa)
353	REAL(wp), INTENT ( IN ) :: actlev !< Individuals activity level per unit surface area (W/m2)
354	REAL(wp), INTENT ( IN ) :: eta !< Individuals work efficiency (dimensionless)
355	REAL(wp), INTENT ( IN ) :: uclo !< Lower threshold of bracketing clothing insulation (clo)
356	REAL(wp), INTENT ( IN ) :: oclo !< Upper threshold of bracketing clothing insulation (clo)
357	REAL(wp), INTENT ( IN ) :: eps !< (0.05) accuracy in clothing insulation (clo) for
358	! evaluation the root of Fanger's PMV (pmva=0)
359	REAL(wp), INTENT ( IN ) :: pmv_o !< Fanger's PMV corresponding to oclo
360	REAL(wp), INTENT ( IN ) :: pmv_u !< Fanger's PMV corresponding to uclo
361
362	! Output variables of argument list:
363	REAL(wp), INTENT ( OUT ) :: pmva !< 0 (set to zero, because clo is evaluated for comfort)
364	REAL(wp), INTENT ( OUT ) :: top !< Operative temperature (°C) at found root of Fanger's PMV
365	REAL(wp), INTENT ( OUT ) :: clo_res !< Resulting clothing insulation value (clo)
366	INTEGER(iwp), INTENT ( OUT ) :: nerr !< Error status / quality flag
367	! nerr >= 0, o.k., and nerr is the number of iterations for
368	! convergence
369	! nerr = -1: error = malfunction of Ridder's convergence method
370	! nerr = -2: error = maximum iterations (max_iteration) exceeded
371	! nerr = -3: error = root not bracketed between uclo and oclo
372
373	!-- Type of program variables
374	INTEGER(iwp), PARAMETER :: max_iteration = 15_iwp
375	REAL(wp), PARAMETER :: guess_0 = -1.11e30_wp
376	REAL(wp) :: x_ridder
377	REAL(wp) :: clo_u
378	REAL(wp) :: clo_o
379	REAL(wp) :: x_unten
380	REAL(wp) :: x_oben
381	REAL(wp) :: x_mittel
382	REAL(wp) :: x_neu
383	REAL(wp) :: y_unten
384	REAL(wp) :: y_oben
385	REAL(wp) :: y_mittel
386	REAL(wp) :: y_neu
387	REAL(wp) :: s
388	INTEGER(iwp) :: j
389
390	!-- Initialise
391	nerr = 0_iwp
392
393	!-- Set pmva = 0 (comfort): Root of PMV depending on clothing insulation
394	pmva = 0._wp
395	clo_u = uclo
396	y_unten = pmv_u
397	clo_o = oclo
398	y_oben = pmv_o
399	IF ( ( y_unten > 0._wp .AND. y_oben < 0._wp ) .OR. &
400	( y_unten < 0._wp .AND. y_oben > 0._wp ) ) THEN
401	x_unten = clo_u
402	x_oben = clo_o
403	x_ridder = guess_0
404
405	DO j = 1_iwp, max_iteration
406	x_mittel = 0.5_wp * ( x_unten + x_oben )
407	CALL fanger ( tt2m, tmrt, el2m, vau1m, pb, x_mittel, actlev, eta, &
408	y_mittel, top )
409	s = SQRT ( y_mittel*2 - y_unten y_oben )
410	IF ( s == 0._wp ) THEN
411	clo_res = x_mittel
412	nerr = j
413	RETURN
414	ENDIF
415	x_neu = x_mittel + ( x_mittel - x_unten ) * &
416	( SIGN ( 1._wp, y_unten - y_oben ) * y_mittel / s )
417	IF ( ABS ( x_neu - x_ridder ) <= eps ) THEN
418	clo_res = x_ridder
419	nerr = j
420	RETURN
421	ENDIF
422	x_ridder = x_neu
423	CALL fanger ( tt2m, tmrt, el2m, vau1m, pb, x_ridder, actlev, eta, &
424	y_neu, top )
425	IF ( y_neu == 0._wp ) THEN
426	clo_res = x_ridder
427	nerr = j
428	RETURN
429	ENDIF
430	IF ( SIGN ( y_mittel, y_neu ) /= y_mittel ) THEN
431	x_unten = x_mittel
432	y_unten = y_mittel
433	x_oben = x_ridder
434	y_oben = y_neu
435	ELSE IF ( SIGN ( y_unten, y_neu ) /= y_unten ) THEN
436	x_oben = x_ridder
437	y_oben = y_neu
438	ELSE IF ( SIGN ( y_oben, y_neu ) /= y_oben ) THEN
439	x_unten = x_ridder
440	y_unten = y_neu
441	ELSE
442	!-- Never get here in x_ridder: singularity in y
443	nerr = -1_iwp
444	clo_res = x_ridder
445	RETURN
446	ENDIF
447	IF ( ABS ( x_oben - x_unten ) <= eps ) THEN
448	clo_res = x_ridder
449	nerr = j
450	RETURN
451	ENDIF
452	ENDDO
453	!-- x_ridder exceed maximum iterations
454	nerr = -2_iwp
455	clo_res = y_neu
456	RETURN
457	ELSE IF ( y_unten == 0. ) THEN
458	x_ridder = clo_u
459	ELSE IF ( y_oben == 0. ) THEN
460	x_ridder = clo_o
461	ELSE
462	!-- x_ridder not bracketed by u_clo and o_clo
463	nerr = -3_iwp
464	clo_res = x_ridder
465	RETURN
466	ENDIF
467
468	END SUBROUTINE iso_ridder
469
470	!------------------------------------------------------------------------------!
471	! Description:
472	! ------------
473	!> Regression relations between perceived temperature (gt) and (adjusted)
474	!> PMV (21.11.1996, files F3PMVPGT.TXT und F3CLOGT.TXT). Three cases:
475	!>
476	!> - PMV < 0: gt = 5.805 + 12.6784*pmv
477	!> - PMV = 0 (gt depends on clothing insulation, FUNCTION iso_ridder):
478	!> gt = 21.258 - 9.558*clo
479	!> - PMV > 0: 16.826 + 6.163*pmv
480	!>
481	!> The regression presumes the Klima-Michel settings for reference
482	!> individual and reference environment.
483	!------------------------------------------------------------------------------!
484	SUBROUTINE pt_regression( pmv, clo, pt )
485
486	IMPLICIT NONE
487
488	REAL(wp), INTENT ( IN ) :: pmv !< Fangers predicted mean vote (dimensionless)
489	REAL(wp), INTENT ( IN ) :: clo !< clothing insulation index (clo)
490	REAL(wp), INTENT ( OUT ) :: pt !< pt (°C) corresponding to given PMV / clo
491
492	IF ( pmv <= -0.11_wp ) THEN
493	pt = 5.805_wp + 12.6784_wp * pmv
494	ELSE
495	IF ( pmv >= + 0.01_wp ) THEN
496	pt = 16.826_wp + 6.163_wp * pmv
497	ELSE
498	pt = 21.258_wp - 9.558_wp * clo
499	ENDIF
500	ENDIF
501
502	END SUBROUTINE pt_regression
503
504	!------------------------------------------------------------------------------!
505	! Description:
506	! ------------
507	!> FANGER.F90
508	!>
509	!> SI-VERSION: ACTLEV W m-2, DAMPFDRUCK hPa
510	!> Berechnet das aktuelle Predicted Mean Vote nach Fanger
511	!>
512	!> The case of free convection (vau < 0.1 m/s) is dealt with vau = 0.1 m/s
513	!------------------------------------------------------------------------------!
514	SUBROUTINE fanger( tt, tmrt, pa, in_vau, pb, in_clo, actlev, eta, pmva, top )
515
516	IMPLICIT NONE
517
518	!-- Input variables of argument list:
519	REAL(wp), INTENT ( IN ) :: tt !< Ambient air temperature (°C)
520	REAL(wp), INTENT ( IN ) :: tmrt !< Mean radiant temperature (°C)
521	REAL(wp), INTENT ( IN ) :: pa !< Water vapour pressure (hPa)
522	REAL(wp), INTENT ( IN ) :: pb !< Barometric pressure (hPa) at site
523	REAL(wp), INTENT ( IN ) :: in_vau !< Wind speed (m/s) 1 m above ground
524	REAL(wp), INTENT ( IN ) :: in_clo !< Clothing insulation (clo)
525	REAL(wp), INTENT ( IN ) :: actlev !< Individuals activity level per unit surface area (W/m2)
526	REAL(wp), INTENT ( IN ) :: eta !< Individuals mechanical work efficiency (dimensionless)
527
528	!-- Output variables of argument list:
529	REAL(wp), INTENT ( OUT ) :: pmva !< Actual Predicted Mean Vote (dimensionless) according
530	! to Fanger corresponding to meteorological (tt,tmrt,pa,vau,pb)
531	! and individual variables (clo, actlev, eta)
532	REAL(wp), INTENT ( OUT ) :: top !< operative temperature (°C)
533
534	!-- Internal variables
535	REAL(wp), PARAMETER :: cels_offs = 273.15_wp !< Kelvin Celsius Offset (K)
536	REAL(wp) :: f_cl
537	REAL(wp) :: heat_convection
538	REAL(wp) :: activity
539	REAL(wp) :: t_skin_aver
540	REAL(wp) :: bc
541	REAL(wp) :: cc
542	REAL(wp) :: dc
543	REAL(wp) :: ec
544	REAL(wp) :: gc
545	REAL(wp) :: t_clothing
546	REAL(wp) :: hr
547	REAL(wp) :: clo
548	REAL(wp) :: vau
549	REAL(wp) :: z1
550	REAL(wp) :: z2
551	REAL(wp) :: z3
552	REAL(wp) :: z4
553	REAL(wp) :: z5
554	REAL(wp) :: z6
555	INTEGER(iwp) :: i
556
557	!-- Clo must be > 0. to avoid div. by 0!
558	clo = in_clo
559	IF ( clo <= 0._wp ) clo = .001_wp
560
561	!-- f_cl = Increase in surface due to clothing
562	f_cl = 1._wp + .15_wp * clo
563
564	!-- Case of free convection (vau < 0.1 m/s ) not considered
565	vau = in_vau
566	IF ( vau < .1_wp ) THEN
567	vau = .1_wp
568	ENDIF
569
570	!-- Heat_convection = forced convection
571	heat_convection = 12.1_wp * SQRT ( vau * pb / 1013.25_wp )
572
573	!-- Activity = inner heat produktion per standardized surface
574	activity = actlev * ( 1._wp - eta )
575
576	!-- T_skin_aver = average skin temperature
577	t_skin_aver = 35.7_wp - .0275_wp * activity
578
579	!-- Calculation of constants for evaluation below
580	bc = .155_wp * clo * 3.96_wp * 10._wp*( -8 ) f_cl
581	cc = f_cl * heat_convection
582	ec = .155_wp * clo
583	dc = ( 1._wp + ec * cc ) / bc
584	gc = ( t_skin_aver + bc * ( tmrt + cels_offs )*4 + ec cc * tt ) / bc
585
586	!-- Calculation of clothing surface temperature (t_clothing) based on
587	! Newton-approximation with air temperature as initial guess
588	t_clothing = tt
589	DO I = 1, 3
590	t_clothing = t_clothing - ( ( t_clothing + cels_offs )**4 + t_clothing &
591	* dc - gc ) / ( 4._wp * ( t_clothing + cels_offs )**3 + dc )
592	ENDDO
593
594	!-- Empiric factor for the adaption of the heat ballance equation
595	! to the psycho-physical scale (Equ. 40 in FANGER)
596	z1 = ( .303_wp * EXP ( -.036_wp * actlev ) + .0275_wp )
597
598	!-- Water vapour diffution through the skin
599	z2 = .31_wp * ( 57.3_wp - .07_wp * activity-pa )
600
601	!-- Sweat evaporation from the skin surface
602	z3 = .42_wp * ( activity - 58._wp )
603
604	!-- Loss of latent heat through respiration
605	z4 = .0017_wp * actlev * ( 58.7_wp - pa ) + .0014_wp * actlev * &
606	( 34._wp - tt )
607
608	!-- Loss of radiational heat
609	z5 = 3.96e-8_wp * f_cl * ( ( t_clothing + cels_offs )**4 - ( tmrt + &
610	cels_offs )**4 )
611	IF ( ABS ( t_clothing - tmrt ) > 0._wp ) THEN
612	hr = z5 / f_cl / ( t_clothing - tmrt )
613	ELSE
614	hr = 0._wp
615	ENDIF
616
617	!-- Heat loss through forced convection cc*(t_clothing-TT)
618	z6 = cc * ( t_clothing - tt )
619
620	!-- Predicted Mean Vote
621	pmva = z1 * ( activity - z2 - z3 - z4 - z5 - z6 )
622
623	!-- Operative temperatur
624	top = ( hr * tmrt + heat_convection * tt ) / ( hr + heat_convection )
625
626	END SUBROUTINE fanger
627
628	!------------------------------------------------------------------------------!
629	! Description:
630	! ------------
631	!> For pmva > 0 and clo =0.5 the increment (deltapmv) is calculated
632	!> that converts pmva into Gagge's et al. (1986) PMV*.
633	!------------------------------------------------------------------------------!
634	REAL(wp) FUNCTION deltapmv( pmva, tt2m, el2m, svp_tt, tmrt, vau1m, nerr )
635
636	IMPLICIT NONE
637
638	!-- Input variables of argument list:
639	REAL(wp), INTENT ( IN ) :: pmva !< Actual Predicted Mean Vote (PMV) according to Fanger
640	REAL(wp), INTENT ( IN ) :: tt2m !< Ambient temperature (°C) at screen level
641	REAL(wp), INTENT ( IN ) :: el2m !< Water vapour pressure (hPa) at screen level
642	REAL(wp), INTENT ( IN ) :: svp_tt !< Saturation water vapour pressure (hPa) at tt2m
643	REAL(wp), INTENT ( IN ) :: tmrt !< Mean radiant temperature (°C) at screen level
644	REAL(wp), INTENT ( IN ) :: vau1m !< Wind speed (m/s) 1 m above ground
645
646	!-- Output variables of argument list:
647	INTEGER(iwp), INTENT ( OUT ) :: nerr !< Error status / quality flag
648	! 0 = o.k.
649	! -2 = pmva outside valid regression range
650	! -3 = rel. humidity set to 5 % or 95 %, respectively
651	! -4 = deltapmv set to avoid pmvs < 0
652
653	!-- Internal variable types:
654	REAL(wp) :: pmv
655	REAL(wp) :: pa_p50
656	REAL(wp) :: pa
657	REAL(wp) :: apa
658	REAL(wp) :: dapa
659	REAL(wp) :: sqvel
660	REAL(wp) :: ta
661	REAL(wp) :: dtmrt
662	REAL(wp) :: p10
663	REAL(wp) :: p95
664	REAL(wp) :: gew
665	REAL(wp) :: gew2
666	REAL(wp) :: dpmv_1
667	REAL(wp) :: dpmv_2
668	REAL(wp) :: pmvs
669	REAL(wp) :: bpmv(0:7)
670	REAL(wp) :: bpa_p50(0:7)
671	REAL(wp) :: bpa(0:7)
672	REAL(wp) :: bapa(0:7)
673	REAL(wp) :: bdapa(0:7)
674	REAL(wp) :: bsqvel(0:7)
675	REAL(wp) :: bta(0:7)
676	REAL(wp) :: bdtmrt(0:7)
677	REAL(wp) :: aconst(0:7)
678	INTEGER(iwp) :: nreg
679
680	DATA bpmv / &
681	-0.0556602_wp, -0.1528680_wp, -0.2336104_wp, -0.2789387_wp, -0.3551048_wp,&
682	-0.4304076_wp, -0.4884961_wp, -0.4897495_wp /
683	DATA bpa_p50 / &
684	-0.1607154_wp, -0.4177296_wp, -0.4120541_wp, -0.0886564_wp, +0.4285938_wp,&
685	+0.6281256_wp, +0.5067361_wp, +0.3965169_wp /
686	DATA bpa / &
687	+0.0580284_wp, +0.0836264_wp, +0.1009919_wp, +0.1020777_wp, +0.0898681_wp,&
688	+0.0839116_wp, +0.0853258_wp, +0.0866589_wp /
689	DATA bapa / &
690	-1.7838788_wp, -2.9306231_wp, -1.6350334_wp, +0.6211547_wp, +3.3918083_wp,&
691	+5.5521025_wp, +8.4897418_wp, +16.6265851_wp /
692	DATA bdapa / &
693	+1.6752720_wp, +2.7379504_wp, +1.2940526_wp, -1.0985759_wp, -3.9054732_wp,&
694	-6.0403012_wp, -8.9437119_wp, -17.0671201_wp /
695	DATA bsqvel / &
696	-0.0315598_wp, -0.0286272_wp, -0.0009228_wp, +0.0483344_wp, +0.0992366_wp,&
697	+0.1491379_wp, +0.1951452_wp, +0.2133949_wp /
698	DATA bta / &
699	+0.0953986_wp, +0.1524760_wp, +0.0564241_wp, -0.0893253_wp, -0.2398868_wp,&
700	-0.3515237_wp, -0.5095144_wp, -0.9469258_wp /
701	DATA bdtmrt / &
702	-0.0004672_wp, -0.0000514_wp, -0.0018037_wp, -0.0049440_wp, -0.0069036_wp,&
703	-0.0075844_wp, -0.0079602_wp, -0.0089439_wp /
704	DATA aconst / &
705	+1.8686215_wp, +3.4260713_wp, +2.0116185_wp, -0.7777552_wp, -4.6715853_wp,&
706	-7.7314281_wp, -11.7602578_wp, -23.5934198_wp /
707
708	!-- Test for compliance with regression range
709	IF ( pmva < -1.0_wp .OR. pmva > 7.0_wp ) THEN
710	nerr = -2_iwp
711	ELSE
712	nerr = 0_iwp
713	ENDIF
714
715	!-- Initialise classic PMV
716	pmv = pmva
717
718	!-- Water vapour pressure of air
719	p10 = 0.05_wp * svp_tt
720	p95 = 1.00_wp * svp_tt
721	IF ( el2m >= p10 .AND. el2m <= p95 ) THEN
722	pa = el2m
723	ELSE
724	nerr = -3_iwp
725	IF ( el2m < p10 ) THEN
726	!-- Due to conditions of regressíon: r.H. >= 5 %
727	pa = p10
728	ELSE
729	!-- Due to conditions of regressíon: r.H. <= 95 %
730	pa = p95
731	ENDIF
732	ENDIF
733	IF ( pa > 0._wp ) THEN
734	!-- Natural logarithm of pa
735	apa = DLOG ( pa )
736	ELSE
737	apa = -5._wp
738	ENDIF
739
740	!-- Ratio actual water vapour pressure to that of a r.H. of 50 %
741	pa_p50 = 0.5_wp * svp_tt
742	IF ( pa_p50 > 0._wp .AND. pa > 0._wp ) THEN
743	dapa = apa - DLOG ( pa_p50 )
744	pa_p50 = pa / pa_p50
745	ELSE
746	dapa = -5._wp
747	pa_p50 = 0._wp
748	ENDIF
749	!-- Square root of wind velocity
750	IF ( vau1m >= 0._wp ) THEN
751	sqvel = SQRT ( vau1m )
752	ELSE
753	sqvel = 0._wp
754	ENDIF
755	!-- Air temperature
756	ta = tt2m
757	!-- Difference mean radiation to air temperature
758	dtmrt = tmrt - ta
759
760	!-- Select the valid regression coefficients
761	nreg = INT ( pmv )
762	IF ( nreg < 0_iwp ) THEN
763	!-- value of the FUNCTION in the case pmv <= -1
764	deltapmv = 0._wp
765	RETURN
766	ENDIF
767	gew = DMOD ( pmv, 1._wp )
768	IF ( gew < 0._wp ) gew = 0._wp
769	IF ( nreg > 5_iwp ) THEN
770	! nreg=6
771	nreg = 5_iwp
772	gew = pmv - 5._wp
773	gew2 = pmv - 6._wp
774	IF ( gew2 > 0_iwp ) THEN
775	gew = ( gew - gew2 ) / gew
776	ENDIF
777	ENDIF
778
779	!-- Regression valid for 0. <= pmv <= 6.
780	dpmv_1 = &
781	+ bpa ( nreg ) * pa &
782	+ bpmv ( nreg ) * pmv &
783	+ bapa ( nreg ) * apa &
784	+ bta ( nreg ) * ta &
785	+ bdtmrt ( nreg ) * dtmrt &
786	+ bdapa ( nreg ) * dapa &
787	+ bsqvel ( nreg ) * sqvel &
788	+ bpa_p50 ( nreg ) * pa_p50 &
789	+ aconst ( nreg )
790
791	dpmv_2 = 0._wp
792	IF ( nreg < 6_iwp ) THEN
793	dpmv_2 = &
794	+ bpa ( nreg + 1_iwp ) * pa &
795	+ bpmv ( nreg + 1_iwp ) * pmv &
796	+ bapa ( nreg + 1_iwp ) * apa &
797	+ bta ( nreg + 1_iwp ) * ta &
798	+ bdtmrt ( nreg + 1_iwp ) * dtmrt &
799	+ bdapa ( nreg + 1_iwp ) * dapa &
800	+ bsqvel ( nreg + 1_iwp ) * sqvel &
801	+ bpa_p50 ( nreg + 1_iwp ) * pa_p50 &
802	+ aconst ( nreg + 1_iwp )
803	ENDIF
804
805	!-- Calculate pmv modification
806	deltapmv = ( 1._wp - gew ) * dpmv_1 + gew * dpmv_2
807	pmvs = pmva + deltapmv
808	IF ( ( pmvs ) < 0._wp ) THEN
809	!-- Prevent negative pmv* due to problems with clothing insulation
810	nerr = -4_iwp
811	IF ( pmvs > -0.11_wp ) THEN
812	!-- Threshold from FUNCTION pt_regression for winter clothing insulation
813	deltapmv = deltapmv + 0.11_wp
814	ELSE
815	!-- Set pmvs to "0" for compliance with summer clothing insulation
816	deltapmv = -1._wp * pmva
817	ENDIF
818	ENDIF
819
820	END FUNCTION deltapmv
821
822	!------------------------------------------------------------------------------!
823	! Description:
824	! ------------
825	!> The subroutine "calc_sultr" returns a threshold value to perceived
826	!> temperature allowing to decide whether the actual perceived temperature
827	!> is linked to perecption of sultriness. The threshold values depends
828	!> on the Fanger's classical PMV, expressed here as perceived temperature
829	!> gtc. It is derived from all synoptic observations 1966-1995 of the sites
830	!> 10170 Rostock-Warnemuende and 10803 Freiburg showing heat load. The
831	!> threshold value is valid for subjects acclimatised to Central European
832	!> climate conditions. It includes all effective influences as air
833	!> temperature, relative humidity, mean radiant temperature, and wind
834	!> velocity:
835	!> - defined only under warm conditions: gtc based on 0.5 (clo) and
836	!> gtc > 16.826 (°C)
837	!> - undefined: sultr_res set at +99.
838	!------------------------------------------------------------------------------!
839	SUBROUTINE calc_sultr( gtc, dgtcm, dgtcstd, sultr_res )
840
841	IMPLICIT NONE
842
843	!-- Input of the argument list:
844	REAL(wp), INTENT ( IN ) :: gtc !< Classical perceived temperature: Base is Fanger's PMV
845
846	!-- Additional output variables of argument list:
847	REAL(wp), INTENT ( OUT ) :: dgtcm !< Mean deviation gtc (classical gt) to gt* (rational gt
848	! calculated based on Gagge's rational PMV*)
849	REAL(wp), INTENT ( OUT ) :: dgtcstd !< dgtcm plus its standard deviation times a factor
850	! determining the significance to perceive sultriness
851	REAL(wp), INTENT ( OUT ) :: sultr_res
852
853	!-- Types of coefficients mean deviation: third order polynomial
854	REAL(wp), PARAMETER :: dgtcka = +7.5776086_wp
855	REAL(wp), PARAMETER :: dgtckb = -0.740603_wp
856	REAL(wp), PARAMETER :: dgtckc = +0.0213324_wp
857	REAL(wp), PARAMETER :: dgtckd = -0.00027797237_wp
858
859	!-- Types of coefficients mean deviation plus standard deviation
860	! regression coefficients: third order polynomial
861	REAL(wp), PARAMETER :: dgtcsa = +0.0268918_wp
862	REAL(wp), PARAMETER :: dgtcsb = +0.0465957_wp
863	REAL(wp), PARAMETER :: dgtcsc = -0.00054709752_wp
864	REAL(wp), PARAMETER :: dgtcsd = +0.0000063714823_wp
865
866	!-- Factor to mean standard deviation defining SIGNificance for
867	! sultriness
868	REAL(wp), PARAMETER :: faktor = 1._wp
869
870	!-- Initialise
871	sultr_res = +99._wp
872	dgtcm = 0._wp
873	dgtcstd = 999999._wp
874
875	IF ( gtc < 16.826_wp .OR. gtc > 56._wp ) THEN
876	!-- Unallowed classical PMV/gtc
877	RETURN
878	ENDIF
879
880	!-- Mean deviation dependent on gtc
881	dgtcm = dgtcka + dgtckb * gtc + dgtckc * gtc*2._wp + dgtckd gtc**3._wp
882
883	!-- Mean deviation plus its standard deviation
884	dgtcstd = dgtcsa + dgtcsb * gtc + dgtcsc * gtc*2._wp + dgtcsd gtc**3._wp
885
886	!-- Value of the FUNCTION
887	sultr_res = dgtcm + faktor * dgtcstd
888	IF ( ABS ( sultr_res ) > 99._wp ) sultr_res = +99._wp
889
890	END SUBROUTINE calc_sultr
891
892	!------------------------------------------------------------------------------!
893	! Description:
894	! ------------
895	!> Multiple linear regression to calculate an increment delta_kalt,
896	!> to adjust Fanger's classical PMV (pmva) by Gagge's 2 node model,
897	!> applying Fanger's convective heat transfer coefficient, hcf.
898	!> Wind velocitiy of the reference environment is 0.10 m/s
899	!------------------------------------------------------------------------------!
900	SUBROUTINE dpmv_cold( pmva, tt2m, vau1m, tmrt, nerr, dpmv_cold_res )
901
902	IMPLICIT NONE
903
904	!-- Type of input arguments
905	REAL(wp), INTENT ( IN ) :: pmva !< Fanger's classical predicted mean vote
906	REAL(wp), INTENT ( IN ) :: tt2m !< Air temperature (°C) 2 m above ground
907	REAL(wp), INTENT ( IN ) :: vau1m !< Relative wind velocity 1 m above ground (m/s)
908	REAL(wp), INTENT ( IN ) :: tmrt !< Mean radiant temperature (°C)
909
910	!-- Type of output argument
911	INTEGER(iwp), INTENT ( OUT ) :: nerr !< Error indicator: 0 = o.k., +1 = denominator for intersection = 0
912	REAL(wp), INTENT ( OUT ) :: dpmv_cold_res !< Increment to adjust pmva according to the results of Gagge's
913	! 2 node model depending on the input
914
915	!-- Type of program variables
916	REAL(wp) :: delta_kalt(3)
917	REAL(wp) :: pmv_cross(2)
918	REAL(wp) :: reg_a(3)
919	REAL(wp) :: coeff(3,5)
920	REAL(wp) :: r_nenner
921	REAL(wp) :: pmvc
922	REAL(wp) :: dtmrt
923	REAL(wp) :: SQRT_v1m
924	INTEGER(iwp) :: i
925	INTEGER(iwp) :: j
926	INTEGER(iwp) :: i_bin
927
928	!-- Coefficient of the 3 regression lines
929	! 1:const 2:pmvc 3:tt2m 4:SQRT_v1m 5:dtmrt
930	coeff(1,1:5) = &
931	(/ +0.161_wp, +0.130_wp, -1.125E-03_wp, +1.106E-03_wp, -4.570E-04_wp /)
932	coeff(2,1:5) = &
933	(/ 0.795_wp, 0.713_wp, -8.880E-03_wp, -1.803E-03_wp, -2.816E-03_wp/)
934	coeff(3,1:5) = &
935	(/ +0.05761_wp, +0.458_wp, -1.829E-02_wp, -5.577E-03_wp, -1.970E-03_wp /)
936
937	!-- Initialise
938	nerr = 0_iwp
939	dpmv_cold_res = 0._wp
940	pmvc = pmva
941	dtmrt = tmrt - tt2m
942	SQRT_v1m = vau1m
943	IF ( SQRT_v1m < 0.10_wp ) THEN
944	SQRT_v1m = 0.10_wp
945	ELSE
946	SQRT_v1m = SQRT ( SQRT_v1m )
947	ENDIF
948
949	DO i = 1, 3
950	delta_kalt (i) = 0._wp
951	IF ( i < 3 ) THEN
952	pmv_cross (i) = pmvc
953	ENDIF
954	ENDDO
955
956	DO i = 1, 3
957	!-- Regression constant for given meteorological variables
958	reg_a(i) = coeff(i, 1) + coeff(i, 3) * tt2m + coeff(i, 4) * SQRT_v1m + &
959	coeff(i,5)*dtmrt
960	delta_kalt(i) = reg_a(i) + coeff(i, 2) * pmvc
961	ENDDO
962
963	!-- Intersection points of regression lines in terms of Fanger's PMV
964	DO i = 1, 2
965	r_nenner = coeff (i, 2) - coeff (i + 1, 2)
966	IF ( ABS ( r_nenner ) > 0.00001_wp ) THEN
967	pmv_cross(i) = ( reg_a (i + 1) - reg_a (i) ) / r_nenner
968	ELSE
969	nerr = 1_iwp
970	RETURN
971	ENDIF
972	ENDDO
973
974	i_bin = 3
975	DO i = 1, 2
976	IF ( pmva > pmv_cross (i) ) THEN
977	i_bin = i
978	EXIT
979	ENDIF
980	ENDDO
981	!-- Adjust to operative temperature scaled according
982	! to classical PMV (Fanger)
983	dpmv_cold_res = delta_kalt(i_bin) - dpmv_adj(pmva)
984
985	END SUBROUTINE dpmv_cold
986
987	!------------------------------------------------------------------------------!
988	! Description:
989	! ------------
990	!> Calculates the summand dpmv_adj adjusting to the operative temperature
991	!> scaled according to classical PMV (Fanger)
992	!> Reference environment: v_1m = 0.10 m/s, dTMRT = 0 K, r.h. = 50 %
993	!------------------------------------------------------------------------------!
994	REAL(wp) FUNCTION dpmv_adj( pmva )
995
996	IMPLICIT NONE
997
998	REAL(wp), INTENT ( IN ) :: pmva
999	INTEGER(iwp), PARAMETER :: n_bin = 3
1000	INTEGER(iwp), PARAMETER :: n_ca = 0
1001	INTEGER(iwp), PARAMETER :: n_ce = 3
1002	REAL(wp), dimension (n_bin, n_ca:n_ce) :: coef
1003
1004	REAL(wp) :: pmv
1005	INTEGER(iwp) :: i, i_bin
1006
1007	! range_1 range_2 range_3
1008	DATA (coef(i, 0), i = 1, n_bin) /+0.0941540_wp, -0.1506620_wp, -0.0871439_wp/
1009	DATA (coef(i, 1), i = 1, n_bin) /+0.0783162_wp, -1.0612651_wp, +0.1695040_wp/
1010	DATA (coef(i, 2), i = 1, n_bin) /+0.1350144_wp, -1.0049144_wp, -0.0167627_wp/
1011	DATA (coef(i, 3), i = 1, n_bin) /+0.1104037_wp, -0.2005277_wp, -0.0003230_wp/
1012
1013	IF ( pmva <= -2.1226_wp ) THEN
1014	i_bin = 3_iwp
1015	ELSE IF ( pmva <= -1.28_wp ) THEN
1016	i_bin = 2_iwp
1017	ELSE
1018	i_bin = 1_iwp
1019	ENDIF
1020
1021	dpmv_adj = coef( i_bin, n_ca )
1022	pmv = 1._wp
1023
1024	DO i = n_ca + 1, n_ce
1025	pmv = pmv * pmva
1026	dpmv_adj = dpmv_adj + coef(i_bin, i) * pmv
1027	ENDDO
1028	RETURN
1029	END FUNCTION dpmv_adj
1030
1031	!------------------------------------------------------------------------------!
1032	! Description:
1033	! ------------
1034	!> Based on perceived temperature (gt) as input, ireq_neutral determines
1035	!> the required clothing insulation (clo) for thermally neutral conditions
1036	!> (neither body cooling nor body heating). It is related to the Klima-
1037	!> Michel activity level (134.682 W/m2). IREQ_neutral is only defined
1038	!> for gt < 10 (°C)
1039	!------------------------------------------------------------------------------!
1040	REAL(wp) FUNCTION ireq_neutral( gt, ireq_minimal, nerr )
1041
1042	IMPLICIT NONE
1043
1044	!-- Type declaration of arguments
1045	REAL(wp), INTENT ( IN ) :: gt
1046	REAL(wp), INTENT ( OUT ) :: ireq_minimal
1047	INTEGER(iwp), INTENT ( OUT ) :: nerr
1048
1049	!-- Type declaration for internal varables
1050	REAL(wp) :: top02
1051
1052	!-- Initialise
1053	nerr = 0_iwp
1054
1055	!-- Convert perceived temperature from basis 0.1 m/s to basis 0.2 m/s
1056	top02 = 1.8788_wp + 0.9296_wp * gt
1057
1058	!-- IREQ neutral conditions (thermal comfort)
1059	ireq_neutral = 1.62_wp - 0.0564_wp * top02
1060
1061	!-- Regression only defined for gt <= 10 (°C)
1062	IF ( ireq_neutral < 0.5_wp ) THEN
1063	IF ( ireq_neutral < 0.48_wp ) THEN
1064	nerr = 1_iwp
1065	ENDIF
1066	ireq_neutral = 0.5_wp
1067	ENDIF
1068
1069	!-- Minimal required clothing insulation: maximal acceptable body cooling
1070	ireq_minimal = 1.26_wp - 0.0588_wp * top02
1071	IF ( nerr > 0_iwp ) THEN
1072	ireq_minimal = ireq_neutral
1073	ENDIF
1074
1075	RETURN
1076	END FUNCTION ireq_neutral
1077
1078	END MODULE biometeorology_pt_mod

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |