SURFEX  V8_0
Surfex V8_0 release
 All Classes Files Functions Variables
utci_approx.F90
Go to the documentation of this file.
1 !SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
2 !SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
3 !SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
4 !SFX_LIC for details. version 1.
5 !~ *************************************************************
6 FUNCTION utci_approx(PTA,PEHPA,PTMRT,PVA) RESULT(PUTCI_APPROX)
7 !~ *************************************************************
8 !~ ****!
9 !!**** *UTCI_APPROX*
10 !!
11 !! PURPOSE
12 !! -------
13 !
14 ! Computes the Universal Thermal and Climate Index Equivalent temperature
15 !
16 !
17 !!** METHOD
18 ! ------
19 ! UTCI method ~ computed by a 6th order approximating polynomial from the 4 Input paramters
20 ! ~ UTCI_approx, Version a 0.002, October 2009
21 ! ~ Copyright (C) 2009 Peter Broede
22 !
23 !! EXTERNAL
24 !! --------
25 !!
26 !! IMPLICIT ARGUMENTS
27 !! ------------------
28 !!
29 !! REFERENCE
30 !! ---------
31 !! www.utci.org
32 !~ DOUBLE PRECISION Function value is the UTCI in degree Celsius
33 !~ computed by a 6th order approximating polynomial from the 4 Input paramters
34 !~
35 !~ Input parameters (all of type DOUBLE PRECISION)
36 !~ - Ta : air temperature, degree Celsius
37 !~ - ehPa : water vapour presure, hPa=hecto Pascal
38 !~ - Tmrt : mean radiant temperature, degree Celsius
39 !~ - va10m : wind speed 10 m above ground level in m)s
40 !~
41 !~ UTCI_approx, Version a 0.002, October 2009
42 !~ Copyright (C) 2009 Peter Broede
43 !!
44 !! AUTHOR
45 !! ------
46 !!
47 !! P. Broede
48 !!
49 !! MODIFICATIONS
50 !! -------------
51 !-------------------------------------------------------------------------------
52 USE yomhook ,ONLY : lhook, dr_hook
53 USE parkind1 ,ONLY : jprb
54 !
55 implicit none
56 !~ type of input of the argument list
57 REAL, DIMENSION(:), INTENT(IN) :: pta
58 REAL, DIMENSION(:), INTENT(IN) :: pehpa
59 REAL, DIMENSION(:), INTENT(IN) :: ptmrt
60 REAL, DIMENSION(:), INTENT(IN) :: pva
61 REAL, DIMENSION(SIZE(PTA)) :: putci_approx
62 !
63 !local variables
64 REAL, DIMENSION(SIZE(PTA)) :: zpa
65 REAL, DIMENSION(SIZE(PTA)) :: zd_tmrt
66 !
67 REAL, DIMENSION(7,7,7,7) :: zz
68 !
69 REAL :: z0, z1, z2, z3, z4, z5, z6, zf, zs
70 zs(z0,z1,z2,z3,z4,z5,z6,zf) = z0 + z1*zf + z2*zf**2 + z3*zf**3 + z4*zf**4 + z5*zf**5 + z6*zf**6
71 REAL, DIMENSION(SIZE(PTA),7) :: zc_ta, zc_va, zc_tmrt, zc_pa
72 INTEGER :: j1, j2, j3, j4, jj
73 !
74 REAL(KIND=JPRB) :: zhook_handle
75 !
76 IF (lhook) CALL dr_hook('UTCI_APPROX',0,zhook_handle)
77 !
78 zz(:,:,:,:)=0.
79 ! va
80 ! Ta**0, Ta**1, Ta**2, Ta**3, Ta**4, Ta**5, Ta**6
81 zz(1,1,1,1:7) = (/ 6.07562052d-01,-2.27712343d-02, 8.06470249d-04,-1.54271372d-04,-3.24651735d-06,&
82  7.32602852d-08, 1.35959073d-09/) ! va**0
83 zz(1,1,2,1:6) = (/-2.25836520d+00, 8.80326035d-02, 2.16844454d-03,-1.53347087d-05,-5.72983704d-07,&
84  -2.55090145d-09/) ! va**1
85 zz(1,1,3,1:5) = (/-7.51269505d-01,-4.08350271d-03,-5.21670675d-05, 1.94544667d-06, 1.14099531d-08/) ! va**2
86 zz(1,1,4,1:4) = (/ 1.58137256d-01,-6.57263143d-05, 2.22697524d-07,-4.16117031d-08/) ! va**3
87 zz(1,1,5,1:3) = (/-1.27762753d-02, 9.66891875d-06, 2.52785852d-09/) ! va**4
88 zz(1,1,6,1:2) = (/ 4.56306672d-04,-1.74202546d-07/) ! va**5
89 zz(1,1,7,1) = -5.91491269d-06 ! va**6
90 ! D_Tmrt / va
91 zz(1,2,1,1:6) = (/ 3.98374029d-01, 1.83945314d-04,-1.73754510d-04,-7.60781159d-07, 3.77830287d-08, 5.43079673d-10/)
92 zz(1,2,2,1:5) = (/-2.00518269d-02, 8.92859837d-04, 3.45433048d-06,-3.77925774d-07,-1.69699377d-09/)
93 zz(1,2,3,1:4) = (/ 1.69992415d-04,-4.99204314d-05, 2.47417178d-07, 1.07596466d-08/)
94 zz(1,2,4,1:3) = (/ 8.49242932d-05, 1.35191328d-06,-6.21531254d-09/)
95 zz(1,2,5,1:2) = (/-4.99410301d-06,-1.89489258d-08/)
96 zz(1,2,6,1) = 8.15300114d-08
97 ! D_Tmrt**2 / va
98 zz(1,3,1,1:5) = (/ 7.55043090d-04,-5.65095215d-05,-4.52166564d-07, 2.46688878d-08, 2.42674348d-10/)
99 zz(1,3,2,1:4) = (/ 1.54547250d-04, 5.24110970d-06,-8.75874982d-08,-1.50743064d-09/)
100 zz(1,3,3,1:3) = (/-1.56236307d-05,-1.33895614d-07, 2.49709824d-09/)
101 zz(1,3,4,1:2) = (/ 6.51711721d-07, 1.94960053d-09/)
102 zz(1,3,5,1) = -1.00361113d-08
103 !D_Tmrt**3 / va
104 zz(1,4,1,1:4) = (/-1.21206673d-05,-2.18203660d-07, 7.51269482d-09, 9.79063848d-11/)
105 zz(1,4,2,1:3) = (/ 1.25006734d-06,-1.81584736d-09,-3.52197671d-10/)
106 zz(1,4,3,1:2) = (/-3.36514630d-08, 1.35908359d-10/)
107 zz(1,4,4,1) = 4.17032620d-10
108 !D_Tmrt**4 / va
109 zz(1,5,1,1:3) = (/-1.30369025d-09, 4.13908461d-10, 9.22652254d-12/)
110 zz(1,5,2,1:2) = (/-5.08220384d-09,-2.24730961d-11/)
111 zz(1,5,3,1) = 1.17139133d-10
112 !D_Tmrt**5 / va
113 zz(1,6,1,1:2) = (/6.62154879d-10, 4.03863260d-13/)
114 zz(1,6,2,1) = 1.95087203d-12
115 !D_Tmrt**6
116 zz(1,7,1,1) = -4.73602469d-12
117 ! Pa / va
118 zz(2,1,1,1:6) = (/ 5.12733497d+00,-3.12788561d-01,-1.96701861d-02, 9.99690870d-04, 9.51738512d-06,-4.66426341d-07/)
119 zz(2,1,2,1:5) = (/ 5.48050612d-01,-3.30552823d-03,-1.64119440d-03,-5.16670694d-06, 9.52692432d-07/)
120 zz(2,1,3,1:4) = (/-4.29223622d-02, 5.00845667d-03, 1.00601257d-06,-1.81748644d-06/)
121 zz(2,1,4,1:3) = (/-1.25813502d-03,-1.79330391d-04, 2.34994441d-06/)
122 zz(2,1,5,1:2) = (/ 1.29735808d-04, 1.29064870d-06/)
123 zz(2,1,6,1) = -2.28558686d-06
124 ! Pa / D_Tmrt / va
125 zz(2,2,1,1:5) = (/-3.69476348d-02, 1.62325322d-03,-3.14279680d-05, 2.59835559d-06,-4.77136523d-08/)
126 zz(2,2,2,1:4) = (/ 8.64203390d-03,-6.87405181d-04,-9.13863872d-06, 5.15916806d-07/)
127 zz(2,2,3,1:3) = (/-3.59217476d-05, 3.28696511d-05,-7.10542454d-07/)
128 zz(2,2,4,1:2) = (/-1.24382300d-05,-7.38584400d-09/)
129 zz(2,2,5,1) = 2.20609296d-07
130 ! Pa / D_Tmrt**2 / va
131 zz(2,3,1,1:4) = (/-7.32469180d-04,-1.87381964d-05, 4.80925239d-06,-8.75492040d-08/)
132 zz(2,3,2,1:3) = (/ 2.77862930d-05,-5.06004592d-06, 1.14325367d-07/)
133 zz(2,3,3,1:2) = (/ 2.53016723d-06,-1.72857035d-08/)
134 zz(2,3,4,1) = -3.95079398d-08
135 ! Pa / D_Tmrt**3 / va
136 zz(2,4,1,1:3) = (/-3.59413173d-07, 7.04388046d-07,-1.89309167d-08/)
137 zz(2,4,2,1:2) = (/-4.79768731d-07, 7.96079978d-09/)
138 zz(2,4,3,1) = 1.62897058d-09
139 ! Pa / D_Tmrt**4 / va
140 zz(2,5,1,1:2) = (/ 3.94367674d-08,-1.18566247d-09/)
141 zz(2,5,2,1) = 3.34678041d-10
142 ! Pa / D_Tmrt**5
143 zz(2,6,1,1) = -1.15606447d-10
144 ! Pa**2 / va
145 zz(3,1,1,1:5) = (/-2.80626406d+00, 5.48712484d-01,-3.99428410d-03,-9.54009191d-04, 1.93090978d-05/)
146 zz(3,1,2,1:4) = (/-3.08806365d-01, 1.16952364d-02, 4.95271903d-04,-1.90710882d-05/)
147 zz(3,1,3,1:3) = (/ 2.10787756d-03,-6.98445738d-04, 2.30109073d-05/)
148 zz(3,1,4,1:2) = (/ 4.17856590d-04,-1.27043871d-05/)
149 zz(3,1,5,1) = -3.04620472d-06
150 ! Pa**2 / D_Tmrt / va
151 zz(3,2,1,1:4) = (/ 5.14507424d-02,-4.32510997d-03, 8.99281156d-05,-7.14663943d-07/)
152 zz(3,2,2,1:3) = (/-2.66016305d-04, 2.63789586d-04,-7.01199003d-06/)
153 zz(3,2,3,1:2) = (/-1.06823306d-04, 3.61341136d-06/)
154 zz(3,2,4,1) = 2.29748967d-07
155 ! Pa**2 / D_Tmrt**2 / va
156 zz(3,3,1,1:3) = (/3.04788893d-04,-6.42070836d-05, 1.16257971d-06/)
157 zz(3,3,2,1:2) = (/7.68023384d-06,-5.47446896d-07/)
158 zz(3,3,3,1) = -3.59937910d-08
159 ! Pa**2 / D_Tmrt**3 / va
160 zz(3,4,1,1:2) = (/-4.36497725d-06, 1.68737969d-07/)
161 zz(3,4,2,1) = 2.67489271d-08
162 ! Pa**2 / D_Tmrt**4
163 zz(3,5,1,1) = 3.23926897d-09
164 ! Pa**3 / va
165 zz(4,1,1,1:4) = (/-3.53874123d-02, -2.21201190d-01, 1.55126038d-02, -2.63917279d-04/)
166 zz(4,1,2,1:3) = (/4.53433455d-02, -4.32943862d-03, 1.45389826d-04/)
167 zz(4,1,3,1:2) = (/2.17508610d-04, -6.66724702d-05/)
168 zz(4,1,4,1) = 3.33217140d-05
169 ! Pa**3 / D_Tmrt / va
170 zz(4,2,1,1:3) = (/-2.26921615d-03, 3.80261982d-04, -5.45314314d-09/)
171 zz(4,2,2,1:2) = (/-7.96355448d-04, 2.53458034d-05/)
172 zz(4,2,3,1) = -6.31223658d-06
173 ! Pa**3 / D_Tmrt**2 / va
174 zz(4,3,1,1:2) = (/3.02122035d-04, -4.77403547d-06/)
175 zz(4,3,2,1) = 1.73825715d-06
176 ! Pa**3 / D_Tmrt**3
177 zz(4,4,1,1) = -4.09087898d-07
178 ! Pa**4 / va
179 zz(5,1,1,1:3) = (/6.14155345d-01, -6.16755931d-02, 1.33374846d-03/)
180 zz(5,1,2,1:2) = (/3.55375387d-03, -5.13027851d-04/)
181 zz(5,1,3,1) = 1.02449757d-04
182 ! Pa**4 / D_Tmrt / va
183 zz(5,2,1,1:2) = (/-1.48526421d-03, -4.11469183d-05/)
184 zz(5,2,2,1) = -6.80434415d-06
185 ! Pa**4 / D_Tmrt**2 / va
186 zz(5,3,1,1) = -9.77675906d-06
187 ! Pa**5 / va
188 zz(6,1,1,1:2) = (/8.82773108d-02, -3.01859306d-03/)
189 zz(6,1,2,1) = 1.04452989d-03
190 ! Pa**5 / D_Tmrt
191 zz(6,2,1,1) = 2.47090539d-04
192 ! Pa**6
193 zz(7,1,1,1) = 1.48348065d-03
194 !
195 zd_tmrt = ptmrt - pta
196 zpa = pehpa / 10.0; !~ use vapour pressure in kPa
197 !
198 zc_ta(:,:) = 0.
199 zc_va(:,:) = 0.
200 zc_tmrt(:,:) = 0.
201 zc_pa(:,:) = 0.
202 !
203 DO j4 = 1,7
204  DO j3 = 1,7
205  DO j2 = 1,7
206  DO j1 = 1,7
207  zc_ta(:,j1) = zz(j4,j3,j2,j1)
208  ENDDO
209  DO jj=1,SIZE(pta)
210  !ZC_VA(JJ,J2) = ZC_TA(JJ,1)+ZC_TA(JJ,2)*PTA(JJ)+ZC_TA(JJ,3)*PTA(JJ)**2+ZC_TA(JJ,4)*PTA(JJ)**3+ZC_TA(JJ,5)*PTA(JJ)**4 &
211  ! +ZC_TA(JJ,6)*PTA(JJ)**5+ZC_TA(JJ,7)*PTA(JJ)**6
212  zc_va(jj,j2) = zs(zc_ta(jj,1),zc_ta(jj,2),zc_ta(jj,3),zc_ta(jj,4),zc_ta(jj,5),zc_ta(jj,6),zc_ta(jj,7),pta(jj))
213  ENDDO
214  ENDDO
215  DO jj=1,SIZE(pta)
216  !ZC_TMRT(JJ,J3) = ZC_VA(JJ,1)+ZC_VA(JJ,2)*PVA(JJ)+ZC_VA(JJ,3)*PVA(JJ)**2+ZC_VA(JJ,4)*PVA(JJ)**3+ZC_VA(JJ,5)*PVA(JJ)**4 &
217  ! +ZC_VA(JJ,6)*PVA(JJ)**5+ZC_VA(JJ,7)*PVA(JJ)**6
218  zc_tmrt(jj,j3) = zs(zc_va(jj,1),zc_va(jj,2),zc_va(jj,3),zc_va(jj,4),zc_va(jj,5),zc_va(jj,6),zc_va(jj,7),pva(jj))
219  ENDDO
220  ENDDO
221  DO jj=1,SIZE(pta)
222  !ZC_PA(JJ,J4) = ZC_TMRT(JJ,1)+ZC_TMRT(JJ,2)*ZD_TMRT(JJ)+ZC_TMRT(JJ,3)*ZD_TMRT(JJ)**2+ZC_TMRT(JJ,4)*ZD_TMRT(JJ)**3 &
223  ! +ZC_TMRT(JJ,5)*ZD_TMRT(JJ)**4 +ZC_TMRT(JJ,6)*ZD_TMRT(JJ)**5+ZC_TMRT(JJ,7)*ZD_TMRT(JJ)**6
224  zc_pa(jj,j4) = zs(zc_tmrt(jj,1),zc_tmrt(jj,2),zc_tmrt(jj,3),zc_tmrt(jj,4),zc_tmrt(jj,5),zc_tmrt(jj,6),zc_tmrt(jj,7),zd_tmrt(jj))
225  ENDDO
226 ENDDO
227 !
228 DO jj=1,SIZE(pta)
229  !PUTCI_APPROX(JJ) = PTA(JJ) + ZC_PA(JJ,1)+ZC_PA(JJ,2)*ZPA(JJ)+ZC_PA(JJ,3)*ZPA(JJ)**2+ZC_PA(JJ,4)*ZPA(JJ)**3 &
230  ! +ZC_PA(JJ,5)*ZPA(JJ)**4 + ZC_PA(JJ,6)*ZPA(JJ)**5+ZC_PA(JJ,7)*ZPA(JJ)**6
231  putci_approx(jj) = pta(jj) + zs(zc_pa(jj,1),zc_pa(jj,2),zc_pa(jj,3),zc_pa(jj,4),zc_pa(jj,5),zc_pa(jj,6),zc_pa(jj,7),zpa(jj))
232 ENDDO
233 !
234 IF (lhook) CALL dr_hook('UTCI_APPROX',1,zhook_handle)
235 !
236 END FUNCTION utci_approx
237 
utci_approx
real function, dimension(size(pta)) utci_approx(PTA, PEHPA, PTMRT, PVA)
Definition: utci_approx.F90:6
Generated on Fri May 13 2016 09:31:06 for SURFEX by   doxygen 1.8.5