Context Navigation

module_ForDiagnostics.f90 @ 1787

Last change on this file since 1787 was 1784, checked in by lfita, 7 years ago

Adding:

`WRFzwind_log': extrapolate the wind at a given height following the 'logarithmic law' methodology

File size: 26.8 KB

Line
1	!! Fortran version of different diagnostics
2	! L. Fita. LMD May 2016
3	! gfortran module_generic.o module_ForDiagnosticsVars.o -c module_ForDiagnostics.F90
4	!
5	! f2py -m module_ForDiagnostics --f90exec=/usr/bin/gfortran-4.7 -c module_generic.F90 module_ForDiagnosticsVars.F90 module_ForDiagnostics.F90
6
7	MODULE module_ForDiagnostics
8
9	USE module_definitions
10	USE module_generic
11	USE module_ForDiagnosticsVars
12
13	CONTAINS
14
15	!!!!!!! Calculations
16	! compute_cape_afwa4D: Subroutine to use WRF phys/module_diag_afwa.F `buyoancy' subroutine to compute
17	! CAPE, CIN, ZLFC, PLFC, LI
18	! compute_cllmh4D3: Computation of low, medium and high cloudiness from a 4D CLDFRA and pressure being
19	! 3rd dimension the z-dim
20	! compute_cllmh3D3: Computation of low, medium and high cloudiness from a 3D CLDFRA and pressure being
21	! 3rd dimension the z-dim
22	! compute_cllmh: Computation of low, medium and high cloudiness
23	! compute_clt4D3: Computation of total cloudiness from a 4D CLDFRA being 3rd dimension the z-dim
24	! compute_clt3D3: Computation of total cloudiness from a 3D CLDFRA being 3rd dimension the z-dim
25	! compute_clt: Computation of total cloudiness
26	! compute_massvertint1D: Subroutine to vertically integrate a 1D variable in eta vertical coordinates
27	! compute_vertint1D: Subroutine to vertically integrate a 1D variable in any vertical coordinates
28	! compute_zint4D: Subroutine to vertically integrate a 4D variable in any vertical coordinates
29	! compute_zmla_generic4D: Subroutine to compute pbl-height following a generic method
30	! compute_zwind4D: Subroutine to compute extrapolate the wind at a given height following the 'power law' methodology
31	! compute_zwind_log4D: Subroutine to compute extrapolate the wind at a given height following the 'logarithmic law' methodology
32	! compute_zwindMCO3D: Subroutine to compute extrapolate the wind at a given height following the 'power law' methodolog
33
34	!!!
35	! Calculations
36	!!!
37
38	SUBROUTINE compute_cllmh4D2(cldfra4D, pres4D, cllmh4D2, d1, d2, d3, d4)
39	! Subroutine to compute the low, medium and high cloudiness following 'newmicro.F90' from LMDZ from a 4D CLDFRA and pressure
40	! where zdim is the 2nd dimension (thus, cldfra4D(d1,d2,d3,d4) --> cllmh(3,d1,d3,d4) 1: low, 2: medium, 3: high
41	! It should be properly done via an 'INTERFACE', but...
42
43	IMPLICIT NONE
44
45	INTEGER, INTENT(in) :: d1, d2, d3, d4
46	REAL(r_k), DIMENSION(d1,d2,d3,d4), INTENT(in) :: cldfra4D, pres4D
47	REAL(r_k), DIMENSION(3,d1,d3,d4), INTENT(out) :: cllmh4D2
48
49	! Local
50	INTEGER :: i,j,k, zdim, Ndim
51
52	!!!!!!! Variables
53	! cldfra4D: 4D cloud fraction values [1]
54	! pres4D: 4D pressure values [Pa]
55	! Ndim: number of dimensions of the input data
56	! d[1-4]: dimensions of 'cldfra4D'
57	! zdim: number of the vertical-dimension within the matrix
58	! cltlmh4D2: low, medium, high cloudiness for the 4D cldfra and d2 being 'zdim'
59
60	fname = 'compute_cllmh4D2'
61	zdim = 2
62	Ndim = 4
63
64	DO i=1, d1
65	DO j=1, d3
66	DO k=1, d4
67	cllmh4D2(:,i,j,k) = var_cllmh(cldfra4D(i,:,j,k), pres4D(i,:,j,k), d2)
68	END DO
69	END DO
70	END DO
71
72	RETURN
73
74	END SUBROUTINE compute_cllmh4D2
75
76	SUBROUTINE compute_cllmh3D1(cldfra3D, pres3D, cllmh3D1, d1, d2, d3)
77	! Subroutine to compute the low, medium and high cloudiness following 'newmicro.F90' from LMDZ from a 3D CLDFRA and pressure
78	! where zdim is the 1st dimension (thus, cldfra3D(d1,d2,d3) --> cllmh(3,d2,d3) 1: low, 2: medium, 3: high
79	! It should be properly done via an 'INTERFACE', but...
80
81	IMPLICIT NONE
82
83	INTEGER, INTENT(in) :: d1, d2, d3
84	REAL(r_k), DIMENSION(d1,d2,d3), INTENT(in) :: cldfra3D, pres3D
85	REAL(r_k), DIMENSION(3,d2,d3), INTENT(out) :: cllmh3D1
86
87	! Local
88	INTEGER :: i,j,k, zdim, Ndim
89
90	!!!!!!! Variables
91	! cldfra3D: 3D cloud fraction values [1]
92	! pres3D: 3D pressure values [Pa]
93	! Ndim: number of dimensions of the input data
94	! d[1-3]: dimensions of 'cldfra3D'
95	! zdim: number of the vertical-dimension within the matrix
96	! cltlmh3D1: low, medium, high cloudiness for the 3D cldfra and d1 being 'zdim'
97
98	fname = 'compute_cllmh3D1'
99	zdim = 1
100	Ndim = 3
101
102	DO i=1, d1
103	DO j=1, d2
104	cllmh3D1(:,i,j) = var_cllmh(cldfra3D(:,i,j), pres3D(:,i,j), d1)
105	END DO
106	END DO
107
108	RETURN
109
110	END SUBROUTINE compute_cllmh3D1
111
112	SUBROUTINE compute_cllmh(cldfra1D, cldfra2D, cldfra3D, cldfra4D, pres1D, pres2D, pres3D, pres4D, &
113	Ndim, zdim, cllmh1D, cllmh2D1, cllmh2D2, cllmh3D1, cllmh3D2, cllmh3D3, cllmh4D1, cllmh4D2, &
114	cllmh4D3, cllmh4D4, d1, d2, d3, d4)
115	! Subroutine to compute the low, medium and high cloudiness following 'newmicro.F90' from LMDZ
116
117	IMPLICIT NONE
118
119	INTEGER, INTENT(in) :: Ndim, d1, d2, d3, d4, zdim
120	REAL(r_k), DIMENSION(d1), OPTIONAL, INTENT(in) :: cldfra1D, pres1D
121	REAL(r_k), DIMENSION(d1,d2), OPTIONAL, INTENT(in) :: cldfra2D, pres2D
122	REAL(r_k), DIMENSION(d1,d2,d3), OPTIONAL, INTENT(in) :: cldfra3D, pres3D
123	REAL(r_k), DIMENSION(d1,d2,d3,d4), OPTIONAL, &
124	INTENT(in) :: cldfra4D, pres4D
125	REAL(r_k), DIMENSION(3), OPTIONAL, INTENT(out) :: cllmh1D
126	REAL(r_k), DIMENSION(d1,3), OPTIONAL, INTENT(out) :: cllmh2D1
127	REAL(r_k), DIMENSION(d2,3), OPTIONAL, INTENT(out) :: cllmh2D2
128	REAL(r_k), DIMENSION(d2,d3,3), OPTIONAL, INTENT(out) :: cllmh3D1
129	REAL(r_k), DIMENSION(d1,d3,3), OPTIONAL, INTENT(out) :: cllmh3D2
130	REAL(r_k), DIMENSION(d1,d2,3), OPTIONAL, INTENT(out) :: cllmh3D3
131	REAL(r_k), DIMENSION(d2,d3,d4,3), OPTIONAL, &
132	INTENT(out) :: cllmh4D1
133	REAL(r_k), DIMENSION(d1,d3,d4,3), OPTIONAL, &
134	INTENT(out) :: cllmh4D2
135	REAL(r_k), DIMENSION(d1,d2,d4,3), OPTIONAL, &
136	INTENT(out) :: cllmh4D3
137	REAL(r_k), DIMENSION(d1,d2,d3,3), OPTIONAL, &
138	INTENT(out) :: cllmh4D4
139
140	! Local
141	INTEGER :: i,j,k
142
143	!!!!!!! Variables
144	! cldfra[1-4]D: cloud fraction values [1]
145	! pres[1-4]D: pressure values [Pa]
146	! Ndim: number of dimensions of the input data
147	! d[1-4]: dimensions of 'cldfra'
148	! zdim: number of the vertical-dimension within the matrix
149	! cllmh1D: low, medium and high cloudiness for the 1D cldfra
150	! cllmh2D1: low, medium and high cloudiness for the 2D cldfra and d1 being 'zdim'
151	! cllmh2D2: low, medium and high cloudiness for the 2D cldfra and d2 being 'zdim'
152	! cllmh3D1: low, medium and high cloudiness for the 3D cldfra and d1 being 'zdim'
153	! cllmh3D2: low, medium and high cloudiness for the 3D cldfra and d2 being 'zdim'
154	! cllmh3D3: low, medium and high cloudiness for the 3D cldfra and d3 being 'zdim'
155	! cllmh4D1: low, medium and high cloudiness for the 4D cldfra and d1 being 'zdim'
156	! cllmh4D2: low, medium and high cloudiness for the 4D cldfra and d2 being 'zdim'
157	! cllmh4D3: low, medium and high cloudiness for the 4D cldfra and d3 being 'zdim'
158	! cllmh4D4: low, medium and high cloudiness for the 4D cldfra and d4 being 'zdim'
159
160	fname = 'compute_cllmh'
161
162	SELECT CASE (Ndim)
163	CASE (1)
164	cllmh1D = var_cllmh(cldfra1D, pres1D, d1)
165	CASE (2)
166	IF (zdim == 1) THEN
167	DO i=1, d2
168	cllmh2D1(i,:) = var_cllmh(cldfra2D(:,i), pres2D(:,i), d1)
169	END DO
170	ELSE IF (zdim == 2) THEN
171	DO i=1, d1
172	cllmh2D2(i,:) = var_cllmh(cldfra2D(:,i), pres2D(i,:), d2)
173	END DO
174	ELSE
175	PRINT *,TRIM(ErrWarnMsg('err'))
176	PRINT *,' ' // TRIM(fname) // ': wrong zdim:', zdim,' for Ndim=', Ndim, ' !!'
177	PRINT *,' accepted values: 1,2'
178	STOP
179	END IF
180	CASE (3)
181	IF (zdim == 1) THEN
182	DO i=1, d2
183	DO j=1, d3
184	cllmh3D1(i,j,:) = var_cllmh(cldfra3D(:,i,j), pres3D(:,i,j), d1)
185	END DO
186	END DO
187	ELSE IF (zdim == 2) THEN
188	DO i=1, d1
189	DO j=1, d3
190	cllmh3D2(i,j,:) = var_cllmh(cldfra3D(i,:,j), pres3D(i,:,j), d2)
191	END DO
192	END DO
193	ELSE IF (zdim == 3) THEN
194	DO i=1, d1
195	DO j=1, d2
196	cllmh3D3(i,j,:) = var_cllmh(cldfra3D(i,j,:), pres3D(i,j,:), d3)
197	END DO
198	END DO
199	ELSE
200	PRINT *,TRIM(ErrWarnMsg('err'))
201	PRINT *,' ' // TRIM(fname) // ': wrong zdim:', zdim,' for Ndim=', Ndim, ' !!'
202	PRINT *,' accepted values: 1,2,3'
203	STOP
204	END IF
205	CASE (4)
206	IF (zdim == 1) THEN
207	DO i=1, d2
208	DO j=1, d3
209	DO k=1, d4
210	cllmh4D1(i,j,k,:) = var_cllmh(cldfra4D(:,i,j,k), pres4D(:,i,j,k), d1)
211	END DO
212	END DO
213	END DO
214	ELSE IF (zdim == 2) THEN
215	DO i=1, d1
216	DO j=1, d3
217	DO k=1, d4
218	cllmh4D2(i,j,k,:) = var_cllmh(cldfra4D(i,:,j,k), pres4D(i,:,j,k), d2)
219	END DO
220	END DO
221	END DO
222	ELSE IF (zdim == 3) THEN
223	DO i=1, d2
224	DO j=1, d3
225	DO k=1, d4
226	cllmh4D3(i,j,k,:) = var_cllmh(cldfra4D(i,j,:,k), pres4D(i,j,:,k), d3)
227	END DO
228	END DO
229	END DO
230	ELSE IF (zdim == 4) THEN
231	DO i=1, d1
232	DO j=1, d2
233	DO k=1, d3
234	cllmh4D4(i,j,k,:) = var_cllmh(cldfra4D(i,j,k,:), pres4D(i,j,k,:), d4)
235	END DO
236	END DO
237	END DO
238	ELSE
239	PRINT *,TRIM(ErrWarnMsg('err'))
240	PRINT *,' ' // TRIM(fname) // ': wrong zdim:', zdim,' for Ndim=', Ndim, ' !!'
241	PRINT *,' accepted values: 1,2,3,4'
242	STOP
243	END IF
244	CASE DEFAULT
245	PRINT *,TRIM(ErrWarnMsg('err'))
246	PRINT *,' ' // TRIM(fname) // ': Ndim:', Ndim,' not ready !!'
247	STOP
248	END SELECT
249
250	RETURN
251
252	END SUBROUTINE compute_cllmh
253
254	SUBROUTINE compute_clt4D2(cldfra4D, clt4D2, d1, d2, d3, d4)
255	! Subroutine to compute the total cloudiness following 'newmicro.F90' from LMDZ from a 4D CLDFRA
256	! where zdim is the 2nd dimension (thus, cldfra4D(d1,d2,d3,d4) --> clt(d1,d3,d4)
257	! It should be properly done via an 'INTERFACE', but...
258
259	IMPLICIT NONE
260
261	INTEGER, INTENT(in) :: d1, d2, d3, d4
262	REAL(r_k), DIMENSION(d1,d2,d3,d4), INTENT(in) :: cldfra4D
263	REAL(r_k), DIMENSION(d1,d3,d4), INTENT(out) :: clt4D2
264
265	! Local
266	INTEGER :: i,j,k, zdim, Ndim
267
268	!!!!!!! Variables
269	! cldfra4D: 4D cloud fraction values [1]
270	! Ndim: number of dimensions of the input data
271	! d[1-4]: dimensions of 'cldfra4D'
272	! zdim: number of the vertical-dimension within the matrix
273	! clt4D2: total cloudiness for the 4D cldfra and d2 being 'zdim'
274
275	fname = 'compute_clt4D2'
276	zdim = 2
277	Ndim = 4
278
279	DO i=1, d1
280	DO j=1, d3
281	DO k=1, d4
282	clt4D2(i,j,k) = var_clt(cldfra4D(i,:,j,k), d2)
283	END DO
284	END DO
285	END DO
286
287	RETURN
288
289	END SUBROUTINE compute_clt4D2
290
291	SUBROUTINE compute_clt3D1(cldfra3D, clt3D1, d1, d2, d3)
292	! Subroutine to compute the total cloudiness following 'newmicro.F90' from LMDZ from a 3D CLDFRA
293	! where zdim is the 1st dimension (thus, cldfra4D(d1,d2,d3) --> clt(d2,d3)
294	! It should be properly done via an 'INTERFACE', but...
295
296	IMPLICIT NONE
297
298	INTEGER, INTENT(in) :: d1, d2, d3
299	REAL(r_k), DIMENSION(d1,d2,d3), INTENT(in) :: cldfra3D
300	REAL(r_k), DIMENSION(d2,d3), INTENT(out) :: clt3D1
301
302	! Local
303	INTEGER :: i,j,k, zdim, Ndim
304
305	!!!!!!! Variables
306	! cldfra3D: 3D cloud fraction values [1]
307	! Ndim: number of dimensions of the input data
308	! d[1-3]: dimensions of 'cldfra3D'
309	! zdim: number of the vertical-dimension within the matrix
310	! clt3D1: total cloudiness for the 3D cldfra and d1 being 'zdim'
311
312	fname = 'compute_clt3D1'
313	zdim = 1
314	Ndim = 3
315
316	DO i=1, d2
317	DO j=1, d3
318	clt3D1(i,j) = var_clt(cldfra3D(:,i,j), d1)
319	END DO
320	END DO
321
322	RETURN
323
324	END SUBROUTINE compute_clt3D1
325
326	SUBROUTINE compute_clt(cldfra1D, cldfra2D, cldfra3D, cldfra4D, Ndim, zdim, clt1D, clt2D1, clt2D2, &
327	clt3D1, clt3D2, clt3D3, clt4D1, clt4D2, clt4D3, clt4D4, d1, d2, d3, d4)
328	! Subroutine to compute the total cloudiness following 'newmicro.F90' from LMDZ
329
330	IMPLICIT NONE
331
332	INTEGER, INTENT(in) :: Ndim, d1, d2, d3, d4, zdim
333	REAL(r_k), DIMENSION(d1), OPTIONAL, INTENT(in) :: cldfra1D
334	REAL(r_k), DIMENSION(d1,d2), OPTIONAL, INTENT(in) :: cldfra2D
335	REAL(r_k), DIMENSION(d1,d2,d3), OPTIONAL, INTENT(in) :: cldfra3D
336	REAL(r_k), DIMENSION(d1,d2,d3,d4), OPTIONAL, &
337	INTENT(in) :: cldfra4D
338	REAL(r_k), OPTIONAL, INTENT(out) :: clt1D
339	REAL(r_k), DIMENSION(d1), OPTIONAL, INTENT(out) :: clt2D1
340	REAL(r_k), DIMENSION(d2), OPTIONAL, INTENT(out) :: clt2D2
341	REAL(r_k), DIMENSION(d2,d3), OPTIONAL, INTENT(out) :: clt3D1
342	REAL(r_k), DIMENSION(d1,d3), OPTIONAL, INTENT(out) :: clt3D2
343	REAL(r_k), DIMENSION(d1,d2), OPTIONAL, INTENT(out) :: clt3D3
344	REAL(r_k), DIMENSION(d2,d3,d4), OPTIONAL,INTENT(out) :: clt4D1
345	REAL(r_k), DIMENSION(d1,d3,d4), OPTIONAL,INTENT(out) :: clt4D2
346	REAL(r_k), DIMENSION(d1,d2,d4), OPTIONAL,INTENT(out) :: clt4D3
347	REAL(r_k), DIMENSION(d1,d2,d3), OPTIONAL,INTENT(out) :: clt4D4
348
349	! Local
350	INTEGER :: i,j,k
351
352	!!!!!!! Variables
353	! cldfra[1-4]D: cloud fraction values [1]
354	! Ndim: number of dimensions of the input data
355	! d[1-4]: dimensions of 'cldfra'
356	! zdim: number of the vertical-dimension within the matrix
357	! clt1D: total cloudiness for the 1D cldfra
358	! clt2D1: total cloudiness for the 2D cldfra and d1 being 'zdim'
359	! clt2D2: total cloudiness for the 2D cldfra and d2 being 'zdim'
360	! clt3D1: total cloudiness for the 3D cldfra and d1 being 'zdim'
361	! clt3D2: total cloudiness for the 3D cldfra and d2 being 'zdim'
362	! clt3D3: total cloudiness for the 3D cldfra and d3 being 'zdim'
363	! clt4D1: total cloudiness for the 4D cldfra and d1 being 'zdim'
364	! clt4D2: total cloudiness for the 4D cldfra and d2 being 'zdim'
365	! clt4D3: total cloudiness for the 4D cldfra and d3 being 'zdim'
366	! clt4D4: total cloudiness for the 4D cldfra and d4 being 'zdim'
367
368	fname = 'compute_clt'
369
370	SELECT CASE (Ndim)
371	CASE (1)
372	clt1D = var_clt(cldfra1D, d1)
373	CASE (2)
374	IF (zdim == 1) THEN
375	DO i=1, d2
376	clt2D1(i) = var_clt(cldfra2D(:,i), d1)
377	END DO
378	ELSE IF (zdim == 2) THEN
379	DO i=1, d1
380	clt2D2(i) = var_clt(cldfra2D(:,i), d2)
381	END DO
382	ELSE
383	PRINT *,TRIM(ErrWarnMsg('err'))
384	PRINT *,' ' // TRIM(fname) // ': wrong zdim:', zdim,' for Ndim=', Ndim, ' !!'
385	PRINT *,' accepted values: 1,2'
386	STOP
387	END IF
388	CASE (3)
389	IF (zdim == 1) THEN
390	DO i=1, d2
391	DO j=1, d3
392	clt3D1(i,j) = var_clt(cldfra3D(:,i,j), d1)
393	END DO
394	END DO
395	ELSE IF (zdim == 2) THEN
396	DO i=1, d1
397	DO j=1, d3
398	clt3D2(i,j) = var_clt(cldfra3D(i,:,j), d2)
399	END DO
400	END DO
401	ELSE IF (zdim == 3) THEN
402	DO i=1, d1
403	DO j=1, d2
404	clt3D3(i,j) = var_clt(cldfra3D(i,j,:), d3)
405	END DO
406	END DO
407	ELSE
408	PRINT *,TRIM(ErrWarnMsg('err'))
409	PRINT *,' ' // TRIM(fname) // ': wrong zdim:', zdim,' for Ndim=', Ndim, ' !!'
410	PRINT *,' accepted values: 1,2,3'
411	STOP
412	END IF
413	CASE (4)
414	IF (zdim == 1) THEN
415	DO i=1, d2
416	DO j=1, d3
417	DO k=1, d4
418	clt4D1(i,j,k) = var_clt(cldfra4D(:,i,j,k), d1)
419	END DO
420	END DO
421	END DO
422	ELSE IF (zdim == 2) THEN
423	DO i=1, d1
424	DO j=1, d3
425	DO k=1, d4
426	clt4D2(i,j,k) = var_clt(cldfra4D(i,:,j,k), d2)
427	END DO
428	END DO
429	END DO
430	ELSE IF (zdim == 3) THEN
431	DO i=1, d2
432	DO j=1, d3
433	DO k=1, d4
434	clt4D3(i,j,k) = var_clt(cldfra4D(i,j,:,k), d3)
435	END DO
436	END DO
437	END DO
438	ELSE IF (zdim == 4) THEN
439	DO i=1, d1
440	DO j=1, d2
441	DO k=1, d3
442	clt4D4(i,j,k) = var_clt(cldfra4D(i,j,k,:), d4)
443	END DO
444	END DO
445	END DO
446	ELSE
447	PRINT *,TRIM(ErrWarnMsg('err'))
448	PRINT *,' ' // TRIM(fname) // ': wrong zdim:', zdim,' for Ndim=', Ndim, ' !!'
449	PRINT *,' accepted values: 1,2,3,4'
450	STOP
451	END IF
452	CASE DEFAULT
453	PRINT *,TRIM(ErrWarnMsg('err'))
454	PRINT *,' ' // TRIM(fname) // ': Ndim:', Ndim,' not ready !!'
455	STOP
456	END SELECT
457
458	RETURN
459
460	END SUBROUTINE compute_clt
461
462	SUBROUTINE compute_massvertint1D(var, mutot, dz, deta, integral)
463	! Subroutine to vertically integrate a 1D variable in eta vertical coordinates
464
465	IMPLICIT NONE
466
467	INTEGER, INTENT(in) :: dz
468	REAL(r_k), INTENT(in) :: mutot
469	REAL(r_k), DIMENSION(dz), INTENT(in) :: var, deta
470	REAL(r_k), INTENT(out) :: integral
471
472	! Local
473	INTEGER :: k
474
475	!!!!!!! Variables
476	! var: vertical variable to integrate (assuming kgkg-1)
477	! mutot: total dry-air mass in column
478	! dz: vertical dimension
479	! deta: eta-levels difference between full eta-layers
480
481	fname = 'compute_massvertint1D'
482
483	! integral=0.
484	! DO k=1,dz
485	! integral = integral + var(k)*deta(k)
486	! END DO
487	integral = SUM(var*deta)
488
489	integral=integral*mutot/g
490
491	RETURN
492
493	END SUBROUTINE compute_massvertint1D
494
495	SUBROUTINE compute_zint4D(var4D, dlev, zweight, d1, d2, d3, d4, int3D)
496	! Subroutine to vertically integrate a 4D variable in any vertical coordinates
497
498	IMPLICIT NONE
499
500	INTEGER, INTENT(in) :: d1,d2,d3,d4
501	REAL(r_k), DIMENSION(d1,d2,d3,d4), INTENT(in) :: var4D, dlev, zweight
502	REAL(r_k), DIMENSION(d1,d2,d4), INTENT(out) :: int3D
503
504	! Local
505	INTEGER :: i,j,l
506
507	!!!!!!! Variables
508	! var4D: vertical variable to integrate
509	! dlev: height of layers
510	! zweight: weight for each level to be applied (=1. for no effect)
511
512	fname = 'compute_zint4D'
513
514	DO i=1,d1
515	DO j=1,d2
516	DO l=1,d4
517	CALL compute_vertint1D(var4D(i,j,:,l),d3, dlev(i,j,:,l), zweight(i,j,:,l), &
518	int3D(i,j,l))
519	END DO
520	END DO
521	END DO
522
523	RETURN
524
525	END SUBROUTINE compute_zint4D
526
527	SUBROUTINE compute_vertint1D(var, dz, deta, zweight, integral)
528	! Subroutine to vertically integrate a 1D variable in any vertical coordinates
529
530	IMPLICIT NONE
531
532	INTEGER, INTENT(in) :: dz
533	REAL(r_k), DIMENSION(dz), INTENT(in) :: var, deta, zweight
534	REAL(r_k), INTENT(out) :: integral
535
536	! Local
537	INTEGER :: k
538
539	!!!!!!! Variables
540	! var: vertical variable to integrate
541	! dz: vertical dimension
542	! deta: eta-levels difference between layers
543	! zweight: weight for each level to be applied (=1. for no effect)
544
545	fname = 'compute_vertint1D'
546
547	! integral=0.
548	! DO k=1,dz
549	! integral = integral + var(k)*deta(k)
550	! END DO
551	integral = SUM(vardetazweight)
552
553	RETURN
554
555	END SUBROUTINE compute_vertint1D
556
557	SUBROUTINE compute_cape_afwa4D(ta, hur, press, zg, hgt, cape, cin, zlfc, plfc, li, parcelmethod, &
558	d1, d2, d3, d4)
559	! Subroutine to use WRF phys/module_diag_afwa.F `buyoancy' subroutine to compute CAPE, CIN, ZLFC, PLFC, LI
560
561	IMPLICIT NONE
562
563	INTEGER, INTENT(in) :: d1, d2, d3, d4, parcelmethod
564	REAL(r_k), DIMENSION(d1,d2,d3,d4), INTENT(in) :: ta, hur, press, zg
565	REAL(r_k), DIMENSION(d1,d2), INTENT(in) :: hgt
566	REAL(r_k), DIMENSION(d1,d2,d4), INTENT(out) :: cape, cin, zlfc, plfc, li
567
568	! Local
569	INTEGER :: i, j, it
570	INTEGER :: ofunc
571
572	!!!!!!! Variables
573	! ta: air temperature [K]
574	! hur: relative humidity [%]
575	! press: air pressure [Pa]
576	! zg: geopotential height [gpm]
577	! hgt: topographical height [m]
578	! cape: Convective available potential energy [Jkg-1]
579	! cin: Convective inhibition [Jkg-1]
580	! zlfc: height at the Level of free convection [m]
581	! plfc: pressure at the Level of free convection [Pa]
582	! li: lifted index [1]
583	! parcelmethod:
584	! Most Unstable = 1 (default)
585	! Mean layer = 2
586	! Surface based = 3
587
588	fname = 'compute_cape_afwa4D'
589
590	DO i=1, d1
591	DO j=1, d2
592	DO it=1, d4
593	ofunc = var_cape_afwa1D(d3, ta(i,j,:,it), hur(i,j,:,it), press(i,j,:,it), zg(i,j,:,it), &
594	1, cape(i,j,it), cin(i,j,it), zlfc(i,j,it), plfc(i,j,it), li(i,j,it), parcelmethod)
595	zlfc(i,j,it) = zlfc(i,j,it)/g - hgt(i,j)
596	END DO
597	END DO
598	END DO
599
600	RETURN
601
602	END SUBROUTINE compute_cape_afwa4D
603
604	SUBROUTINE compute_zmla_generic4D(tpot, qratio, z, hgt, zmla3D, d1, d2, d3, d4)
605	! Subroutine to compute pbl-height following a generic method
606	! from Nielsen-Gammon et al., 2008 J. Appl. Meteor. Clim.
607	! applied also in Garcia-Diez et al., 2013, QJRMS
608	! where
609	! "The technique identifies the ML height as a threshold increase of potential temperature from
610	! its minimum value within the boundary layer."
611	! here applied similarly to Garcia-Diez et al. where
612	! zmla = "...first level where potential temperature exceeds the minimum potential temperature
613	! reached in the mixed layer by more than 1.5 K"
614
615	IMPLICIT NONE
616
617	INTEGER, INTENT(in) :: d1, d2, d3, d4
618	REAL(r_k), DIMENSION(d1,d2,d3,d4), INTENT(in) :: tpot, qratio, z
619	REAL(r_k), DIMENSION(d1,d2), INTENT(in) :: hgt
620	REAL(r_k), DIMENSION(d1,d2,d4), INTENT(out) :: zmla3D
621
622	! Local
623	INTEGER :: i, j, it
624
625	!!!!!!! Variables
626	! tpot: potential air temperature [K]
627	! qratio: water vapour mixing ratio [kgkg-1]
628	! z: height above sea level [m]
629	! hgt: terrain height [m]
630	! zmla3D: boundary layer height from surface [m]
631
632	fname = 'compute_zmla_generic4D'
633
634	DO i=1, d1
635	DO j=1, d2
636	DO it=1, d4
637	CALL var_zmla_generic(d3, qratio(i,j,:,it), tpot(i,j,:,it), z(i,j,:,it), hgt(i,j), &
638	zmla3D(i,j,it))
639	END DO
640	END DO
641	END DO
642
643	RETURN
644
645	END SUBROUTINE compute_zmla_generic4D
646
647	SUBROUTINE compute_zwind4D(ua, va, z, uas, vas, sina, cosa, zextrap, uaz, vaz, d1, d2, d3, d4)
648	! Subroutine to compute extrapolate the wind at a given height following the 'power law' methodology
649
650	IMPLICIT NONE
651
652	INTEGER, INTENT(in) :: d1, d2, d3, d4
653	REAL(r_k), DIMENSION(d1,d2,d3,d4), INTENT(in) :: ua, va, z
654	REAL(r_k), DIMENSION(d1,d2,d4), INTENT(in) :: uas, vas
655	REAL(r_k), DIMENSION(d1,d2), INTENT(in) :: sina, cosa
656	REAL(r_k), INTENT(in) :: zextrap
657	REAL(r_k), DIMENSION(d1,d2,d4), INTENT(out) :: uaz, vaz
658
659	! Local
660	INTEGER :: i, j, it
661
662	!!!!!!! Variables
663	! tpot: potential air temperature [K]
664	! qratio: water vapour mixing ratio [kgkg-1]
665	! z: height above surface [m]
666	! sina, cosa: local sine and cosine of map rotation [1.]
667	! zmla3D: boundary layer height from surface [m]
668
669	fname = 'compute_zwind4D'
670
671	DO i=1, d1
672	DO j=1, d2
673	DO it=1, d4
674	CALL var_zwind(d3, ua(i,j,:,it), va(i,j,:,it), z(i,j,:,it), uas(i,j,it), vas(i,j,it), &
675	sina(i,j), cosa(i,j), zextrap, uaz(i,j,it), vaz(i,j,it))
676	END DO
677	END DO
678	END DO
679
680	RETURN
681
682	END SUBROUTINE compute_zwind4D
683
684	SUBROUTINE compute_zwind_log4D(ua, va, z, uas, vas, sina, cosa, zextrap, uaz, vaz, d1, d2, d3, d4)
685	! Subroutine to compute extrapolate the wind at a given height following the 'logarithmic law' methodology
686
687	IMPLICIT NONE
688
689	INTEGER, INTENT(in) :: d1, d2, d3, d4
690	REAL(r_k), DIMENSION(d1,d2,d3,d4), INTENT(in) :: ua, va, z
691	REAL(r_k), DIMENSION(d1,d2,d4), INTENT(in) :: uas, vas
692	REAL(r_k), DIMENSION(d1,d2), INTENT(in) :: sina, cosa
693	REAL(r_k), INTENT(in) :: zextrap
694	REAL(r_k), DIMENSION(d1,d2,d4), INTENT(out) :: uaz, vaz
695
696	! Local
697	INTEGER :: i, j, it
698
699	!!!!!!! Variables
700	! tpot: potential air temperature [K]
701	! qratio: water vapour mixing ratio [kgkg-1]
702	! z: height above surface [m]
703	! sina, cosa: local sine and cosine of map rotation [1.]
704	! zmla3D: boundary layer height from surface [m]
705
706	fname = 'compute_zwind_log4D'
707
708	DO i=1, d1
709	DO j=1, d2
710	DO it=1, d4
711	CALL var_zwind_log(d3, ua(i,j,:,it), va(i,j,:,it), z(i,j,:,it), uas(i,j,it), vas(i,j,it), &
712	sina(i,j), cosa(i,j), zextrap, uaz(i,j,it), vaz(i,j,it))
713	END DO
714	END DO
715	END DO
716
717	RETURN
718
719	END SUBROUTINE compute_zwind_log4D
720
721	SUBROUTINE compute_zwindMO3D(d1, d2, d3, ust, znt, rmol, uas, vas, sina, cosa, newz, uznew, vznew)
722	! Subroutine to compute extrapolate the wind at a given height following the 'power law' methodology
723	! NOTE: only usefull for newz < 80. m
724
725	IMPLICIT NONE
726
727	INTEGER, INTENT(in) :: d1, d2, d3
728	REAL(r_k), DIMENSION(d1,d2,d3), INTENT(in) :: ust, znt, rmol
729	REAL(r_k), DIMENSION(d1,d2,d3), INTENT(in) :: uas, vas
730	REAL(r_k), DIMENSION(d1,d2), INTENT(in) :: sina, cosa
731	REAL(r_k), INTENT(in) :: newz
732	REAL(r_k), DIMENSION(d1,d2,d3), INTENT(out) :: uznew, vznew
733
734	! Local
735	INTEGER :: i, j, it
736
737	!!!!!!! Variables
738	! ust: u* in similarity theory [ms-1]
739	! znt: thermal time-varying roughness length [m]
740	! rmol: Inverse of the Obukhov length [m-1]
741	! uas: x-component 10-m wind speed [ms-1]
742	! vas: y-component 10-m wind speed [ms-1]
743	! sina, cosa: local sine and cosine of map rotation [1.]
744
745	fname = 'compute_zwindMO3D'
746
747	DO i=1, d1
748	DO j=1, d2
749	DO it=1, d3
750	CALL var_zwind_MOtheor(ust(i,j,it), znt(i,j,it), rmol(i,j,it), uas(i,j,it), vas(i,j,it), &
751	sina(i,j), cosa(i,j), newz, uznew(i,j,it), vznew(i,j,it))
752	END DO
753	END DO
754	END DO
755
756	RETURN
757
758	END SUBROUTINE compute_zwindMO3D
759
760	END MODULE module_ForDiagnostics

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

Download in other formats:

Original Format