Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |