Context Navigation

module_ForDiagnostics.f90 @ 1709

Last change on this file since 1709 was 1608, checked in by lfita, 8 years ago
Adding new Fortran capabilities after Rominas' DistriCorrection?
File size: 16.3 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_cllmh4D3: Computation of low, medium and high cloudiness from a 4D CLDFRA and pressure being 3rd dimension the z-dim
17	! compute_cllmh3D3: Computation of low, medium and high cloudiness from a 3D CLDFRA and pressure being 3rd dimension the z-dim
18	! compute_cllmh: Computation of low, medium and high cloudiness
19	! compute_clt4D3: Computation of total cloudiness from a 4D CLDFRA being 3rd dimension the z-dim
20	! compute_clt3D3: Computation of total cloudiness from a 3D CLDFRA being 3rd dimension the z-dim
21	! compute_clt: Computation of total cloudiness
22
23	!!!
24	! Calculations
25	!!!
26
27	SUBROUTINE compute_cllmh4D2(cldfra4D, pres4D, cllmh4D2, d1, d2, d3, d4)
28	! Subroutine to compute the low, medium and high cloudiness following 'newmicro.F90' from LMDZ from a 4D CLDFRA and pressure
29	! where zdim is the 2nd dimension (thus, cldfra4D(d1,d2,d3,d4) --> cllmh(3,d1,d3,d4) 1: low, 2: medium, 3: high
30	! It should be properly done via an 'INTERFACE', but...
31
32	IMPLICIT NONE
33
34	INTEGER, INTENT(in) :: d1, d2, d3, d4
35	REAL(r_k), DIMENSION(d1,d2,d3,d4), INTENT(in) :: cldfra4D, pres4D
36	REAL(r_k), DIMENSION(3,d1,d3,d4), INTENT(out) :: cllmh4D2
37
38	! Local
39	INTEGER :: i,j,k, zdim, Ndim
40
41	!!!!!!! Variables
42	! cldfra4D: 4D cloud fraction values [1]
43	! pres4D: 4D pressure values [Pa]
44	! Ndim: number of dimensions of the input data
45	! d[1-4]: dimensions of 'cldfra4D'
46	! zdim: number of the vertical-dimension within the matrix
47	! cltlmh4D2: low, medium, high cloudiness for the 4D cldfra and d2 being 'zdim'
48
49	fname = 'compute_cllmh4D2'
50	zdim = 2
51	Ndim = 4
52
53	DO i=1, d1
54	DO j=1, d3
55	DO k=1, d4
56	cllmh4D2(:,i,j,k) = var_cllmh(cldfra4D(i,:,j,k), pres4D(i,:,j,k), d2)
57	END DO
58	END DO
59	END DO
60
61	RETURN
62
63	END SUBROUTINE compute_cllmh4D2
64
65	SUBROUTINE compute_cllmh3D1(cldfra3D, pres3D, cllmh3D1, d1, d2, d3)
66	! Subroutine to compute the low, medium and high cloudiness following 'newmicro.F90' from LMDZ from a 3D CLDFRA and pressure
67	! where zdim is the 1st dimension (thus, cldfra3D(d1,d2,d3) --> cllmh(3,d2,d3) 1: low, 2: medium, 3: high
68	! It should be properly done via an 'INTERFACE', but...
69
70	IMPLICIT NONE
71
72	INTEGER, INTENT(in) :: d1, d2, d3
73	REAL(r_k), DIMENSION(d1,d2,d3), INTENT(in) :: cldfra3D, pres3D
74	REAL(r_k), DIMENSION(3,d2,d3), INTENT(out) :: cllmh3D1
75
76	! Local
77	INTEGER :: i,j,k, zdim, Ndim
78
79	!!!!!!! Variables
80	! cldfra3D: 3D cloud fraction values [1]
81	! pres3D: 3D pressure values [Pa]
82	! Ndim: number of dimensions of the input data
83	! d[1-3]: dimensions of 'cldfra3D'
84	! zdim: number of the vertical-dimension within the matrix
85	! cltlmh3D1: low, medium, high cloudiness for the 3D cldfra and d1 being 'zdim'
86
87	fname = 'compute_cllmh3D1'
88	zdim = 1
89	Ndim = 3
90
91	DO i=1, d1
92	DO j=1, d2
93	cllmh3D1(:,i,j) = var_cllmh(cldfra3D(:,i,j), pres3D(:,i,j), d1)
94	END DO
95	END DO
96
97	RETURN
98
99	END SUBROUTINE compute_cllmh3D1
100
101	SUBROUTINE compute_cllmh(cldfra1D, cldfra2D, cldfra3D, cldfra4D, pres1D, pres2D, pres3D, pres4D, &
102	Ndim, zdim, cllmh1D, cllmh2D1, cllmh2D2, cllmh3D1, cllmh3D2, cllmh3D3, cllmh4D1, cllmh4D2, &
103	cllmh4D3, cllmh4D4, d1, d2, d3, d4)
104	! Subroutine to compute the low, medium and high cloudiness following 'newmicro.F90' from LMDZ
105
106	IMPLICIT NONE
107
108	INTEGER, INTENT(in) :: Ndim, d1, d2, d3, d4, zdim
109	REAL(r_k), DIMENSION(d1), OPTIONAL, INTENT(in) :: cldfra1D, pres1D
110	REAL(r_k), DIMENSION(d1,d2), OPTIONAL, INTENT(in) :: cldfra2D, pres2D
111	REAL(r_k), DIMENSION(d1,d2,d3), OPTIONAL, INTENT(in) :: cldfra3D, pres3D
112	REAL(r_k), DIMENSION(d1,d2,d3,d4), OPTIONAL, &
113	INTENT(in) :: cldfra4D, pres4D
114	REAL(r_k), DIMENSION(3), OPTIONAL, INTENT(out) :: cllmh1D
115	REAL(r_k), DIMENSION(d1,3), OPTIONAL, INTENT(out) :: cllmh2D1
116	REAL(r_k), DIMENSION(d2,3), OPTIONAL, INTENT(out) :: cllmh2D2
117	REAL(r_k), DIMENSION(d2,d3,3), OPTIONAL, INTENT(out) :: cllmh3D1
118	REAL(r_k), DIMENSION(d1,d3,3), OPTIONAL, INTENT(out) :: cllmh3D2
119	REAL(r_k), DIMENSION(d1,d2,3), OPTIONAL, INTENT(out) :: cllmh3D3
120	REAL(r_k), DIMENSION(d2,d3,d4,3), OPTIONAL, &
121	INTENT(out) :: cllmh4D1
122	REAL(r_k), DIMENSION(d1,d3,d4,3), OPTIONAL, &
123	INTENT(out) :: cllmh4D2
124	REAL(r_k), DIMENSION(d1,d2,d4,3), OPTIONAL, &
125	INTENT(out) :: cllmh4D3
126	REAL(r_k), DIMENSION(d1,d2,d3,3), OPTIONAL, &
127	INTENT(out) :: cllmh4D4
128
129	! Local
130	INTEGER :: i,j,k
131
132	!!!!!!! Variables
133	! cldfra[1-4]D: cloud fraction values [1]
134	! pres[1-4]D: pressure values [Pa]
135	! Ndim: number of dimensions of the input data
136	! d[1-4]: dimensions of 'cldfra'
137	! zdim: number of the vertical-dimension within the matrix
138	! cllmh1D: low, medium and high cloudiness for the 1D cldfra
139	! cllmh2D1: low, medium and high cloudiness for the 2D cldfra and d1 being 'zdim'
140	! cllmh2D2: low, medium and high cloudiness for the 2D cldfra and d2 being 'zdim'
141	! cllmh3D1: low, medium and high cloudiness for the 3D cldfra and d1 being 'zdim'
142	! cllmh3D2: low, medium and high cloudiness for the 3D cldfra and d2 being 'zdim'
143	! cllmh3D3: low, medium and high cloudiness for the 3D cldfra and d3 being 'zdim'
144	! cllmh4D1: low, medium and high cloudiness for the 4D cldfra and d1 being 'zdim'
145	! cllmh4D2: low, medium and high cloudiness for the 4D cldfra and d2 being 'zdim'
146	! cllmh4D3: low, medium and high cloudiness for the 4D cldfra and d3 being 'zdim'
147	! cllmh4D4: low, medium and high cloudiness for the 4D cldfra and d4 being 'zdim'
148
149	fname = 'compute_cllmh'
150
151	SELECT CASE (Ndim)
152	CASE (1)
153	cllmh1D = var_cllmh(cldfra1D, pres1D, d1)
154	CASE (2)
155	IF (zdim == 1) THEN
156	DO i=1, d2
157	cllmh2D1(i,:) = var_cllmh(cldfra2D(:,i), pres2D(:,i), d1)
158	END DO
159	ELSE IF (zdim == 2) THEN
160	DO i=1, d1
161	cllmh2D2(i,:) = var_cllmh(cldfra2D(:,i), pres2D(i,:), d2)
162	END DO
163	ELSE
164	PRINT *,TRIM(ErrWarnMsg('err'))
165	PRINT *,' ' // TRIM(fname) // ': wrong zdim:', zdim,' for Ndim=', Ndim, ' !!'
166	PRINT *,' accepted values: 1,2'
167	STOP
168	END IF
169	CASE (3)
170	IF (zdim == 1) THEN
171	DO i=1, d2
172	DO j=1, d3
173	cllmh3D1(i,j,:) = var_cllmh(cldfra3D(:,i,j), pres3D(:,i,j), d1)
174	END DO
175	END DO
176	ELSE IF (zdim == 2) THEN
177	DO i=1, d1
178	DO j=1, d3
179	cllmh3D2(i,j,:) = var_cllmh(cldfra3D(i,:,j), pres3D(i,:,j), d2)
180	END DO
181	END DO
182	ELSE IF (zdim == 3) THEN
183	DO i=1, d1
184	DO j=1, d2
185	cllmh3D3(i,j,:) = var_cllmh(cldfra3D(i,j,:), pres3D(i,j,:), d3)
186	END DO
187	END DO
188	ELSE
189	PRINT *,TRIM(ErrWarnMsg('err'))
190	PRINT *,' ' // TRIM(fname) // ': wrong zdim:', zdim,' for Ndim=', Ndim, ' !!'
191	PRINT *,' accepted values: 1,2,3'
192	STOP
193	END IF
194	CASE (4)
195	IF (zdim == 1) THEN
196	DO i=1, d2
197	DO j=1, d3
198	DO k=1, d4
199	cllmh4D1(i,j,k,:) = var_cllmh(cldfra4D(:,i,j,k), pres4D(:,i,j,k), d1)
200	END DO
201	END DO
202	END DO
203	ELSE IF (zdim == 2) THEN
204	DO i=1, d1
205	DO j=1, d3
206	DO k=1, d4
207	cllmh4D2(i,j,k,:) = var_cllmh(cldfra4D(i,:,j,k), pres4D(i,:,j,k), d2)
208	END DO
209	END DO
210	END DO
211	ELSE IF (zdim == 3) THEN
212	DO i=1, d2
213	DO j=1, d3
214	DO k=1, d4
215	cllmh4D3(i,j,k,:) = var_cllmh(cldfra4D(i,j,:,k), pres4D(i,j,:,k), d3)
216	END DO
217	END DO
218	END DO
219	ELSE IF (zdim == 4) THEN
220	DO i=1, d1
221	DO j=1, d2
222	DO k=1, d3
223	cllmh4D4(i,j,k,:) = var_cllmh(cldfra4D(i,j,k,:), pres4D(i,j,k,:), d4)
224	END DO
225	END DO
226	END DO
227	ELSE
228	PRINT *,TRIM(ErrWarnMsg('err'))
229	PRINT *,' ' // TRIM(fname) // ': wrong zdim:', zdim,' for Ndim=', Ndim, ' !!'
230	PRINT *,' accepted values: 1,2,3,4'
231	STOP
232	END IF
233	CASE DEFAULT
234	PRINT *,TRIM(ErrWarnMsg('err'))
235	PRINT *,' ' // TRIM(fname) // ': Ndim:', Ndim,' not ready !!'
236	STOP
237	END SELECT
238
239	RETURN
240
241	END SUBROUTINE compute_cllmh
242
243	SUBROUTINE compute_clt4D2(cldfra4D, clt4D2, d1, d2, d3, d4)
244	! Subroutine to compute the total cloudiness following 'newmicro.F90' from LMDZ from a 4D CLDFRA
245	! where zdim is the 2nd dimension (thus, cldfra4D(d1,d2,d3,d4) --> clt(d1,d3,d4)
246	! It should be properly done via an 'INTERFACE', but...
247
248	IMPLICIT NONE
249
250	INTEGER, INTENT(in) :: d1, d2, d3, d4
251	REAL(r_k), DIMENSION(d1,d2,d3,d4), INTENT(in) :: cldfra4D
252	REAL(r_k), DIMENSION(d1,d3,d4), INTENT(out) :: clt4D2
253
254	! Local
255	INTEGER :: i,j,k, zdim, Ndim
256
257	!!!!!!! Variables
258	! cldfra4D: 4D cloud fraction values [1]
259	! Ndim: number of dimensions of the input data
260	! d[1-4]: dimensions of 'cldfra4D'
261	! zdim: number of the vertical-dimension within the matrix
262	! clt4D2: total cloudiness for the 4D cldfra and d2 being 'zdim'
263
264	fname = 'compute_clt4D2'
265	zdim = 2
266	Ndim = 4
267
268	DO i=1, d1
269	DO j=1, d3
270	DO k=1, d4
271	clt4D2(i,j,k) = var_clt(cldfra4D(i,:,j,k), d2)
272	END DO
273	END DO
274	END DO
275
276	RETURN
277
278	END SUBROUTINE compute_clt4D2
279
280	SUBROUTINE compute_clt3D1(cldfra3D, clt3D1, d1, d2, d3)
281	! Subroutine to compute the total cloudiness following 'newmicro.F90' from LMDZ from a 3D CLDFRA
282	! where zdim is the 1st dimension (thus, cldfra4D(d1,d2,d3) --> clt(d2,d3)
283	! It should be properly done via an 'INTERFACE', but...
284
285	IMPLICIT NONE
286
287	INTEGER, INTENT(in) :: d1, d2, d3
288	REAL(r_k), DIMENSION(d1,d2,d3), INTENT(in) :: cldfra3D
289	REAL(r_k), DIMENSION(d2,d3), INTENT(out) :: clt3D1
290
291	! Local
292	INTEGER :: i,j,k, zdim, Ndim
293
294	!!!!!!! Variables
295	! cldfra3D: 3D cloud fraction values [1]
296	! Ndim: number of dimensions of the input data
297	! d[1-3]: dimensions of 'cldfra3D'
298	! zdim: number of the vertical-dimension within the matrix
299	! clt3D1: total cloudiness for the 3D cldfra and d1 being 'zdim'
300
301	fname = 'compute_clt3D1'
302	zdim = 1
303	Ndim = 3
304
305	DO i=1, d2
306	DO j=1, d3
307	clt3D1(i,j) = var_clt(cldfra3D(:,i,j), d1)
308	END DO
309	END DO
310
311	RETURN
312
313	END SUBROUTINE compute_clt3D1
314
315	SUBROUTINE compute_clt(cldfra1D, cldfra2D, cldfra3D, cldfra4D, Ndim, zdim, clt1D, clt2D1, clt2D2, &
316	clt3D1, clt3D2, clt3D3, clt4D1, clt4D2, clt4D3, clt4D4, d1, d2, d3, d4)
317	! Subroutine to compute the total cloudiness following 'newmicro.F90' from LMDZ
318
319	IMPLICIT NONE
320
321	INTEGER, INTENT(in) :: Ndim, d1, d2, d3, d4, zdim
322	REAL(r_k), DIMENSION(d1), OPTIONAL, INTENT(in) :: cldfra1D
323	REAL(r_k), DIMENSION(d1,d2), OPTIONAL, INTENT(in) :: cldfra2D
324	REAL(r_k), DIMENSION(d1,d2,d3), OPTIONAL, INTENT(in) :: cldfra3D
325	REAL(r_k), DIMENSION(d1,d2,d3,d4), OPTIONAL, &
326	INTENT(in) :: cldfra4D
327	REAL(r_k), OPTIONAL, INTENT(out) :: clt1D
328	REAL(r_k), DIMENSION(d1), OPTIONAL, INTENT(out) :: clt2D1
329	REAL(r_k), DIMENSION(d2), OPTIONAL, INTENT(out) :: clt2D2
330	REAL(r_k), DIMENSION(d2,d3), OPTIONAL, INTENT(out) :: clt3D1
331	REAL(r_k), DIMENSION(d1,d3), OPTIONAL, INTENT(out) :: clt3D2
332	REAL(r_k), DIMENSION(d1,d2), OPTIONAL, INTENT(out) :: clt3D3
333	REAL(r_k), DIMENSION(d2,d3,d4), OPTIONAL,INTENT(out) :: clt4D1
334	REAL(r_k), DIMENSION(d1,d3,d4), OPTIONAL,INTENT(out) :: clt4D2
335	REAL(r_k), DIMENSION(d1,d2,d4), OPTIONAL,INTENT(out) :: clt4D3
336	REAL(r_k), DIMENSION(d1,d2,d3), OPTIONAL,INTENT(out) :: clt4D4
337
338	! Local
339	INTEGER :: i,j,k
340
341	!!!!!!! Variables
342	! cldfra[1-4]D: cloud fraction values [1]
343	! Ndim: number of dimensions of the input data
344	! d[1-4]: dimensions of 'cldfra'
345	! zdim: number of the vertical-dimension within the matrix
346	! clt1D: total cloudiness for the 1D cldfra
347	! clt2D1: total cloudiness for the 2D cldfra and d1 being 'zdim'
348	! clt2D2: total cloudiness for the 2D cldfra and d2 being 'zdim'
349	! clt3D1: total cloudiness for the 3D cldfra and d1 being 'zdim'
350	! clt3D2: total cloudiness for the 3D cldfra and d2 being 'zdim'
351	! clt3D3: total cloudiness for the 3D cldfra and d3 being 'zdim'
352	! clt4D1: total cloudiness for the 4D cldfra and d1 being 'zdim'
353	! clt4D2: total cloudiness for the 4D cldfra and d2 being 'zdim'
354	! clt4D3: total cloudiness for the 4D cldfra and d3 being 'zdim'
355	! clt4D4: total cloudiness for the 4D cldfra and d4 being 'zdim'
356
357	fname = 'compute_clt'
358
359	SELECT CASE (Ndim)
360	CASE (1)
361	clt1D = var_clt(cldfra1D, d1)
362	CASE (2)
363	IF (zdim == 1) THEN
364	DO i=1, d2
365	clt2D1(i) = var_clt(cldfra2D(:,i), d1)
366	END DO
367	ELSE IF (zdim == 2) THEN
368	DO i=1, d1
369	clt2D2(i) = var_clt(cldfra2D(:,i), d2)
370	END DO
371	ELSE
372	PRINT *,TRIM(ErrWarnMsg('err'))
373	PRINT *,' ' // TRIM(fname) // ': wrong zdim:', zdim,' for Ndim=', Ndim, ' !!'
374	PRINT *,' accepted values: 1,2'
375	STOP
376	END IF
377	CASE (3)
378	IF (zdim == 1) THEN
379	DO i=1, d2
380	DO j=1, d3
381	clt3D1(i,j) = var_clt(cldfra3D(:,i,j), d1)
382	END DO
383	END DO
384	ELSE IF (zdim == 2) THEN
385	DO i=1, d1
386	DO j=1, d3
387	clt3D2(i,j) = var_clt(cldfra3D(i,:,j), d2)
388	END DO
389	END DO
390	ELSE IF (zdim == 3) THEN
391	DO i=1, d1
392	DO j=1, d2
393	clt3D3(i,j) = var_clt(cldfra3D(i,j,:), d3)
394	END DO
395	END DO
396	ELSE
397	PRINT *,TRIM(ErrWarnMsg('err'))
398	PRINT *,' ' // TRIM(fname) // ': wrong zdim:', zdim,' for Ndim=', Ndim, ' !!'
399	PRINT *,' accepted values: 1,2,3'
400	STOP
401	END IF
402	CASE (4)
403	IF (zdim == 1) THEN
404	DO i=1, d2
405	DO j=1, d3
406	DO k=1, d4
407	clt4D1(i,j,k) = var_clt(cldfra4D(:,i,j,k), d1)
408	END DO
409	END DO
410	END DO
411	ELSE IF (zdim == 2) THEN
412	DO i=1, d1
413	DO j=1, d3
414	DO k=1, d4
415	clt4D2(i,j,k) = var_clt(cldfra4D(i,:,j,k), d2)
416	END DO
417	END DO
418	END DO
419	ELSE IF (zdim == 3) THEN
420	DO i=1, d2
421	DO j=1, d3
422	DO k=1, d4
423	clt4D3(i,j,k) = var_clt(cldfra4D(i,j,:,k), d3)
424	END DO
425	END DO
426	END DO
427	ELSE IF (zdim == 4) THEN
428	DO i=1, d1
429	DO j=1, d2
430	DO k=1, d3
431	clt4D4(i,j,k) = var_clt(cldfra4D(i,j,k,:), d4)
432	END DO
433	END DO
434	END DO
435	ELSE
436	PRINT *,TRIM(ErrWarnMsg('err'))
437	PRINT *,' ' // TRIM(fname) // ': wrong zdim:', zdim,' for Ndim=', Ndim, ' !!'
438	PRINT *,' accepted values: 1,2,3,4'
439	STOP
440	END IF
441	CASE DEFAULT
442	PRINT *,TRIM(ErrWarnMsg('err'))
443	PRINT *,' ' // TRIM(fname) // ': Ndim:', Ndim,' not ready !!'
444	STOP
445	END SELECT
446
447	RETURN
448
449	END SUBROUTINE compute_clt
450
451	END MODULE module_ForDiagnostics

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

Download in other formats:

Original Format