!> @file biometeorology_utci_mod.f90 !------------------------------------------------------------------------------! ! This file is part of PALM-4U. ! ! PALM-4U is free software: you can redistribute it and/or modify it under the ! terms of the GNU General Public License as published by the Free Software ! Foundation, either version 3 of the License, or (at your option) any later ! version. ! ! PALM-4U is distributed in the hope that it will be useful, but WITHOUT ANY ! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR ! A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! ! You should have received a copy of the GNU General Public License along with ! PALM. If not, see . ! ! Copyright 2018, Deutscher Wetterdienst (DWD) / ! German Meteorological Service (DWD) ! ! UTCI regression equation after ! Bröde P, Fiala D, Blazejczyk K, Holmér I, Jendritzky G, Kampmann B, Tinz B, ! Havenith G (2012) Deriving the operational procedure for the Universal Thermal ! Climate Index (UTCI). International Journal of Biometeorology 56 (3):481-494. ! doi:10.1007/s00484-011-0454-1 ! ! original regression source available at ! www.utci.org !------------------------------------------------------------------------------! MODULE biometeorology_utci_mod !-- Load required variables from existing modules USE kinds IMPLICIT NONE PRIVATE !-- Add INTERFACES that must be available to other modules (alphabetical order) PUBLIC calculate_utci_static INTERFACE calculate_utci_static MODULE PROCEDURE calculate_utci_static END INTERFACE calculate_utci_static CONTAINS !------------------------------------------------------------------------------! ! Description: ! ------------ !> SUBROUTINE for calculating UTCI Temperature (UTCI) !> computed by a 6th order approximation !------------------------------------------------------------------------------! SUBROUTINE calculate_utci_static( ta_in, ehpa, v_hag, tmrt, hag, utci ) IMPLICIT NONE !-- Type of input of the argument list REAL(WP), INTENT ( IN ) :: ta_in !< Local air temperature (°C) REAL(WP), INTENT ( IN ) :: ehpa !< Loacl vapour pressure (hPa) REAL(WP), INTENT ( IN ) :: v_hag !< Incident wind speed (m/s) REAL(WP), INTENT ( IN ) :: tmrt !< Local mean radiant temperature (°C) REAL(WP), INTENT ( IN ) :: hag !< Height of wind speed input (m) !-- Type of output of the argument list REAL(wp), INTENT ( OUT ) :: utci !< Universal Thermal Climate Index (°C) !-- Make sure precission is sufficient for regression equation DOUBLE PRECISION :: ta DOUBLE PRECISION :: pa DOUBLE PRECISION :: d_tmrt DOUBLE PRECISION :: va DOUBLE PRECISION :: utci_d DOUBLE PRECISION :: offset !-- Initialize offset = 0.d0 ta = DBLE( ta_in ) d_tmrt = DBLE( tmrt - ta_in ) !-- Use vapour pressure in kpa pa = DBLE( ehpa / 10.0_wp ) !-- Wind altitude correction from hag to 10m after Broede et al. (2012), eq.3 ! z(0) is set to 0.01 according to UTCI definition va = DBLE( v_hag * log ( 10.0_wp / 0.01_wp ) / log ( hag / 0.01_wp ) ) !-- Check if input values in range after Broede et al. (2012) IF ( ( d_tmrt > 70.d0 ) .OR. ( d_tmrt < -30.d0 ) .OR. & ( ehpa .GE. 50._wp ) ) THEN utci = -999.0_wp RETURN ENDIF !-- Apply eq. 2 in Broede et al. (2012) for ta out of bounds IF ( ta > 50.d0 ) THEN offset = ta - 50.d0 ta = 50.d0 ENDIF IF ( ta < -50.d0 ) THEN offset = ta + 50.d0 ta = -50.d0 ENDIF !-- For routine application. For wind speeds and relative ! humidity values below 0.5 m/s or 5%, respectively, the ! user is advised to use the lower bounds for the calculations. IF ( va < 0.5d0 ) va = 0.5d0 IF ( va > 17.0d0 ) va = 17.0d0 !-- Calculate 6th order polynomial as approximation utci_d = ta + & ( 6.07562052D-01 ) + & ( -2.27712343D-02 ) * ta + & ( 8.06470249D-04 ) * ta * ta + & ( -1.54271372D-04 ) * ta * ta * ta + & ( -3.24651735D-06 ) * ta * ta * ta * ta + & ( 7.32602852D-08 ) * ta * ta * ta * ta * ta + & ( 1.35959073D-09 ) * ta * ta * ta * ta * ta * ta + & ( -2.25836520D+00 ) * va + & ( 8.80326035D-02 ) * ta * va + & ( 2.16844454D-03 ) * ta * ta * va + & ( -1.53347087D-05 ) * ta * ta * ta * va + & ( -5.72983704D-07 ) * ta * ta * ta * ta * va + & ( -2.55090145D-09 ) * ta * ta * ta * ta * ta * va + & ( -7.51269505D-01 ) * va * va + & ( -4.08350271D-03 ) * ta * va * va + & ( -5.21670675D-05 ) * ta * ta * va * va + & ( 1.94544667D-06 ) * ta * ta * ta * va * va + & ( 1.14099531D-08 ) * ta * ta * ta * ta * va * va + & ( 1.58137256D-01 ) * va * va * va + & ( -6.57263143D-05 ) * ta * va * va * va + & ( 2.22697524D-07 ) * ta * ta * va * va * va + & ( -4.16117031D-08 ) * ta * ta * ta * va * va * va + & ( -1.27762753D-02 ) * va * va * va * va + & ( 9.66891875D-06 ) * ta * va * va * va * va + & ( 2.52785852D-09 ) * ta * ta * va * va * va * va + & ( 4.56306672D-04 ) * va * va * va * va * va + & ( -1.74202546D-07 ) * ta * va * va * va * va * va + & ( -5.91491269D-06 ) * va * va * va * va * va * va + & ( 3.98374029D-01 ) * d_tmrt + & ( 1.83945314D-04 ) * ta * d_tmrt + & ( -1.73754510D-04 ) * ta * ta * d_tmrt + & ( -7.60781159D-07 ) * ta * ta * ta * d_tmrt + & ( 3.77830287D-08 ) * ta * ta * ta * ta * d_tmrt + & ( 5.43079673D-10 ) * ta * ta * ta * ta * ta * d_tmrt + & ( -2.00518269D-02 ) * va * d_tmrt + & ( 8.92859837D-04 ) * ta * va * d_tmrt + & ( 3.45433048D-06 ) * ta * ta * va * d_tmrt + & ( -3.77925774D-07 ) * ta * ta * ta * va * d_tmrt + & ( -1.69699377D-09 ) * ta * ta * ta * ta * va * d_tmrt + & ( 1.69992415D-04 ) * va * va * d_tmrt + & ( -4.99204314D-05 ) * ta * va * va * d_tmrt + & ( 2.47417178D-07 ) * ta * ta * va * va * d_tmrt + & ( 1.07596466D-08 ) * ta * ta * ta * va * va * d_tmrt + & ( 8.49242932D-05 ) * va * va * va * d_tmrt + & ( 1.35191328D-06 ) * ta * va * va * va * d_tmrt + & ( -6.21531254D-09 ) * ta * ta * va * va * va * d_tmrt + & ( -4.99410301D-06 ) * va * va * va * va * d_tmrt + & ( -1.89489258D-08 ) * ta * va * va * va * va * d_tmrt + & ( 8.15300114D-08 ) * va * va * va * va * va * d_tmrt + & ( 7.55043090D-04 ) * d_tmrt * d_tmrt + & ( -5.65095215D-05 ) * ta * d_tmrt * d_tmrt + & ( -4.52166564D-07 ) * ta * ta * d_tmrt * d_tmrt + & ( 2.46688878D-08 ) * ta * ta * ta * d_tmrt * d_tmrt + & ( 2.42674348D-10 ) * ta * ta * ta * ta * d_tmrt * d_tmrt + & ( 1.54547250D-04 ) * va * d_tmrt * d_tmrt + & ( 5.24110970D-06 ) * ta * va * d_tmrt * d_tmrt + & ( -8.75874982D-08 ) * ta * ta * va * d_tmrt * d_tmrt + & ( -1.50743064D-09 ) * ta * ta * ta * va * d_tmrt * d_tmrt + & ( -1.56236307D-05 ) * va * va * d_tmrt * d_tmrt + & ( -1.33895614D-07 ) * ta * va * va * d_tmrt * d_tmrt + & ( 2.49709824D-09 ) * ta * ta * va * va * d_tmrt * d_tmrt + & ( 6.51711721D-07 ) * va * va * va * d_tmrt * d_tmrt + & ( 1.94960053D-09 ) * ta * va * va * va * d_tmrt * d_tmrt + & ( -1.00361113D-08 ) * va * va * va * va * d_tmrt * d_tmrt + & ( -1.21206673D-05 ) * d_tmrt * d_tmrt * d_tmrt + & ( -2.18203660D-07 ) * ta * d_tmrt * d_tmrt * d_tmrt + & ( 7.51269482D-09 ) * ta * ta * d_tmrt * d_tmrt * d_tmrt + & ( 9.79063848D-11 ) * ta * ta * ta * d_tmrt * d_tmrt * d_tmrt + & ( 1.25006734D-06 ) * va * d_tmrt * d_tmrt * d_tmrt + & ( -1.81584736D-09 ) * ta * va * d_tmrt * d_tmrt * d_tmrt + & ( -3.52197671D-10 ) * ta * ta * va * d_tmrt * d_tmrt * d_tmrt + & ( -3.36514630D-08 ) * va * va * d_tmrt * d_tmrt * d_tmrt + & ( 1.35908359D-10 ) * ta * va * va * d_tmrt * d_tmrt * d_tmrt + & ( 4.17032620D-10 ) * va * va * va * d_tmrt * d_tmrt * d_tmrt + & ( -1.30369025D-09 ) * d_tmrt * d_tmrt * d_tmrt * d_tmrt + & ( 4.13908461D-10 ) * ta * d_tmrt * d_tmrt * d_tmrt * d_tmrt + & ( 9.22652254D-12 ) * ta * ta * d_tmrt * d_tmrt * d_tmrt * d_tmrt + & ( -5.08220384D-09 ) * va * d_tmrt * d_tmrt * d_tmrt * d_tmrt + & ( -2.24730961D-11 ) * ta * va * d_tmrt * d_tmrt * d_tmrt * d_tmrt + & ( 1.17139133D-10 ) * va * va * d_tmrt * d_tmrt * d_tmrt * d_tmrt + & ( 6.62154879D-10 ) * d_tmrt * d_tmrt * d_tmrt * d_tmrt * d_tmrt + & ( 4.03863260D-13 ) * ta * d_tmrt * d_tmrt * d_tmrt * d_tmrt * d_tmrt + & ( 1.95087203D-12 ) * va * d_tmrt * d_tmrt * d_tmrt * d_tmrt * d_tmrt + & ( -4.73602469D-12 ) * d_tmrt * d_tmrt * d_tmrt * d_tmrt * d_tmrt * & d_tmrt + & ( 5.12733497D+00 ) * pa + & ( -3.12788561D-01 ) * ta * pa + & ( -1.96701861D-02 ) * ta * ta * pa + & ( 9.99690870D-04 ) * ta * ta * ta * pa + & ( 9.51738512D-06 ) * ta * ta * ta * ta * pa + & ( -4.66426341D-07 ) * ta * ta * ta * ta * ta * pa + & ( 5.48050612D-01 ) * va * pa + & ( -3.30552823D-03 ) * ta * va * pa + & ( -1.64119440D-03 ) * ta * ta * va * pa + & ( -5.16670694D-06 ) * ta * ta * ta * va * pa + & ( 9.52692432D-07 ) * ta * ta * ta * ta * va * pa + & ( -4.29223622D-02 ) * va * va * pa + & ( 5.00845667D-03 ) * ta * va * va * pa + & ( 1.00601257D-06 ) * ta * ta * va * va * pa + & ( -1.81748644D-06 ) * ta * ta * ta * va * va * pa + & ( -1.25813502D-03 ) * va * va * va * pa + & ( -1.79330391D-04 ) * ta * va * va * va * pa + & ( 2.34994441D-06 ) * ta * ta * va * va * va * pa + & ( 1.29735808D-04 ) * va * va * va * va * pa + & ( 1.29064870D-06 ) * ta * va * va * va * va * pa + & ( -2.28558686D-06 ) * va * va * va * va * va * pa + & ( -3.69476348D-02 ) * d_tmrt * pa + & ( 1.62325322D-03 ) * ta * d_tmrt * pa + & ( -3.14279680D-05 ) * ta * ta * d_tmrt * pa + & ( 2.59835559D-06 ) * ta * ta * ta * d_tmrt * pa + & ( -4.77136523D-08 ) * ta * ta * ta * ta * d_tmrt * pa + & ( 8.64203390D-03 ) * va * d_tmrt * pa + & ( -6.87405181D-04 ) * ta * va * d_tmrt * pa + & ( -9.13863872D-06 ) * ta * ta * va * d_tmrt * pa + & ( 5.15916806D-07 ) * ta * ta * ta * va * d_tmrt * pa + & ( -3.59217476D-05 ) * va * va * d_tmrt * pa + & ( 3.28696511D-05 ) * ta * va * va * d_tmrt * pa + & ( -7.10542454D-07 ) * ta * ta * va * va * d_tmrt * pa + & ( -1.24382300D-05 ) * va * va * va * d_tmrt * pa + & ( -7.38584400D-09 ) * ta * va * va * va * d_tmrt * pa + & ( 2.20609296D-07 ) * va * va * va * va * d_tmrt * pa + & ( -7.32469180D-04 ) * d_tmrt * d_tmrt * pa + & ( -1.87381964D-05 ) * ta * d_tmrt * d_tmrt * pa + & ( 4.80925239D-06 ) * ta * ta * d_tmrt * d_tmrt * pa + & ( -8.75492040D-08 ) * ta * ta * ta * d_tmrt * d_tmrt * pa + & ( 2.77862930D-05 ) * va * d_tmrt * d_tmrt * pa + & ( -5.06004592D-06 ) * ta * va * d_tmrt * d_tmrt * pa + & ( 1.14325367D-07 ) * ta * ta * va * d_tmrt * d_tmrt * pa + & ( 2.53016723D-06 ) * va * va * d_tmrt * d_tmrt * pa + & ( -1.72857035D-08 ) * ta * va * va * d_tmrt * d_tmrt * pa + & ( -3.95079398D-08 ) * va * va * va * d_tmrt * d_tmrt * pa + & ( -3.59413173D-07 ) * d_tmrt * d_tmrt * d_tmrt * pa + & ( 7.04388046D-07 ) * ta * d_tmrt * d_tmrt * d_tmrt * pa + & ( -1.89309167D-08 ) * ta * ta * d_tmrt * d_tmrt * d_tmrt * pa + & ( -4.79768731D-07 ) * va * d_tmrt * d_tmrt * d_tmrt * pa + & ( 7.96079978D-09 ) * ta * va * d_tmrt * d_tmrt * d_tmrt * pa + & ( 1.62897058D-09 ) * va * va * d_tmrt * d_tmrt * d_tmrt * pa + & ( 3.94367674D-08 ) * d_tmrt * d_tmrt * d_tmrt * d_tmrt * pa + & ( -1.18566247D-09 ) * ta * d_tmrt * d_tmrt * d_tmrt * d_tmrt * pa + & ( 3.34678041D-10 ) * va * d_tmrt * d_tmrt * d_tmrt * d_tmrt * pa + & ( -1.15606447D-10 ) * d_tmrt * d_tmrt * d_tmrt * d_tmrt * d_tmrt * pa + & ( -2.80626406D+00 ) * pa * pa + & ( 5.48712484D-01 ) * ta * pa * pa + & ( -3.99428410D-03 ) * ta * ta * pa * pa + & ( -9.54009191D-04 ) * ta * ta * ta * pa * pa + & ( 1.93090978D-05 ) * ta * ta * ta * ta * pa * pa + & ( -3.08806365D-01 ) * va * pa * pa + & ( 1.16952364D-02 ) * ta * va * pa * pa + & ( 4.95271903D-04 ) * ta * ta * va * pa * pa + & ( -1.90710882D-05 ) * ta * ta * ta * va * pa * pa + & ( 2.10787756D-03 ) * va * va * pa * pa + & ( -6.98445738D-04 ) * ta * va * va * pa * pa + & ( 2.30109073D-05 ) * ta * ta * va * va * pa * pa + & ( 4.17856590D-04 ) * va * va * va * pa * pa + & ( -1.27043871D-05 ) * ta * va * va * va * pa * pa + & ( -3.04620472D-06 ) * va * va * va * va * pa * pa + & ( 5.14507424D-02 ) * d_tmrt * pa * pa + & ( -4.32510997D-03 ) * ta * d_tmrt * pa * pa + & ( 8.99281156D-05 ) * ta * ta * d_tmrt * pa * pa + & ( -7.14663943D-07 ) * ta * ta * ta * d_tmrt * pa * pa + & ( -2.66016305D-04 ) * va * d_tmrt * pa * pa + & ( 2.63789586D-04 ) * ta * va * d_tmrt * pa * pa + & ( -7.01199003D-06 ) * ta * ta * va * d_tmrt * pa * pa + & ( -1.06823306D-04 ) * va * va * d_tmrt * pa * pa + & ( 3.61341136D-06 ) * ta * va * va * d_tmrt * pa * pa + & ( 2.29748967D-07 ) * va * va * va * d_tmrt * pa * pa + & ( 3.04788893D-04 ) * d_tmrt * d_tmrt * pa * pa + & ( -6.42070836D-05 ) * ta * d_tmrt * d_tmrt * pa * pa + & ( 1.16257971D-06 ) * ta * ta * d_tmrt * d_tmrt * pa * pa + & ( 7.68023384D-06 ) * va * d_tmrt * d_tmrt * pa * pa + & ( -5.47446896D-07 ) * ta * va * d_tmrt * d_tmrt * pa * pa + & ( -3.59937910D-08 ) * va * va * d_tmrt * d_tmrt * pa * pa + & ( -4.36497725D-06 ) * d_tmrt * d_tmrt * d_tmrt * pa * pa + & ( 1.68737969D-07 ) * ta * d_tmrt * d_tmrt * d_tmrt * pa * pa + & ( 2.67489271D-08 ) * va * d_tmrt * d_tmrt * d_tmrt * pa * pa + & ( 3.23926897D-09 ) * d_tmrt * d_tmrt * d_tmrt * d_tmrt * pa * pa + & ( -3.53874123D-02 ) * pa * pa * pa + & ( -2.21201190D-01 ) * ta * pa * pa * pa + & ( 1.55126038D-02 ) * ta * ta * pa * pa * pa + & ( -2.63917279D-04 ) * ta * ta * ta * pa * pa * pa + & ( 4.53433455D-02 ) * va * pa * pa * pa + & ( -4.32943862D-03 ) * ta * va * pa * pa * pa + & ( 1.45389826D-04 ) * ta * ta * va * pa * pa * pa + & ( 2.17508610D-04 ) * va * va * pa * pa * pa + & ( -6.66724702D-05 ) * ta * va * va * pa * pa * pa + & ( 3.33217140D-05 ) * va * va * va * pa * pa * pa + & ( -2.26921615D-03 ) * d_tmrt * pa * pa * pa + & ( 3.80261982D-04 ) * ta * d_tmrt * pa * pa * pa + & ( -5.45314314D-09 ) * ta * ta * d_tmrt * pa * pa * pa + & ( -7.96355448D-04 ) * va * d_tmrt * pa * pa * pa + & ( 2.53458034D-05 ) * ta * va * d_tmrt * pa * pa * pa + & ( -6.31223658D-06 ) * va * va * d_tmrt * pa * pa * pa + & ( 3.02122035D-04 ) * d_tmrt * d_tmrt * pa * pa * pa + & ( -4.77403547D-06 ) * ta * d_tmrt * d_tmrt * pa * pa * pa + & ( 1.73825715D-06 ) * va * d_tmrt * d_tmrt * pa * pa * pa + & ( -4.09087898D-07 ) * d_tmrt * d_tmrt * d_tmrt * pa * pa * pa + & ( 6.14155345D-01 ) * pa * pa * pa * pa + & ( -6.16755931D-02 ) * ta * pa * pa * pa * pa + & ( 1.33374846D-03 ) * ta * ta * pa * pa * pa * pa + & ( 3.55375387D-03 ) * va * pa * pa * pa * pa + & ( -5.13027851D-04 ) * ta * va * pa * pa * pa * pa + & ( 1.02449757D-04 ) * va * va * pa * pa * pa * pa + & ( -1.48526421D-03 ) * d_tmrt * pa * pa * pa * pa + & ( -4.11469183D-05 ) * ta * d_tmrt * pa * pa * pa * pa + & ( -6.80434415D-06 ) * va * d_tmrt * pa * pa * pa * pa + & ( -9.77675906D-06 ) * d_tmrt * d_tmrt * pa * pa * pa * pa + & ( 8.82773108D-02 ) * pa * pa * pa * pa * pa + & ( -3.01859306D-03 ) * ta * pa * pa * pa * pa * pa + & ( 1.04452989D-03 ) * va * pa * pa * pa * pa * pa + & ( 2.47090539D-04 ) * d_tmrt * pa * pa * pa * pa * pa + & ( 1.48348065D-03 ) * pa * pa * pa * pa * pa * pa !-- Cast result to working precision utci = REAL( utci_d + offset, wp ) END SUBROUTINE calculate_utci_static END MODULE biometeorology_utci_mod