Context Navigation

module_ForDiagnostics.F90 @ 772

Last change on this file since 772 was 772, checked in by lfita, 9 years ago
Using diagnostics with Fortran subroutines
File size: 17.1 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_generic
10	USE module_ForDiagnosticsVars
11
12	CONTAINS
13
14	!!!!!!! Calculations
15	! compute_cllmh4D3: Computation of low, medium and high cloudiness from a 4D CLDFRA and pressure being 3rd dimension the z-dim
16	! compute_cllmh3D3: Computation of low, medium and high cloudiness from a 3D CLDFRA and pressure being 3rd dimension the z-dim
17	! compute_cllmh: Computation of low, medium and high cloudiness
18	! compute_clt4D3: Computation of total cloudiness from a 4D CLDFRA being 3rd dimension the z-dim
19	! compute_clt3D3: Computation of total cloudiness from a 3D CLDFRA being 3rd dimension the z-dim
20	! compute_clt: Computation of total cloudiness
21
22	!!!
23	! Calculations
24	!!!
25
26	SUBROUTINE compute_cllmh4D2(cldfra4D, pres4D, cllmh4D2, d1, d2, d3, d4)
27	! Subroutine to compute the low, medium and high cloudiness following 'newmicro.F90' from LMDZ from a 4D CLDFRA and pressure
28	! where zdim is the 2nd dimension (thus, cldfra4D(d1,d2,d3,d4) --> cllmh(3,d1,d3,d4) 1: low, 2: medium, 3: high
29	! It should be properly done via an 'INTERFACE', but...
30
31	IMPLICIT NONE
32
33	INTEGER, PARAMETER :: r_k = KIND(1.d0)
34	REAL(r_k), DIMENSION(d1,d2,d3,d4), INTENT(in) :: cldfra4D, pres4D
35	INTEGER, INTENT(in) :: d1, d2, d3, d4
36	REAL(r_k), DIMENSION(3,d1,d3,d4), INTENT(out) :: cllmh4D2
37
38	! Local
39	INTEGER :: i,j,k, zdim, Ndim
40	CHARACTER(LEN=50) :: fname
41
42	!!!!!!! Variables
43	! cldfra4D: 4D cloud fraction values [1]
44	! pres4D: 4D pressure values [Pa]
45	! Ndim: number of dimensions of the input data
46	! d[1-4]: dimensions of 'cldfra4D'
47	! zdim: number of the vertical-dimension within the matrix
48	! cltlmh4D2: low, medium, high cloudiness for the 4D cldfra and d2 being 'zdim'
49
50	fname = 'compute_cllmh4D2'
51	zdim = 2
52	Ndim = 4
53
54	DO i=1, d1
55	DO j=1, d3
56	DO k=1, d4
57	cllmh4D2(:,i,j,k) = var_cllmh(cldfra4D(i,:,j,k), pres4D(i,:,j,k), d2)
58	END DO
59	END DO
60	END DO
61
62	RETURN
63
64	END SUBROUTINE compute_cllmh4D2
65
66	SUBROUTINE compute_cllmh3D1(cldfra3D, pres3D, cllmh3D1, d1, d2, d3)
67	! Subroutine to compute the low, medium and high cloudiness following 'newmicro.F90' from LMDZ from a 3D CLDFRA and pressure
68	! where zdim is the 1st dimension (thus, cldfra3D(d1,d2,d3) --> cllmh(3,d2,d3) 1: low, 2: medium, 3: high
69	! It should be properly done via an 'INTERFACE', but...
70
71	IMPLICIT NONE
72
73	INTEGER, PARAMETER :: r_k = KIND(1.d0)
74	REAL(r_k), DIMENSION(d1,d2,d3), INTENT(in) :: cldfra3D, pres3D
75	INTEGER, INTENT(in) :: d1, d2, d3
76	REAL(r_k), DIMENSION(3,d2,d3), INTENT(out) :: cllmh3D1
77
78	! Local
79	INTEGER :: i,j,k, zdim, Ndim
80	CHARACTER(LEN=50) :: fname
81
82	!!!!!!! Variables
83	! cldfra3D: 3D cloud fraction values [1]
84	! pres3D: 3D pressure values [Pa]
85	! Ndim: number of dimensions of the input data
86	! d[1-3]: dimensions of 'cldfra3D'
87	! zdim: number of the vertical-dimension within the matrix
88	! cltlmh3D1: low, medium, high cloudiness for the 3D cldfra and d1 being 'zdim'
89
90	fname = 'compute_cllmh3D1'
91	zdim = 1
92	Ndim = 3
93
94	DO i=1, d1
95	DO j=1, d2
96	cllmh3D1(:,i,j) = var_cllmh(cldfra3D(:,i,j), pres3D(:,i,j), d1)
97	END DO
98	END DO
99
100	RETURN
101
102	END SUBROUTINE compute_cllmh3D1
103
104	SUBROUTINE compute_cllmh(cldfra1D, cldfra2D, cldfra3D, cldfra4D, pres1D, pres2D, pres3D, pres4D, &
105	Ndim, zdim, cllmh1D, cllmh2D1, cllmh2D2, cllmh3D1, cllmh3D2, cllmh3D3, cllmh4D1, cllmh4D2, &
106	cllmh4D3, cllmh4D4, d1, d2, d3, d4)
107	! Subroutine to compute the low, medium and high cloudiness following 'newmicro.F90' from LMDZ
108
109	IMPLICIT NONE
110
111	INTEGER, PARAMETER :: r_k = KIND(1.d0)
112	REAL(r_k), DIMENSION(d1), OPTIONAL, INTENT(in) :: cldfra1D, pres1D
113	REAL(r_k), DIMENSION(d1,d2), OPTIONAL, INTENT(in) :: cldfra2D, pres2D
114	REAL(r_k), DIMENSION(d1,d2,d3), OPTIONAL, INTENT(in) :: cldfra3D, pres3D
115	REAL(r_k), DIMENSION(d1,d2,d3,d4), OPTIONAL, &
116	INTENT(in) :: cldfra4D, pres4D
117	INTEGER, INTENT(in) :: Ndim, d1, d2, d3, d4, zdim
118	REAL(r_k), DIMENSION(3), OPTIONAL, INTENT(out) :: cllmh1D
119	REAL(r_k), DIMENSION(d1,3), OPTIONAL, INTENT(out) :: cllmh2D1
120	REAL(r_k), DIMENSION(d2,3), OPTIONAL, INTENT(out) :: cllmh2D2
121	REAL(r_k), DIMENSION(d2,d3,3), OPTIONAL, INTENT(out) :: cllmh3D1
122	REAL(r_k), DIMENSION(d1,d3,3), OPTIONAL, INTENT(out) :: cllmh3D2
123	REAL(r_k), DIMENSION(d1,d2,3), OPTIONAL, INTENT(out) :: cllmh3D3
124	REAL(r_k), DIMENSION(d2,d3,d4,3), OPTIONAL, &
125	INTENT(out) :: cllmh4D1
126	REAL(r_k), DIMENSION(d1,d3,d4,3), OPTIONAL, &
127	INTENT(out) :: cllmh4D2
128	REAL(r_k), DIMENSION(d1,d2,d4,3), OPTIONAL, &
129	INTENT(out) :: cllmh4D3
130	REAL(r_k), DIMENSION(d1,d2,d3,3), OPTIONAL, &
131	INTENT(out) :: cllmh4D4
132
133	! Local
134	INTEGER :: i,j,k
135	CHARACTER(LEN=50) :: fname
136
137	!!!!!!! Variables
138	! cldfra[1-4]D: cloud fraction values [1]
139	! pres[1-4]D: pressure values [Pa]
140	! Ndim: number of dimensions of the input data
141	! d[1-4]: dimensions of 'cldfra'
142	! zdim: number of the vertical-dimension within the matrix
143	! cllmh1D: low, medium and high cloudiness for the 1D cldfra
144	! cllmh2D1: low, medium and high cloudiness for the 2D cldfra and d1 being 'zdim'
145	! cllmh2D2: low, medium and high cloudiness for the 2D cldfra and d2 being 'zdim'
146	! cllmh3D1: low, medium and high cloudiness for the 3D cldfra and d1 being 'zdim'
147	! cllmh3D2: low, medium and high cloudiness for the 3D cldfra and d2 being 'zdim'
148	! cllmh3D3: low, medium and high cloudiness for the 3D cldfra and d3 being 'zdim'
149	! cllmh4D1: low, medium and high cloudiness for the 4D cldfra and d1 being 'zdim'
150	! cllmh4D2: low, medium and high cloudiness for the 4D cldfra and d2 being 'zdim'
151	! cllmh4D3: low, medium and high cloudiness for the 4D cldfra and d3 being 'zdim'
152	! cllmh4D4: low, medium and high cloudiness for the 4D cldfra and d4 being 'zdim'
153
154	fname = 'compute_cllmh'
155
156	SELECT CASE (Ndim)
157	CASE (1)
158	cllmh1D = var_cllmh(cldfra1D, pres1D, d1)
159	CASE (2)
160	IF (zdim == 1) THEN
161	DO i=1, d2
162	cllmh2D1(i,:) = var_cllmh(cldfra2D(:,i), pres2D(:,i), d1)
163	END DO
164	ELSE IF (zdim == 2) THEN
165	DO i=1, d1
166	cllmh2D2(i,:) = var_cllmh(cldfra2D(:,i), pres2D(i,:), d2)
167	END DO
168	ELSE
169	PRINT *,TRIM(ErrWarnMsg('err'))
170	PRINT *,' ' // TRIM(fname) // ': wrong zdim:', zdim,' for Ndim=', Ndim, ' !!'
171	PRINT *,' accepted values: 1,2'
172	STOP
173	END IF
174	CASE (3)
175	IF (zdim == 1) THEN
176	DO i=1, d2
177	DO j=1, d3
178	cllmh3D1(i,j,:) = var_cllmh(cldfra3D(:,i,j), pres3D(:,i,j), d1)
179	END DO
180	END DO
181	ELSE IF (zdim == 2) THEN
182	DO i=1, d1
183	DO j=1, d3
184	cllmh3D2(i,j,:) = var_cllmh(cldfra3D(i,:,j), pres3D(i,:,j), d2)
185	END DO
186	END DO
187	ELSE IF (zdim == 3) THEN
188	DO i=1, d1
189	DO j=1, d2
190	cllmh3D3(i,j,:) = var_cllmh(cldfra3D(i,j,:), pres3D(i,j,:), d3)
191	END DO
192	END DO
193	ELSE
194	PRINT *,TRIM(ErrWarnMsg('err'))
195	PRINT *,' ' // TRIM(fname) // ': wrong zdim:', zdim,' for Ndim=', Ndim, ' !!'
196	PRINT *,' accepted values: 1,2,3'
197	STOP
198	END IF
199	CASE (4)
200	IF (zdim == 1) THEN
201	DO i=1, d2
202	DO j=1, d3
203	DO k=1, d4
204	cllmh4D1(i,j,k,:) = var_cllmh(cldfra4D(:,i,j,k), pres4D(:,i,j,k), d1)
205	END DO
206	END DO
207	END DO
208	ELSE IF (zdim == 2) THEN
209	DO i=1, d1
210	DO j=1, d3
211	DO k=1, d4
212	cllmh4D2(i,j,k,:) = var_cllmh(cldfra4D(i,:,j,k), pres4D(i,:,j,k), d2)
213	END DO
214	END DO
215	END DO
216	ELSE IF (zdim == 3) THEN
217	DO i=1, d2
218	DO j=1, d3
219	DO k=1, d4
220	cllmh4D3(i,j,k,:) = var_cllmh(cldfra4D(i,j,:,k), pres4D(i,j,:,k), d3)
221	END DO
222	END DO
223	END DO
224	ELSE IF (zdim == 4) THEN
225	DO i=1, d1
226	DO j=1, d2
227	DO k=1, d3
228	cllmh4D4(i,j,k,:) = var_cllmh(cldfra4D(i,j,k,:), pres4D(i,j,k,:), d4)
229	END DO
230	END DO
231	END DO
232	ELSE
233	PRINT *,TRIM(ErrWarnMsg('err'))
234	PRINT *,' ' // TRIM(fname) // ': wrong zdim:', zdim,' for Ndim=', Ndim, ' !!'
235	PRINT *,' accepted values: 1,2,3,4'
236	STOP
237	END IF
238	CASE DEFAULT
239	PRINT *,TRIM(ErrWarnMsg('err'))
240	PRINT *,' ' // TRIM(fname) // ': Ndim:', Ndim,' not ready !!'
241	STOP
242	END SELECT
243
244	RETURN
245
246	END SUBROUTINE compute_cllmh
247
248	SUBROUTINE compute_clt4D2(cldfra4D, clt4D2, d1, d2, d3, d4)
249	! Subroutine to compute the total cloudiness following 'newmicro.F90' from LMDZ from a 4D CLDFRA
250	! where zdim is the 2nd dimension (thus, cldfra4D(d1,d2,d3,d4) --> clt(d1,d3,d4)
251	! It should be properly done via an 'INTERFACE', but...
252
253	IMPLICIT NONE
254
255	INTEGER, PARAMETER :: r_k = KIND(1.d0)
256	REAL(r_k), DIMENSION(d1,d2,d3,d4), INTENT(in) :: cldfra4D
257	INTEGER, INTENT(in) :: d1, d2, d3, d4
258	REAL(r_k), DIMENSION(d1,d3,d4), INTENT(out) :: clt4D2
259
260	! Local
261	INTEGER :: i,j,k, zdim, Ndim
262	CHARACTER(LEN=50) :: fname
263
264	!!!!!!! Variables
265	! cldfra4D: 4D cloud fraction values [1]
266	! Ndim: number of dimensions of the input data
267	! d[1-4]: dimensions of 'cldfra4D'
268	! zdim: number of the vertical-dimension within the matrix
269	! clt4D2: total cloudiness for the 4D cldfra and d2 being 'zdim'
270
271	fname = 'compute_clt4D2'
272	zdim = 2
273	Ndim = 4
274
275	DO i=1, d1
276	DO j=1, d3
277	DO k=1, d4
278	clt4D2(i,j,k) = var_clt(cldfra4D(i,:,j,k), d2)
279	END DO
280	END DO
281	END DO
282
283	RETURN
284
285	END SUBROUTINE compute_clt4D2
286
287	SUBROUTINE compute_clt3D1(cldfra3D, clt3D1, d1, d2, d3)
288	! Subroutine to compute the total cloudiness following 'newmicro.F90' from LMDZ from a 3D CLDFRA
289	! where zdim is the 1st dimension (thus, cldfra4D(d1,d2,d3) --> clt(d2,d3)
290	! It should be properly done via an 'INTERFACE', but...
291
292	IMPLICIT NONE
293
294	INTEGER, PARAMETER :: r_k = KIND(1.d0)
295	REAL(r_k), DIMENSION(d1,d2,d3), INTENT(in) :: cldfra3D
296	INTEGER, INTENT(in) :: d1, d2, d3
297	REAL(r_k), DIMENSION(d2,d3), INTENT(out) :: clt3D1
298
299	! Local
300	INTEGER :: i,j,k, zdim, Ndim
301	CHARACTER(LEN=50) :: fname
302
303	!!!!!!! Variables
304	! cldfra3D: 3D cloud fraction values [1]
305	! Ndim: number of dimensions of the input data
306	! d[1-3]: dimensions of 'cldfra3D'
307	! zdim: number of the vertical-dimension within the matrix
308	! clt3D1: total cloudiness for the 3D cldfra and d1 being 'zdim'
309
310	fname = 'compute_clt3D1'
311	zdim = 1
312	Ndim = 3
313
314	DO i=1, d2
315	DO j=1, d3
316	clt3D1(i,j) = var_clt(cldfra3D(:,i,j), d1)
317	END DO
318	END DO
319
320	RETURN
321
322	END SUBROUTINE compute_clt3D1
323
324	SUBROUTINE compute_clt(cldfra1D, cldfra2D, cldfra3D, cldfra4D, Ndim, zdim, clt1D, clt2D1, clt2D2, &
325	clt3D1, clt3D2, clt3D3, clt4D1, clt4D2, clt4D3, clt4D4, d1, d2, d3, d4)
326	! Subroutine to compute the total cloudiness following 'newmicro.F90' from LMDZ
327
328	IMPLICIT NONE
329
330	INTEGER, PARAMETER :: r_k = KIND(1.d0)
331	REAL(r_k), DIMENSION(d1), OPTIONAL, INTENT(in) :: cldfra1D
332	REAL(r_k), DIMENSION(d1,d2), OPTIONAL, INTENT(in) :: cldfra2D
333	REAL(r_k), DIMENSION(d1,d2,d3), OPTIONAL, INTENT(in) :: cldfra3D
334	REAL(r_k), DIMENSION(d1,d2,d3,d4), OPTIONAL, &
335	INTENT(in) :: cldfra4D
336	INTEGER, INTENT(in) :: Ndim, d1, d2, d3, d4, zdim
337	REAL(r_k), OPTIONAL, INTENT(out) :: clt1D
338	REAL(r_k), DIMENSION(d1), OPTIONAL, INTENT(out) :: clt2D1
339	REAL(r_k), DIMENSION(d2), OPTIONAL, INTENT(out) :: clt2D2
340	REAL(r_k), DIMENSION(d2,d3), OPTIONAL, INTENT(out) :: clt3D1
341	REAL(r_k), DIMENSION(d1,d3), OPTIONAL, INTENT(out) :: clt3D2
342	REAL(r_k), DIMENSION(d1,d2), OPTIONAL, INTENT(out) :: clt3D3
343	REAL(r_k), DIMENSION(d2,d3,d4), OPTIONAL,INTENT(out) :: clt4D1
344	REAL(r_k), DIMENSION(d1,d3,d4), OPTIONAL,INTENT(out) :: clt4D2
345	REAL(r_k), DIMENSION(d1,d2,d4), OPTIONAL,INTENT(out) :: clt4D3
346	REAL(r_k), DIMENSION(d1,d2,d3), OPTIONAL,INTENT(out) :: clt4D4
347
348	! Local
349	INTEGER :: i,j,k
350	CHARACTER(LEN=50) :: fname
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	END MODULE module_ForDiagnostics

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

Download in other formats:

Original Format