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 | SUBROUTINE ECUMEV6_FLUX(PZ0SEA,PTA,PSST,PQA,PQSAT,PVMOD, & |
---|
7 | PZREF,PSSS,PUREF,PPS,PPA,OPRECIP,OPWEBB, & |
---|
8 | PSFTH,PSFTQ,PUSTAR,PCD,PCDN,PCH,PCE, & |
---|
9 | PRI,PRESA,PRAIN,PZ0HSEA,OPERTFLUX,coeffs ) |
---|
10 | !############################################################################### |
---|
11 | !! |
---|
12 | !!**** *ECUMEV6_FLUX* |
---|
13 | !! |
---|
14 | !! PURPOSE |
---|
15 | !! ------- |
---|
16 | ! Calculate the surface turbulent fluxes of heat, moisture, and momentum |
---|
17 | ! over sea surface + corrections due to rainfall & Webb effect. |
---|
18 | !! |
---|
19 | !!** METHOD |
---|
20 | !! ------ |
---|
21 | ! The estimation of the transfer coefficients relies on the iterative |
---|
22 | ! computation of the scaling parameters U*/Teta*/q*. The convergence is |
---|
23 | ! supposed to be reached in NITERFL iterations maximum. |
---|
24 | ! Neutral transfer coefficients for momentum/temperature/humidity |
---|
25 | ! are computed as a function of the 10m-height neutral wind speed using |
---|
26 | ! the ECUME_V6 formulation based on the multi-campaign (POMME,FETCH,CATCH, |
---|
27 | ! SEMAPHORE,EQUALANT) ALBATROS dataset. |
---|
28 | !! |
---|
29 | !! EXTERNAL |
---|
30 | !! -------- |
---|
31 | !! |
---|
32 | !! IMPLICIT ARGUMENTS |
---|
33 | !! ------------------ |
---|
34 | !! |
---|
35 | !! REFERENCE |
---|
36 | !! --------- |
---|
37 | !! Fairall et al (1996), JGR, 3747-3764 |
---|
38 | !! Gosnell et al (1995), JGR, 437-442 |
---|
39 | !! Fairall et al (1996), JGR, 1295-1308 |
---|
40 | !! |
---|
41 | !! AUTHOR |
---|
42 | !! ------ |
---|
43 | !! C. Lebeaupin *Météo-France* (adapted from S. Belamari's code) |
---|
44 | !! |
---|
45 | !! MODIFICATIONS |
---|
46 | !! ------------- |
---|
47 | !! Original 15/03/2005 |
---|
48 | !! Modified 01/2006 C. Lebeaupin (adapted from A. Pirani's code) |
---|
49 | !! Modified 08/2009 B. Decharme: limitation of Ri |
---|
50 | !! Modified 09/2012 B. Decharme: CD correction |
---|
51 | !! Modified 09/2012 B. Decharme: limitation of Ri in surface_ri.F90 |
---|
52 | !! Modified 10/2012 P. Le Moigne: extra inputs for FLake use |
---|
53 | !! Modified 06/2013 B. Decharme: bug in z0 (output) computation |
---|
54 | !! Modified 12/2013 S. Belamari: ZRF computation updated: |
---|
55 | !! 1. ZP00/PPA in ZDWAT, ZLVA in ZDQSDT/ZBULB/ZRF |
---|
56 | !! 2. ZDWAT/ZDTMP in ZBULB/ZRF (Gosnell et al 95) |
---|
57 | !! 3. cool skin correction included |
---|
58 | !! Modified 01/2014 S. Belamari: salinity impact on latent heat of |
---|
59 | !! vaporization of seawater included |
---|
60 | !! Modified 01/2014 S. Belamari: new formulation for pure water |
---|
61 | !! specific heat (ZCPWA) |
---|
62 | !! Modified 01/2014 S. Belamari: 4 choices for PZ0SEA computation |
---|
63 | !! Modified 12/2015 S. Belamari: ECUME now provides parameterisations |
---|
64 | !! for: U10n*sqrt(CDN) instead of CDN |
---|
65 | !! U10n*CHN/sqrt(CDN) " CHN |
---|
66 | !! U10n*CEN/sqrt(CDN) " CEN |
---|
67 | !! Modified 01/2016 S. Belamari: New ECUME formulation |
---|
68 | !! |
---|
69 | !! To be done: |
---|
70 | !! include gustiness computation following Mondon & Redelsperger (1998) |
---|
71 | !!! |
---|
72 | !------------------------------------------------------------------------------- |
---|
73 | !! |
---|
74 | !! MODIFICATIONS RELATED TO SST CORRECTION COMPUTATION |
---|
75 | !! --------------------------------------------------- |
---|
76 | !! Modified 09/2013 S. Belamari: use 0.98 for the ocean emissivity |
---|
77 | !! following up to date satellite measurements in |
---|
78 | !! the 8-14 μm range (obtained values range from |
---|
79 | !! 0.98 to 0.99). |
---|
80 | !!! |
---|
81 | !------------------------------------------------------------------------------- |
---|
82 | ! |
---|
83 | ! 0. DECLARATIONS |
---|
84 | ! ------------ |
---|
85 | ! |
---|
86 | USE dimphy |
---|
87 | USE indice_sol_mod |
---|
88 | USE MODD_CSTS, ONLY : XPI, XDAY, XKARMAN, XG, XP00, XSTEFAN, XRD, XRV, & |
---|
89 | XCPD, XCPV, XCL, XTT, XLVTT |
---|
90 | |
---|
91 | |
---|
92 | !USE MODD_SURF_PAR, ONLY : XUNDEF |
---|
93 | !USE MODD_SURF_ATM, ONLY : XVCHRNK, XVZ0CM |
---|
94 | !USE MODD_REPROD_OPER, ONLY : CCHARNOCK |
---|
95 | ! |
---|
96 | !USE MODE_THERMOS |
---|
97 | !USE MODI_WIND_THRESHOLD |
---|
98 | !USE MODI_SURFACE_RI |
---|
99 | ! |
---|
100 | !USE YOMHOOK, ONLY : LHOOK, DR_HOOK |
---|
101 | !USE PARKIND1, ONLY : JPRB |
---|
102 | ! |
---|
103 | !USE MODI_ABOR1_SFX |
---|
104 | ! |
---|
105 | IMPLICIT NONE |
---|
106 | ! |
---|
107 | ! 0.1. Declarations of arguments |
---|
108 | ! |
---|
109 | REAL, DIMENSION(klon), INTENT(IN) :: PVMOD ! module of wind at atm level (m/s) |
---|
110 | REAL, DIMENSION(klon), INTENT(IN) :: PTA ! air temperature at atm level (K) |
---|
111 | REAL, DIMENSION(klon), INTENT(IN) :: PQA ! air spec. hum. at atm level (kg/kg) |
---|
112 | REAL, DIMENSION(klon), INTENT(IN) :: PQSAT ! sea surface spec. hum. (kg/kg) |
---|
113 | REAL, DIMENSION(klon), INTENT(IN) :: PPA ! air pressure at atm level (Pa) |
---|
114 | !REAL, DIMENSION(:), INTENT(IN) :: PRHOA ! air density at atm level (kg/m3) |
---|
115 | !REAL, DIMENSION(:), INTENT(IN) :: PEXNA ! Exner function at atm level |
---|
116 | REAL, DIMENSION(klon), INTENT(IN) :: PUREF ! atm level for wind (m) |
---|
117 | REAL, DIMENSION(klon), INTENT(IN) :: PZREF ! atm level for temp./hum. (m) |
---|
118 | REAL, DIMENSION(klon), INTENT(IN) :: PSSS ! Sea Surface Salinity (g/kg) |
---|
119 | REAL, DIMENSION(klon), INTENT(IN) :: PPS ! air pressure at sea surface (Pa) |
---|
120 | !REAL, DIMENSION(:), INTENT(IN) :: PEXNS ! Exner function at sea surface |
---|
121 | !REAL, DIMENSION(:), INTENT(IN) :: PPERTFLUX ! stochastic flux perturbation pattern |
---|
122 | ! for correction |
---|
123 | !REAL, INTENT(IN) :: PICHCE ! |
---|
124 | LOGICAL, INTENT(IN) :: OPRECIP ! |
---|
125 | LOGICAL, INTENT(IN) :: OPWEBB ! |
---|
126 | LOGICAL, INTENT(IN) :: OPERTFLUX |
---|
127 | REAL, DIMENSION(klon), INTENT(IN) :: PRAIN ! precipitation rate (kg/s/m2) |
---|
128 | ! |
---|
129 | !INTEGER, INTENT(IN) :: KZ0 |
---|
130 | ! |
---|
131 | REAL, DIMENSION(klon), INTENT(INOUT) :: PSST ! Sea Surface Temperature (K) |
---|
132 | REAL, DIMENSION(klon), INTENT(INOUT) :: PZ0SEA ! roughness length over sea |
---|
133 | REAL, DIMENSION(klon), INTENT(OUT) :: PZ0HSEA ! heat roughness length over sea |
---|
134 | |
---|
135 | ! surface fluxes : latent heat, sensible heat, friction fluxes |
---|
136 | REAL, DIMENSION(klon), INTENT(OUT) :: PUSTAR ! friction velocity (m/s) |
---|
137 | REAL, DIMENSION(klon), INTENT(OUT) :: PSFTH ! heat flux (W/m2) |
---|
138 | REAL, DIMENSION(klon), INTENT(OUT) :: PSFTQ ! water flux (kg/m2/s) |
---|
139 | |
---|
140 | ! diagnostics |
---|
141 | REAL, DIMENSION(klon), INTENT(OUT) :: PCD ! transfer coef. for momentum |
---|
142 | REAL, DIMENSION(klon), INTENT(OUT) :: PCH ! transfer coef. for temperature |
---|
143 | REAL, DIMENSION(klon), INTENT(OUT) :: PCE ! transfer coef. for humidity |
---|
144 | REAL, DIMENSION(klon), INTENT(OUT) :: PCDN ! neutral coef. for momentum |
---|
145 | REAL, DIMENSION(klon), INTENT(OUT) :: PRI ! Richardson number |
---|
146 | REAL, DIMENSION(klon), INTENT(OUT) :: PRESA ! aerodynamical resistance |
---|
147 | real, dimension(3), intent(out) :: coeffs |
---|
148 | |
---|
149 | ! 0.2. Declarations of local variables |
---|
150 | ! |
---|
151 | ! specif SB |
---|
152 | INTEGER, DIMENSION(SIZE(PTA)) :: JCV ! convergence index |
---|
153 | INTEGER, DIMENSION(SIZE(PTA)) :: JITER ! nb of iterations to converge |
---|
154 | !rajout |
---|
155 | REAL, DIMENSION(SIZE(PTA)) :: PEXNA ! Exner function at atm level |
---|
156 | REAL, DIMENSION(SIZE(PTA)) :: PEXNS ! Exner function at atm level |
---|
157 | ! |
---|
158 | REAL, DIMENSION(SIZE(PTA)) :: ZTAU ! momentum flux (N/m2) |
---|
159 | REAL, DIMENSION(SIZE(PTA)) :: ZHF ! sensible heat flux (W/m2) |
---|
160 | REAL, DIMENSION(SIZE(PTA)) :: ZEF ! latent heat flux (W/m2) |
---|
161 | REAL, DIMENSION(SIZE(PTA)) :: ZTAUR ! momentum flx due to rain (N/m2) |
---|
162 | REAL, DIMENSION(SIZE(PTA)) :: ZRF ! sensible flx due to rain (W/m2) |
---|
163 | REAL, DIMENSION(SIZE(PTA)) :: ZEFWEBB ! Webb corr. on latent flx (W/m2) |
---|
164 | |
---|
165 | REAL, DIMENSION(SIZE(PTA)) :: ZVMOD ! wind intensity at atm level (m/s) |
---|
166 | REAL, DIMENSION(SIZE(PTA)) :: ZQSATA ! sat.spec.hum. at atm level (kg/kg) |
---|
167 | REAL, DIMENSION(SIZE(PTA)) :: ZLVA ! vap.heat of pure water at atm level (J/kg) |
---|
168 | REAL, DIMENSION(SIZE(PTA)) :: ZLVS ! vap.heat of seawater at sea surface (J/kg) |
---|
169 | REAL, DIMENSION(SIZE(PTA)) :: ZCPA ! specif.heat moist air (J/kg/K) |
---|
170 | REAL, DIMENSION(SIZE(PTA)) :: ZVISA ! kinemat.visc. of dry air (m2/s) |
---|
171 | REAL, DIMENSION(SIZE(PTA)) :: ZDU ! U vert.grad. (real atm) |
---|
172 | REAL, DIMENSION(SIZE(PTA)) :: ZDT,ZDQ ! T,Q vert.grad. (real atm) |
---|
173 | REAL, DIMENSION(SIZE(PTA)) :: ZDDU ! U vert.grad. (real atm + gust) |
---|
174 | REAL, DIMENSION(SIZE(PTA)) :: ZDDT,ZDDQ ! T,Q vert.grad. (real atm + WL/CS) |
---|
175 | REAL, DIMENSION(SIZE(PTA)) :: ZUSR ! velocity scaling param. (m/s) |
---|
176 | ! =friction velocity |
---|
177 | REAL, DIMENSION(SIZE(PTA)) :: ZTSR ! temperature scaling param. (K) |
---|
178 | REAL, DIMENSION(SIZE(PTA)) :: ZQSR ! humidity scaling param. (kg/kg) |
---|
179 | REAL, DIMENSION(SIZE(PTA)) :: ZDELTAU10N,ZDELTAT10N,ZDELTAQ10N |
---|
180 | ! U,T,Q vert.grad. (10m, neutral atm) |
---|
181 | REAL, DIMENSION(SIZE(PTA)) :: ZUSR0,ZTSR0,ZQSR0 ! ITERATIVE PROCESS |
---|
182 | REAL, DIMENSION(SIZE(PTA)) :: ZDUSTO,ZDTSTO,ZDQSTO ! ITERATIVE PROCESS |
---|
183 | REAL, DIMENSION(SIZE(PTA)) :: ZPSIU,ZPSIT! PSI funct for U, T/Q (Z0 comp) |
---|
184 | REAL, DIMENSION(SIZE(PTA)) :: ZCHARN ! Charnock parameter (Z0 comp) |
---|
185 | |
---|
186 | REAL, DIMENSION(SIZE(PTA)) :: ZUSTAR2 ! square of friction velocity |
---|
187 | REAL, DIMENSION(SIZE(PTA)) :: ZAC ! aerodynamical conductance |
---|
188 | REAL, DIMENSION(SIZE(PTA)) :: ZDIRCOSZW ! orography slope cosine |
---|
189 | ! (=1 on water!) |
---|
190 | REAL, DIMENSION(SIZE(PTA)) :: ZPARUN,ZPARTN,ZPARQN ! neutral parameter for U,T,Q |
---|
191 | |
---|
192 | !-- rajout pour la pression saturante |
---|
193 | REAL, DIMENSION(SIZE(PPA)) :: ZFOES ! [OPWEBB] |
---|
194 | REAL, DIMENSION(SIZE(PPA)) :: ZWORK1 |
---|
195 | REAL, DIMENSION(SIZE(PPA)) :: ZWORK2 |
---|
196 | REAL, DIMENSION(SIZE(PPS)) :: ZWORK1A |
---|
197 | REAL, DIMENSION(SIZE(PPS)) :: ZWORK2A |
---|
198 | !##################### |
---|
199 | |
---|
200 | REAL, DIMENSION(0:5) :: ZCOEFU,ZCOEFT,ZCOEFQ |
---|
201 | |
---|
202 | !--------- Modif Olive ----------------- |
---|
203 | REAL, DIMENSION(SIZE(PTA)) :: PRHOA |
---|
204 | REAL, PARAMETER :: XUNDEF = 1.E+20 |
---|
205 | |
---|
206 | |
---|
207 | REAL :: XVCHRNK = 0.021 |
---|
208 | REAL :: XVZ0CM = 1.0E-5 |
---|
209 | !REAL :: XRIMAX |
---|
210 | |
---|
211 | CHARACTER :: CCHARNOCK = 'NEW' |
---|
212 | |
---|
213 | |
---|
214 | !-------------------------------------- |
---|
215 | |
---|
216 | |
---|
217 | ! local constants |
---|
218 | LOGICAL :: OPCVFLX ! to force convergence |
---|
219 | INTEGER :: NITERMAX ! nb of iterations to get free convergence |
---|
220 | INTEGER :: NITERSUP ! nb of additional iterations if OPCVFLX=.TRUE. |
---|
221 | INTEGER :: NITERFL ! maximum number of iterations |
---|
222 | REAL :: ZETV,ZRDSRV ! thermodynamic constants |
---|
223 | REAL :: ZSQR3 |
---|
224 | REAL :: ZLMOMIN,ZLMOMAX ! min/max value of Obukhovs stability param. z/l |
---|
225 | REAL :: ZBTA,ZGMA ! parameters of the stability functions |
---|
226 | REAL :: ZDUSR0,ZDTSR0,ZDQSR0 ! maximum gap for USR/TSR/QSR between 2 steps |
---|
227 | REAL :: ZP00 ! [OPRECIP] - water vap. diffusiv.ref.press.(Pa) |
---|
228 | REAL :: ZUTU,ZUTT,ZUTQ ! U10n threshold in ECUME parameterisation |
---|
229 | REAL :: ZCDIRU,ZCDIRT,ZCDIRQ ! coef directeur pour fonction affine U,T,Q |
---|
230 | REAL :: ZORDOU,ZORDOT,ZORDOQ ! ordonnee a l'origine pour fonction affine U,T,Q |
---|
231 | |
---|
232 | INTEGER :: JJ ! for ITERATIVE PROCESS |
---|
233 | INTEGER :: JLON,JK |
---|
234 | REAL :: ZLMOU,ZLMOT ! Obukhovs param. z/l for U, T/Q |
---|
235 | REAL :: ZPSI_U,ZPSI_T ! PSI funct. for U, T/Q |
---|
236 | REAL :: Z0TSEA,Z0QSEA ! roughness length for T, Q |
---|
237 | REAL :: ZCHIC,ZCHIK,ZPSIC,ZPSIK,ZLOGUS10,ZLOGTS10 |
---|
238 | REAL :: ZTAC,ZCPWA,ZDQSDT,ZDWAT,ZDTMP,ZBULB ! [OPRECIP] |
---|
239 | REAL :: ZWW ! [OPWEBB] |
---|
240 | |
---|
241 | |
---|
242 | INTEGER :: PREF ! reference pressure for exner function |
---|
243 | REAL, DIMENSION(klon) :: PQSATA ! sea surface spec. hum. (kg/kg) |
---|
244 | |
---|
245 | REAL :: qsat_seawater2,qsat_seawater |
---|
246 | |
---|
247 | INCLUDE "YOMCST.h" |
---|
248 | INCLUDE "clesphys.h" |
---|
249 | |
---|
250 | !REAL(KIND=JPRB) :: ZHOOK_HANDLE |
---|
251 | ! |
---|
252 | !------------------------------------------------------------------------------- |
---|
253 | !----------------------- Modif Olive calcul de PRHOA --------------------------- |
---|
254 | |
---|
255 | !write(*,*) "PZ0SEA ",PZ0SEA |
---|
256 | !write(*,*) "PTA ",PTA |
---|
257 | !write(*,*) "PSST ",PSST |
---|
258 | !write(*,*) "PQA ",PQA |
---|
259 | !write(*,*) "PVMOD ",PVMOD |
---|
260 | !write(*,*) "PZREF ",PZREF |
---|
261 | !write(*,*) "PUREF ",PUREF |
---|
262 | !write(*,*) "PPS ",PPS |
---|
263 | !write(*,*) "PPA ",PPA |
---|
264 | !write(*,*) "OPRECIP ",OPRECIP |
---|
265 | !write(*,*) "PZ0HSEA ",PZ0HSEA |
---|
266 | !write(*,*) "PRAIN ",PRAIN |
---|
267 | |
---|
268 | |
---|
269 | PRHOA(:) = PPS(:) / (287.1 * PTA(:) * (1.+.61*PQA(:))) |
---|
270 | !write(*,*) "klon klon ",klon,PTA |
---|
271 | !write(*,*) "PRHOA ",SIZE(PRHOA),PRHOA |
---|
272 | |
---|
273 | PREF = 100900. ! = 1000 hPa |
---|
274 | |
---|
275 | !PEXNA = (PPA/PPS)**RKAPPA |
---|
276 | !PEXNS = (PPS/PPS)**RKAPPA |
---|
277 | |
---|
278 | PEXNA = (PPA/PREF)**(RD/RCPD) |
---|
279 | PEXNS = (PPS/PREF)**(RD/RCPD) |
---|
280 | |
---|
281 | !IF (LHOOK) CALL DR_HOOK('ECUMEV6_FLUX',0,ZHOOK_HANDLE) |
---|
282 | ! |
---|
283 | ZDUSR0 = 1.E-06 |
---|
284 | ZDTSR0 = 1.E-06 |
---|
285 | ZDQSR0 = 1.E-09 |
---|
286 | ! |
---|
287 | NITERMAX = 5 |
---|
288 | NITERSUP = 5 |
---|
289 | OPCVFLX = .TRUE. |
---|
290 | ! |
---|
291 | NITERFL = NITERMAX |
---|
292 | IF (OPCVFLX) NITERFL = NITERMAX+NITERSUP |
---|
293 | ! |
---|
294 | ZCOEFU = (/ 1.00E-03, 3.66E-02, -1.92E-03, 2.32E-04, -7.02E-06, 6.40E-08 /) |
---|
295 | ZCOEFT = (/ 5.36E-03, 2.90E-02, -1.24E-03, 4.50E-04, -2.06E-05, 0.0 /) |
---|
296 | ZCOEFQ = (/ 1.00E-03, 3.59E-02, -2.87E-04, 0.0, 0.0, 0.0 /) |
---|
297 | ! |
---|
298 | ZUTU = 40.0 |
---|
299 | ZUTT = 14.4 |
---|
300 | ZUTQ = 10.0 |
---|
301 | ! |
---|
302 | ZCDIRU = ZCOEFU(1) + 2.0*ZCOEFU(2)*ZUTU + 3.0*ZCOEFU(3)*ZUTU**2 & |
---|
303 | + 4.0*ZCOEFU(4)*ZUTU**3 + 5.0*ZCOEFU(5)*ZUTU**4 |
---|
304 | ZCDIRT = ZCOEFT(1) + 2.0*ZCOEFT(2)*ZUTT + 3.0*ZCOEFT(3)*ZUTT**2 & |
---|
305 | + 4.0*ZCOEFT(4)*ZUTT**3 |
---|
306 | ZCDIRQ = ZCOEFQ(1) + 2.0*ZCOEFQ(2)*ZUTQ |
---|
307 | ! |
---|
308 | ZORDOU = ZCOEFU(0) + ZCOEFU(1)*ZUTU + ZCOEFU(2)*ZUTU**2 + ZCOEFU(3)*ZUTU**3 & |
---|
309 | + ZCOEFU(4)*ZUTU**4 + ZCOEFU(5)*ZUTU**5 |
---|
310 | ZORDOT = ZCOEFT(0) + ZCOEFT(1)*ZUTT + ZCOEFT(2)*ZUTT**2 + ZCOEFT(3)*ZUTT**3 & |
---|
311 | + ZCOEFT(4)*ZUTT**4 |
---|
312 | ZORDOQ = ZCOEFQ(0) + ZCOEFQ(1)*ZUTQ + ZCOEFQ(2)*ZUTQ**2 |
---|
313 | ! |
---|
314 | !------------------------------------------------------------------------------- |
---|
315 | ! |
---|
316 | ! 1. AUXILIARY CONSTANTS & ARRAY INITIALISATION BY UNDEFINED VALUES. |
---|
317 | ! -------------------------------------------------------------------- |
---|
318 | ! |
---|
319 | ZDIRCOSZW(:) = 1.0 |
---|
320 | ! |
---|
321 | ZETV = XRV/XRD-1.0 !~0.61 (cf Liu et al. 1979) |
---|
322 | ZRDSRV = XRD/XRV !~0.622 |
---|
323 | ZSQR3 = SQRT(3.0) |
---|
324 | ZLMOMIN = -200.0 |
---|
325 | ZLMOMAX = 0.25 |
---|
326 | ZBTA = 16.0 |
---|
327 | ZGMA = 7.0 !initially =4.7, modified to 7.0 following G. Caniaux |
---|
328 | ! |
---|
329 | ZP00 = 1013.25E+02 |
---|
330 | ! |
---|
331 | PCD = XUNDEF |
---|
332 | PCH = XUNDEF |
---|
333 | PCE = XUNDEF |
---|
334 | PCDN = XUNDEF |
---|
335 | ZUSR = XUNDEF |
---|
336 | ZTSR = XUNDEF |
---|
337 | ZQSR = XUNDEF |
---|
338 | ZTAU = XUNDEF |
---|
339 | ZHF = XUNDEF |
---|
340 | ZEF = XUNDEF |
---|
341 | ! |
---|
342 | PSFTH = XUNDEF |
---|
343 | PSFTQ = XUNDEF |
---|
344 | PUSTAR = XUNDEF |
---|
345 | PRESA = XUNDEF |
---|
346 | PRI = XUNDEF |
---|
347 | ! |
---|
348 | ZTAUR = 0.0 |
---|
349 | ZRF = 0.0 |
---|
350 | ZEFWEBB = 0.0 |
---|
351 | ! |
---|
352 | !------------------------------------------------------------------------------- |
---|
353 | ! |
---|
354 | ! 2. INITIALISATIONS BEFORE ITERATIVE LOOP. |
---|
355 | ! ------------------------------------------- |
---|
356 | ! |
---|
357 | !ZVMOD(:) = WIND_THRESHOLD(PVMOD(:),PUREF(:)) !set a minimum value to wind |
---|
358 | ZVMOD = MAX(PVMOD , 0.1 * MIN(10.,PUREF) ) !set a minimum value to wind |
---|
359 | |
---|
360 | write(*,*) "ZVMOD ",SIZE(ZVMOD) |
---|
361 | |
---|
362 | ! |
---|
363 | ! 2.0. Radiative fluxes - For warm layer & cool skin |
---|
364 | ! |
---|
365 | ! 2.0b. Warm Layer correction |
---|
366 | ! |
---|
367 | ! 2.1. Specific humidity at saturation |
---|
368 | ! |
---|
369 | WHERE(PSSS(:)>0.0.AND.PSSS(:)/=XUNDEF) |
---|
370 | PQSATA = QSAT_SEAWATER2 (PSST(:),PPS(:),PSSS(:)) !at sea surface |
---|
371 | ELSEWHERE |
---|
372 | PQSATA (:) = QSAT_SEAWATER (PSST(:),PPS(:)) !at sea surface |
---|
373 | ENDWHERE |
---|
374 | |
---|
375 | !ZQSATA(:) = QSAT(PTA(:),PPA(:)) !at atm level |
---|
376 | |
---|
377 | !### OLIVIER POUR PRESSION SATURANTE ##### |
---|
378 | !------------------------------------------------------------------------------- |
---|
379 | ! |
---|
380 | ZFOES = 1 !PSAT(PT(:)) |
---|
381 | ZFOES = 0.98*ZFOES |
---|
382 | ! |
---|
383 | ZWORK1 = ZFOES/PPS |
---|
384 | ZWORK2 = XRD/XRV |
---|
385 | |
---|
386 | ZWORK1A = ZFOES/PPA |
---|
387 | ZWORK2A = XRD/XRV |
---|
388 | |
---|
389 | !write(*,*) "ZFOES ",ZFOES |
---|
390 | !write(*,*) "PPS ",PPS |
---|
391 | !write(*,*) "ZWORK1 ",ZWORK1 |
---|
392 | !write(*,*) "XRD ",XRD |
---|
393 | !write(*,*) "XRV ",XRV |
---|
394 | !write(*,*) "PPA ",PPA |
---|
395 | !write(*,*) "ZWORK1A ",ZWORK1A |
---|
396 | |
---|
397 | write(*,*) "PQSAT : ",PQSAT |
---|
398 | write(*,*) "PQSATA : ",PQSATA |
---|
399 | |
---|
400 | |
---|
401 | ! |
---|
402 | !* 2. COMPUTE SATURATION HUMIDITY |
---|
403 | ! --------------------------- |
---|
404 | ! |
---|
405 | !PQSAT = ZWORK2*ZWORK1 / (1.+(ZWORK2-1.)*ZWORK1) |
---|
406 | !ZQSATA = ZWORK2A*ZWORK1A / (1.+(ZWORK2A-1.)*ZWORK1A) |
---|
407 | ZQSATA = QSAT_SEAWATER (PTA(:),PPA(:)) !at sea surface |
---|
408 | |
---|
409 | |
---|
410 | ! |
---|
411 | ! 2.2. Gradients at the air-sea interface |
---|
412 | ! |
---|
413 | ZDU(:) = ZVMOD(:) !one assumes u is measured / sea surface current |
---|
414 | ZDT(:) = PTA(:)/PEXNA(:)-PSST(:)/PEXNS(:) |
---|
415 | ZDQ(:) = PQA(:)-PQSATA(:) |
---|
416 | |
---|
417 | write(*,*) "PQA ",PQA(:) |
---|
418 | write(*,*) "PQSAT",PQSAT(:) |
---|
419 | write(*,*) "ZDQ",ZDQ(:) |
---|
420 | ! |
---|
421 | ! 2.3. Latent heat of vaporisation |
---|
422 | ! |
---|
423 | ZLVA(:) = XLVTT+(XCPV-XCL)*(PTA (:)-XTT) !of pure water at atm level |
---|
424 | ZLVS(:) = XLVTT+(XCPV-XCL)*(PSST(:)-XTT) !of pure water at sea surface |
---|
425 | |
---|
426 | |
---|
427 | |
---|
428 | write(*,*) "ZLVA ",ZLVA |
---|
429 | write(*,*) "ZLVS ",ZLVS |
---|
430 | |
---|
431 | |
---|
432 | WHERE(PSSS(:)>0.0.AND.PSSS(:)/=XUNDEF) |
---|
433 | ZLVS(:) = ZLVS(:)*(1.0-1.00472E-3*PSSS(:)) !of seawater at sea surface |
---|
434 | ENDWHERE |
---|
435 | ! |
---|
436 | ! 2.4. Specific heat of moist air (Businger 1982) |
---|
437 | ! |
---|
438 | !ZCPA(:) = XCPD*(1.0+(XCPV/XCPD-1.0)*PQA(:)) |
---|
439 | ZCPA(:) = XCPD |
---|
440 | ! |
---|
441 | ! 2.4b Kinematic viscosity of dry air (Andreas 1989, CRREL Rep. 89-11) |
---|
442 | ! |
---|
443 | ZVISA(:) = 1.326E-05*(1.0+6.542E-03*(PTA(:)-XTT)+8.301E-06*(PTA(:)-XTT)**2 & |
---|
444 | -4.84E-09*(PTA(:)-XTT)**3) |
---|
445 | ! |
---|
446 | ! 2.4c Coefficients for warm layer and/or cool skin correction |
---|
447 | ! |
---|
448 | ! 2.5. Initial guess |
---|
449 | ! |
---|
450 | ZDDU(:) = ZDU(:) |
---|
451 | ZDDT(:) = ZDT(:) |
---|
452 | ZDDQ(:) = ZDQ(:) |
---|
453 | ZDDU(:) = SIGN(MAX(ABS(ZDDU(:)),10.0*ZDUSR0),ZDDU(:)) |
---|
454 | ZDDT(:) = SIGN(MAX(ABS(ZDDT(:)),10.0*ZDTSR0),ZDDT(:)) |
---|
455 | ZDDQ(:) = SIGN(MAX(ABS(ZDDQ(:)),10.0*ZDQSR0),ZDDQ(:)) |
---|
456 | |
---|
457 | write(*,*) "ZDDU ",ZDDU |
---|
458 | write(*,*) "ZDDQ ",ZDDQ |
---|
459 | write(*,*) "ZDDT ",ZDDT |
---|
460 | |
---|
461 | ! |
---|
462 | JCV (:) = -1 |
---|
463 | ZUSR(:) = 0.04*ZDDU(:) |
---|
464 | ZTSR(:) = 0.04*ZDDT(:) |
---|
465 | ZQSR(:) = 0.04*ZDDQ(:) |
---|
466 | ZDELTAU10N(:) = ZDDU(:) |
---|
467 | ZDELTAT10N(:) = ZDDT(:) |
---|
468 | ZDELTAQ10N(:) = ZDDQ(:) |
---|
469 | JITER(:) = 99 |
---|
470 | ! |
---|
471 | ! In the following, we suppose that Richardson number PRI < XRIMAX |
---|
472 | ! If not true, Monin-Obukhov theory can't (and therefore shouldn't) be applied ! |
---|
473 | !------------------------------------------------------------------------------- |
---|
474 | ! |
---|
475 | ! 3. ITERATIVE LOOP TO COMPUTE U*, T*, Q*. |
---|
476 | ! ------------------------------------------ |
---|
477 | ! |
---|
478 | DO JJ=1,NITERFL |
---|
479 | DO JLON=1,SIZE(PTA) |
---|
480 | ! |
---|
481 | IF (JCV(JLON) == -1) THEN |
---|
482 | ZUSR0(JLON)=ZUSR(JLON) |
---|
483 | ZTSR0(JLON)=ZTSR(JLON) |
---|
484 | ZQSR0(JLON)=ZQSR(JLON) |
---|
485 | IF (JJ == NITERMAX+1 .OR. JJ == NITERMAX+NITERSUP) THEN |
---|
486 | ZDELTAU10N(JLON) = 0.5*(ZDUSTO(JLON)+ZDELTAU10N(JLON)) !forced convergence |
---|
487 | ZDELTAT10N(JLON) = 0.5*(ZDTSTO(JLON)+ZDELTAT10N(JLON)) |
---|
488 | ZDELTAQ10N(JLON) = 0.5*(ZDQSTO(JLON)+ZDELTAQ10N(JLON)) |
---|
489 | IF (JJ == NITERMAX+NITERSUP) JCV(JLON)=3 |
---|
490 | ENDIF |
---|
491 | ZDUSTO(JLON) = ZDELTAU10N(JLON) |
---|
492 | ZDTSTO(JLON) = ZDELTAT10N(JLON) |
---|
493 | ZDQSTO(JLON) = ZDELTAQ10N(JLON) |
---|
494 | ! |
---|
495 | ! 3.1. Neutral parameter for wind speed (ECUME_V6 formulation) |
---|
496 | ! |
---|
497 | IF (ZDELTAU10N(JLON) <= ZUTU) THEN |
---|
498 | ZPARUN(JLON) = ZCOEFU(0) + ZCOEFU(1)*ZDELTAU10N(JLON) & |
---|
499 | + ZCOEFU(2)*ZDELTAU10N(JLON)**2 & |
---|
500 | + ZCOEFU(3)*ZDELTAU10N(JLON)**3 & |
---|
501 | + ZCOEFU(4)*ZDELTAU10N(JLON)**4 & |
---|
502 | + ZCOEFU(5)*ZDELTAU10N(JLON)**5 |
---|
503 | ELSE |
---|
504 | ZPARUN(JLON) = ZCDIRU*(ZDELTAU10N(JLON)-ZUTU) + ZORDOU |
---|
505 | ENDIF |
---|
506 | PCDN(JLON) = (ZPARUN(JLON)/ZDELTAU10N(JLON))**2 |
---|
507 | ! |
---|
508 | ! 3.2. Neutral parameter for temperature (ECUME_V6 formulation) |
---|
509 | ! |
---|
510 | IF (ZDELTAU10N(JLON) <= ZUTT) THEN |
---|
511 | ZPARTN(JLON) = ZCOEFT(0) + ZCOEFT(1)*ZDELTAU10N(JLON) & |
---|
512 | + ZCOEFT(2)*ZDELTAU10N(JLON)**2 & |
---|
513 | + ZCOEFT(3)*ZDELTAU10N(JLON)**3 & |
---|
514 | + ZCOEFT(4)*ZDELTAU10N(JLON)**4 |
---|
515 | ELSE |
---|
516 | ZPARTN(JLON) = ZCDIRT*(ZDELTAU10N(JLON)-ZUTT) + ZORDOT |
---|
517 | ENDIF |
---|
518 | ! |
---|
519 | ! 3.3. Neutral parameter for humidity (ECUME_V6 formulation) |
---|
520 | ! |
---|
521 | IF (ZDELTAU10N(JLON) <= ZUTQ) THEN |
---|
522 | ZPARQN(JLON) = ZCOEFQ(0) + ZCOEFQ(1)*ZDELTAU10N(JLON) & |
---|
523 | + ZCOEFQ(2)*ZDELTAU10N(JLON)**2 |
---|
524 | ELSE |
---|
525 | ZPARQN(JLON) = ZCDIRQ*(ZDELTAU10N(JLON)-ZUTQ) + ZORDOQ |
---|
526 | ENDIF |
---|
527 | ! |
---|
528 | ! 3.4. Scaling parameters U*, T*, Q* |
---|
529 | ! |
---|
530 | ZUSR(JLON) = ZPARUN(JLON) |
---|
531 | ZTSR(JLON) = ZPARTN(JLON)*ZDELTAT10N(JLON)/ZDELTAU10N(JLON) |
---|
532 | ZQSR(JLON) = ZPARQN(JLON)*ZDELTAQ10N(JLON)/ZDELTAU10N(JLON) |
---|
533 | ! |
---|
534 | ! 3.4b Gustiness factor (Deardorff 1970) |
---|
535 | ! |
---|
536 | ! 3.4c Cool skin correction |
---|
537 | ! |
---|
538 | ! 3.5. Obukhovs stability param. z/l following Liu et al. (JAS, 1979) |
---|
539 | ! |
---|
540 | ! For U |
---|
541 | ZLMOU = PUREF(JLON)*XG*XKARMAN*(ZTSR(JLON)/PTA(JLON) & |
---|
542 | +ZETV*ZQSR(JLON)/(1.0+ZETV*PQA(JLON)))/ZUSR(JLON)**2 |
---|
543 | ! For T/Q |
---|
544 | ZLMOT = ZLMOU*(PZREF(JLON)/PUREF(JLON)) |
---|
545 | ZLMOU = MAX(MIN(ZLMOU,ZLMOMAX),ZLMOMIN) |
---|
546 | ZLMOT = MAX(MIN(ZLMOT,ZLMOMAX),ZLMOMIN) |
---|
547 | ! |
---|
548 | ! 3.6. Stability function psi (see Liu et al, 1979 ; Dyer and Hicks, 1970) |
---|
549 | ! Modified to include convective form following Fairall (unpublished) |
---|
550 | ! |
---|
551 | ! For U |
---|
552 | IF (ZLMOU == 0.0) THEN |
---|
553 | ZPSI_U = 0.0 |
---|
554 | ELSEIF (ZLMOU > 0.0) THEN |
---|
555 | ZPSI_U = -ZGMA*ZLMOU |
---|
556 | ELSE |
---|
557 | ZCHIK = (1.0-ZBTA*ZLMOU)**0.25 |
---|
558 | ZPSIK = 2.0*LOG((1.0+ZCHIK)/2.0) & |
---|
559 | +LOG((1.0+ZCHIK**2)/2.0) & |
---|
560 | -2.0*ATAN(ZCHIK)+0.5*XPI |
---|
561 | ZCHIC = (1.0-12.87*ZLMOU)**(1.0/3.0) !for very unstable conditions |
---|
562 | ZPSIC = 1.5*LOG((ZCHIC**2+ZCHIC+1.0)/3.0) & |
---|
563 | -ZSQR3*ATAN((2.0*ZCHIC+1.0)/ZSQR3) & |
---|
564 | +XPI/ZSQR3 |
---|
565 | ZPSI_U = ZPSIC+(ZPSIK-ZPSIC)/(1.0+ZLMOU**2) !match Kansas & free-conv. forms |
---|
566 | ENDIF |
---|
567 | ZPSIU(JLON) = ZPSI_U |
---|
568 | ! For T/Q |
---|
569 | IF (ZLMOT == 0.0) THEN |
---|
570 | ZPSI_T = 0.0 |
---|
571 | ELSEIF (ZLMOT > 0.0) THEN |
---|
572 | ZPSI_T = -ZGMA*ZLMOT |
---|
573 | ELSE |
---|
574 | ZCHIK = (1.0-ZBTA*ZLMOT)**0.25 |
---|
575 | ZPSIK = 2.0*LOG((1.0+ZCHIK**2)/2.0) |
---|
576 | ZCHIC = (1.0-12.87*ZLMOT)**(1.0/3.0) !for very unstable conditions |
---|
577 | ZPSIC = 1.5*LOG((ZCHIC**2+ZCHIC+1.0)/3.0) & |
---|
578 | -ZSQR3*ATAN((2.0*ZCHIC+1.0)/ZSQR3) & |
---|
579 | +XPI/ZSQR3 |
---|
580 | ZPSI_T = ZPSIC+(ZPSIK-ZPSIC)/(1.0+ZLMOT**2) !match Kansas & free-conv. forms |
---|
581 | ENDIF |
---|
582 | ZPSIT(JLON) = ZPSI_T |
---|
583 | ! |
---|
584 | ! 3.7. Update air-sea gradients |
---|
585 | ! |
---|
586 | ZDDU(JLON) = ZDU(JLON) |
---|
587 | ZDDT(JLON) = ZDT(JLON) |
---|
588 | ZDDQ(JLON) = ZDQ(JLON) |
---|
589 | ZDDU(JLON) = SIGN(MAX(ABS(ZDDU(JLON)),10.0*ZDUSR0),ZDDU(JLON)) |
---|
590 | ZDDT(JLON) = SIGN(MAX(ABS(ZDDT(JLON)),10.0*ZDTSR0),ZDDT(JLON)) |
---|
591 | ZDDQ(JLON) = SIGN(MAX(ABS(ZDDQ(JLON)),10.0*ZDQSR0),ZDDQ(JLON)) |
---|
592 | ZLOGUS10 = LOG(PUREF(JLON)/10.0) |
---|
593 | ZLOGTS10 = LOG(PZREF(JLON)/10.0) |
---|
594 | ZDELTAU10N(JLON) = ZDDU(JLON)-ZUSR(JLON)*(ZLOGUS10-ZPSI_U)/XKARMAN |
---|
595 | ZDELTAT10N(JLON) = ZDDT(JLON)-ZTSR(JLON)*(ZLOGTS10-ZPSI_T)/XKARMAN |
---|
596 | ZDELTAQ10N(JLON) = ZDDQ(JLON)-ZQSR(JLON)*(ZLOGTS10-ZPSI_T)/XKARMAN |
---|
597 | ZDELTAU10N(JLON) = SIGN(MAX(ABS(ZDELTAU10N(JLON)),10.0*ZDUSR0), & |
---|
598 | ZDELTAU10N(JLON)) |
---|
599 | ZDELTAT10N(JLON) = SIGN(MAX(ABS(ZDELTAT10N(JLON)),10.0*ZDTSR0), & |
---|
600 | ZDELTAT10N(JLON)) |
---|
601 | ZDELTAQ10N(JLON) = SIGN(MAX(ABS(ZDELTAQ10N(JLON)),10.0*ZDQSR0), & |
---|
602 | ZDELTAQ10N(JLON)) |
---|
603 | ! |
---|
604 | ! 3.8. Test convergence for U*, T*, Q* |
---|
605 | ! |
---|
606 | IF (ABS(ZUSR(JLON)-ZUSR0(JLON)) < ZDUSR0 .AND. & |
---|
607 | ABS(ZTSR(JLON)-ZTSR0(JLON)) < ZDTSR0 .AND. & |
---|
608 | ABS(ZQSR(JLON)-ZQSR0(JLON)) < ZDQSR0) THEN |
---|
609 | JCV(JLON) = 1 !free convergence |
---|
610 | IF (JJ >= NITERMAX+1) JCV(JLON) = 2 !leaded convergence |
---|
611 | ENDIF |
---|
612 | JITER(JLON) = JJ |
---|
613 | ENDIF |
---|
614 | ! |
---|
615 | ENDDO |
---|
616 | ENDDO |
---|
617 | ! |
---|
618 | !------------------------------------------------------------------------------- |
---|
619 | ! |
---|
620 | ! 4. COMPUTATION OF TURBULENT FLUXES AND EXCHANGE COEFFICIENTS. |
---|
621 | ! --------------------------------------------------------------- |
---|
622 | ! |
---|
623 | DO JLON=1,SIZE(PTA) |
---|
624 | ! |
---|
625 | ! 4.1. Surface turbulent fluxes |
---|
626 | ! (ATM CONV.: ZTAU<<0 ; ZHF,ZEF<0 if atm looses heat) |
---|
627 | ! |
---|
628 | ZTAU(JLON) = -PRHOA(JLON)*ZUSR(JLON)**2 |
---|
629 | ZHF(JLON) = -PRHOA(JLON)*ZCPA(JLON)*ZUSR(JLON)*ZTSR(JLON) |
---|
630 | ZEF(JLON) = -PRHOA(JLON)*ZLVS(JLON)*ZUSR(JLON)*ZQSR(JLON) |
---|
631 | |
---|
632 | write(*,*) "ZTAU = ",ZTAU(JLON) |
---|
633 | write(*,*) "SENS = ",ZHF(JLON) |
---|
634 | write(*,*) "LAT = ",ZEF(JLON) |
---|
635 | |
---|
636 | ! |
---|
637 | ! 4.2. Exchange coefficients PCD, PCH, PCE |
---|
638 | ! |
---|
639 | PCD(JLON) = (ZUSR(JLON)/ZDDU(JLON))**2 |
---|
640 | PCH(JLON) = (ZUSR(JLON)*ZTSR(JLON))/(ZDDU(JLON)*ZDDT(JLON)) |
---|
641 | PCE(JLON) = (ZUSR(JLON)*ZQSR(JLON))/(ZDDU(JLON)*ZDDQ(JLON)) |
---|
642 | |
---|
643 | write(*,*) "ZUSR = ",ZUSR(JLON) |
---|
644 | write(*,*) "ZTSR = ",ZTSR(JLON) |
---|
645 | write(*,*) "ZQSR = ",ZQSR(JLON) |
---|
646 | |
---|
647 | ! |
---|
648 | ! 4.3. Stochastic perturbation of turbulent fluxes |
---|
649 | ! |
---|
650 | ! IF( OPERTFLUX )THEN |
---|
651 | ! ZTAU(JLON) = ZTAU(JLON)* ( 1. + PPERTFLUX(JLON) / 2. ) |
---|
652 | ! ZHF (JLON) = ZHF(JLON)* ( 1. + PPERTFLUX(JLON) / 2. ) |
---|
653 | ! ZEF (JLON) = ZEF(JLON)* ( 1. + PPERTFLUX(JLON) / 2. ) |
---|
654 | ! ENDIF |
---|
655 | ! |
---|
656 | ENDDO |
---|
657 | ! |
---|
658 | !------------------------------------------------------------------------------- |
---|
659 | ! |
---|
660 | ! 5. COMPUTATION OF FLUX CORRECTIONS DUE TO RAINFALL. |
---|
661 | ! (ATM conv: ZRF<0 if atm. looses heat, ZTAUR<<0) |
---|
662 | ! ----------------------------------------------------- |
---|
663 | ! |
---|
664 | IF (OPRECIP) THEN |
---|
665 | DO JLON=1,SIZE(PTA) |
---|
666 | ! |
---|
667 | ! 5.1. Momentum flux due to rainfall (ZTAUR, N/m2) |
---|
668 | ! |
---|
669 | ! See pp3752 in FBR96. |
---|
670 | ZTAUR(JLON) = -0.85*PRAIN(JLON)*PVMOD(JLON) |
---|
671 | ! |
---|
672 | ! 5.2. Sensible heat flux due to rainfall (ZRF, W/m2) |
---|
673 | ! |
---|
674 | ! See Eq.12 in GoF95 with ZCPWA as specific heat of water at atm level (J/kg/K), |
---|
675 | ! ZDQSDT from Clausius-Clapeyron relation, ZDWAT as water vapor diffusivity |
---|
676 | ! (Eq.13-3 of Pruppacher and Klett, 1978), ZDTMP as heat diffusivity, and ZBULB |
---|
677 | ! as wet-bulb factor (Eq.11 in GoF95). |
---|
678 | ! |
---|
679 | ZTAC = PTA(JLON)-XTT |
---|
680 | ZCPWA = 4217.51 -3.65566*ZTAC +0.1381*ZTAC**2 & |
---|
681 | -2.8309E-03*ZTAC**3 +3.42061E-05*ZTAC**4 & |
---|
682 | -2.18107E-07*ZTAC**5 +5.74535E-10*ZTAC**6 |
---|
683 | ZDQSDT = (ZLVA(JLON)*ZQSATA(JLON))/(XRV*PTA(JLON)**2) |
---|
684 | ZDWAT = 2.11E-05*(ZP00/PPA(JLON))*(PTA(JLON)/XTT)**1.94 |
---|
685 | ZDTMP = (1.0+3.309E-03*ZTAC-1.44E-06*ZTAC**2) & |
---|
686 | *0.02411/(PRHOA(JLON)*ZCPA(JLON)) |
---|
687 | ZBULB = 1.0/(1.0+ZDQSDT*(ZLVA(JLON)*ZDWAT)/(ZCPA(JLON)*ZDTMP)) |
---|
688 | ZRF(JLON) = PRAIN(JLON)*ZCPWA*ZBULB*((PSST(JLON)-PTA(JLON)) & |
---|
689 | +(PQSATA(JLON)-PQA(JLON))*(ZLVA(JLON)*ZDWAT)/(ZCPA(JLON)*ZDTMP)) |
---|
690 | ! |
---|
691 | ENDDO |
---|
692 | ENDIF |
---|
693 | ! |
---|
694 | !------------------------------------------------------------------------------- |
---|
695 | ! |
---|
696 | ! 6. COMPUTATION OF WEBB CORRECTION TO LATENT HEAT FLUX (ZEFWEBB, W/m2). |
---|
697 | ! ------------------------------------------------------------------------ |
---|
698 | ! |
---|
699 | ! See Eq.21 and Eq.22 in FBR96. |
---|
700 | IF (OPWEBB) THEN |
---|
701 | DO JLON=1,SIZE(PTA) |
---|
702 | ZWW = (1.0+ZETV)*(ZUSR(JLON)*ZQSR(JLON)) & |
---|
703 | +(1.0+(1.0+ZETV)*PQA(JLON))*(ZUSR(JLON)*ZTSR(JLON))/PTA(JLON) |
---|
704 | ZEFWEBB(JLON) = -PRHOA(JLON)*ZLVS(JLON)*ZWW*PQA(JLON) |
---|
705 | ENDDO |
---|
706 | ENDIF |
---|
707 | ! |
---|
708 | !------------------------------------------------------------------------------- |
---|
709 | ! |
---|
710 | ! 7. FINAL STEP : TOTAL SURFACE FLUXES AND DERIVED DIAGNOSTICS. |
---|
711 | ! --------------------------------------------------------------- |
---|
712 | ! |
---|
713 | ! 7.1. Richardson number |
---|
714 | ! |
---|
715 | ! CALL SURFACE_RI(PSST,PQSAT,PEXNS,PEXNA,PTA,PQA, & |
---|
716 | ! PZREF,PUREF,ZDIRCOSZW,PVMOD,PRI) |
---|
717 | ! |
---|
718 | ! 7.2. Friction velocity which contains correction due to rain |
---|
719 | ! |
---|
720 | ZUSTAR2(:) = -(ZTAU(:)+ZTAUR(:))/PRHOA(:) !>>0 as ZTAU<<0 & ZTAUR<=0 |
---|
721 | ! |
---|
722 | IF (OPRECIP) THEN |
---|
723 | PCD(:) = ZUSTAR2(:)/ZDDU(:)**2 |
---|
724 | ENDIF |
---|
725 | ! |
---|
726 | PUSTAR(:) = SQRT(ZUSTAR2(:)) !>>0 |
---|
727 | ! |
---|
728 | ! 7.3. Aerodynamical conductance and resistance |
---|
729 | ! |
---|
730 | ZAC (:) = PCH(:)*ZDDU(:) |
---|
731 | PRESA(:) = 1.0/ZAC(:) |
---|
732 | ! |
---|
733 | ! 7.4. Total surface fluxes |
---|
734 | ! |
---|
735 | PSFTH(:) = ZHF(:)+ZRF(:) |
---|
736 | PSFTQ(:) = (ZEF(:)+ZEFWEBB(:))/ZLVS(:) |
---|
737 | ! |
---|
738 | ! 7.5. Charnock number |
---|
739 | ! |
---|
740 | IF (CCHARNOCK == 'OLD') THEN |
---|
741 | ZCHARN(:) = XVCHRNK |
---|
742 | ELSE !modified for moderate wind speed as in COARE3.0 |
---|
743 | ZCHARN(:) = MIN(0.018,MAX(0.011,0.011+(0.007/8.0)*(ZDDU(:)-10.0))) |
---|
744 | ENDIF |
---|
745 | ! |
---|
746 | ! 7.6. Roughness lengths Z0 and Z0H over sea |
---|
747 | ! |
---|
748 | !IF (KZ0 == 0) THEN ! ARPEGE formulation |
---|
749 | ! PZ0SEA (:) = (ZCHARN(:)/XG)*ZUSTAR2(:) + XVZ0CM*PCD(:)/PCDN(:) |
---|
750 | ! PZ0HSEA(:) = PZ0SEA (:) |
---|
751 | !ELSEIF (KZ0 == 1) THEN ! Smith (1988) formulation |
---|
752 | ! PZ0SEA (:) = (ZCHARN(:)/XG)*ZUSTAR2(:) + 0.11*ZVISA(:)/PUSTAR(:) |
---|
753 | ! PZ0HSEA(:) = PZ0SEA (:) |
---|
754 | !ELSEIF (KZ0 == 2) THEN ! Direct computation using the stability functions |
---|
755 | ! DO JLON=1,SIZE(PTA) |
---|
756 | ! PZ0SEA (JLON) = PUREF(JLON)/EXP(XKARMAN*ZDDU(JLON)/PUSTAR(JLON)+ZPSIU(JLON)) |
---|
757 | ! Z0TSEA = PZREF(JLON)/EXP(XKARMAN*ZDDT(JLON)/ZTSR (JLON)+ZPSIT(JLON)) |
---|
758 | ! Z0QSEA = PZREF(JLON)/EXP(XKARMAN*ZDDQ(JLON)/ZQSR (JLON)+ZPSIT(JLON)) |
---|
759 | ! PZ0HSEA(JLON) = 0.5*(Z0TSEA+Z0QSEA) |
---|
760 | ! ENDDO |
---|
761 | !ENDIF |
---|
762 | |
---|
763 | write(*,*) "JLON ",JLON |
---|
764 | write(*,*) "PTA ",klon,PTA |
---|
765 | write(*,*) "PCD ",SIZE(PCD),PCD |
---|
766 | write(*,*) "PCQ ",SIZE(PCE),PCE |
---|
767 | write(*,*) "PCH ",SIZE(PCH),PCH |
---|
768 | |
---|
769 | coeffs = [PCD,& |
---|
770 | PCE,& |
---|
771 | PCH] |
---|
772 | ! |
---|
773 | ! |
---|
774 | !IF (LHOOK) CALL DR_HOOK('ECUMEV6_FLUX',1,ZHOOK_HANDLE) |
---|
775 | ! |
---|
776 | !------------------------------------------------------------------------------- |
---|
777 | END SUBROUTINE ECUMEV6_FLUX |
---|