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

Last change on this file since 3448 was 3448, checked in by kanani, 3 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.