Context Navigation

module_ForDiagnostics.F90 @ 770

Last change on this file since 770 was 770, checked in by lfita, 9 years ago
Adding Fortran-based diagnostics (to improve efficency!)
File size: 8.1 KB

Line
1	!! Fortran version of different diagnostics
2	! L. Fita. LMD May 2016
3	! gfortran module_generic.o -c module_ForDiagnostics.F90
4	MODULE module_ForDiagnostics
5
6	USE module_generic
7
8	IMPLICIT NONE
9
10	INTEGER, PARAMETER :: r_k = KIND(1.d0)
11	REAL(r_k), PARAMETER :: ZEPSEC=1.0D-12
12	! Low limit pressure for medium clouds [Pa]
13	REAL(r_k), PARAMETER :: prmhc = 44000.d0
14	! Low limit pressure for High clouds [Pa]
15	REAL(r_k), PARAMETER :: prmlc = 68000.d0
16
17	REAL(r_k), PARAMETER :: zero=0.d0
18	REAL(r_k), PARAMETER :: one=1.d0
19	REAL(r_k), PARAMETER :: two=2.d0
20
21	CONTAINS
22
23	!!!!!!! Variables
24	! var_clt: total cloudiness [1,0]
25
26
27	!!!!!!! Calculations
28	! compute_clt: Computation of total cloudiness
29
30	!!!
31	! Variables
32	!!!
33
34
35	REAL(r_k), FUNCTION var_cllmh(clfra, p, dz):
36	! Function to compute cllmh on a 1D column
37
38	IMPLICIT NONE
39
40	INTEGER, INTENT(in) :: dz
41	REAL(r_k), DIMENSION(dz), INTENT(in) :: clfra, p
42
43	! Local
44	INTEGER :: iz
45	CHARACTER(LEN=50) :: fname
46	REAL(r_k) :: zclearl, zcloudl, zclearm, zcloudm, &
47	zclearh, zcloudh
48
49	!!!!!!! Variables
50	! clfra: cloudfraction as 1D verical-column [1]
51	! p: pressure values of the column
52	fname = 'var_cllmh'
53
54	zclearl = one
55	zcloudl = zero
56	zclearm = one
57	zcloudm = zero
58	zclearh = one
59	zcloudh = zero
60
61	DO iz=1, dz
62	IF (p(iz) < prmhc) THEN
63	cllmh(2) = cllmh(2)*(one-MAX(clfra(iz), zcloudh))/(one-MIN(zcloudh,one-ZEPSEC))
64	zcloudh = clfra(iz)
65	ELSE IF ( (p(iz) >= prmhc).AND.(p(iz) < prmlc)) ) THEN
66	cllmh[1] = cllmh[1]*(1.-np.max([cfra[iz], zcloudm]))/(1.- \
67	np.min([zcloudm,1.-ZEPSEC]))
68	zcloudm = cfra[iz]
69	elif p[iz] >= prmlc:
70	cllmh[0] = cllmh[0]*(1.-np.max([cfra[iz], zcloudl]))/(1.- \
71	np.min([zcloudl,1.-ZEPSEC]))
72	zcloudl = cfra[iz]
73
74	cllmh = 1.- cllmh
75
76	RETURN
77
78	END FUNCTION var_clmh
79
80	REAL(r_k) FUNCTION var_clt(clfra, dz)
81	! Function to compute the total cloud fraction following 'newmicro.F90' from LMDZ using 1D vertical
82	! column values
83
84	IMPLICIT NONE
85
86	REAL(r_k), DIMENSION(dz), INTENT(in) :: clfra
87	INTEGER, INTENT(in) :: dz
88	! Local
89	INTEGER :: iz
90	REAL(r_k) :: zclear, zcloud
91	CHARACTER(LEN=50) :: fname
92	!!!!!!! Variables
93	! cfra: 1-column cloud fraction values
94
95	fname = 'var_clt'
96
97	zclear = one
98	zcloud = zero
99
100	DO iz=1,dz
101	zclear = zclear*(one-MAX(clfra(iz),zcloud))/(one-MIN(zcloud,1.-ZEPSEC))
102	var_clt = one - zclear
103	zcloud = clfra(iz)
104	END DO
105
106	RETURN
107
108	END FUNCTION var_clt
109
110	!!!
111	! Calculations
112	!!!
113
114	SUBROUTINE compute_clt(cldfra1D, cldfra2D, cldfra3D, cldfra4D, Ndim, d1, d2, d3, d4, zdim, clt1D, &
115	clt2D1, clt2D2, clt3D1, clt3D2, clt3D3, clt4D1, clt4D2, clt4D3, clt4D4)
116	! Subroutine to compute the total cloud fraction following 'newmicro.F90' from LMDZ
117
118	IMPLICIT NONE
119
120	REAL(r_k), DIMENSION(d1), OPTIONAL, INTENT(in) :: cldfra1D
121	REAL(r_k), DIMENSION(d1,d2), OPTIONAL, INTENT(in) :: cldfra2D
122	REAL(r_k), DIMENSION(d1,d2,d3), OPTIONAL, INTENT(in) :: cldfra3D
123	REAL(r_k), DIMENSION(d1,d2,d3,d4), OPTIONAL, &
124	INTENT(in) :: cldfra4D
125	INTEGER, INTENT(in) :: Ndim, d1, d2, d3, d4, zdim
126	REAL(r_k), OPTIONAL, INTENT(out) :: clt1D
127	REAL(r_k), DIMENSION(d1), OPTIONAL, INTENT(out) :: clt2D1
128	REAL(r_k), DIMENSION(d2), OPTIONAL, INTENT(out) :: clt2D2
129	REAL(r_k), DIMENSION(d2,d3), OPTIONAL, INTENT(out) :: clt3D1
130	REAL(r_k), DIMENSION(d1,d3), OPTIONAL, INTENT(out) :: clt3D2
131	REAL(r_k), DIMENSION(d1,d2), OPTIONAL, INTENT(out) :: clt3D3
132	REAL(r_k), DIMENSION(d2,d3,d4), OPTIONAL,INTENT(out) :: clt4D1
133	REAL(r_k), DIMENSION(d1,d3,d4), OPTIONAL,INTENT(out) :: clt4D2
134	REAL(r_k), DIMENSION(d1,d2,d4), OPTIONAL,INTENT(out) :: clt4D3
135	REAL(r_k), DIMENSION(d1,d2,d3), OPTIONAL,INTENT(out) :: clt4D4
136
137	! Local
138	INTEGER :: i,j,k
139	REAL(r_k) :: var_clt
140	CHARACTER(LEN=50) :: fname
141
142	!!!!!!! Variables
143	! cldfra[1-4]D: cloud fraction values [1]
144	! Ndim: number of dimensions of the input data
145	! d[1-4]: dimensions of 'cldfra'
146	! zdim: number of the vertical-dimension within the matrix
147	! clt1D: total cloudiness for the 1D cldfra
148	! clt2D1: total cloudiness for the 2D cldfra and d1 being 'zdim'
149	! clt2D2: total cloudiness for the 2D cldfra and d2 being 'zdim'
150	! clt3D1: total cloudiness for the 3D cldfra and d1 being 'zdim'
151	! clt3D2: total cloudiness for the 3D cldfra and d2 being 'zdim'
152	! clt3D3: total cloudiness for the 3D cldfra and d3 being 'zdim'
153	! clt4D1: total cloudiness for the 4D cldfra and d1 being 'zdim'
154	! clt4D2: total cloudiness for the 4D cldfra and d2 being 'zdim'
155	! clt4D3: total cloudiness for the 4D cldfra and d3 being 'zdim'
156	! clt4D4: total cloudiness for the 4D cldfra and d4 being 'zdim'
157
158	fname = 'compute_clt'
159
160	SELECT CASE (Ndim)
161	CASE (1)
162	clt1D = var_clt(cldfra1D, d1)
163	CASE (2)
164	IF (zdim == 1) THEN
165	DO i=1, d2
166	clt2D1(i) = var_clt(cldfra2D(:,i), d1)
167	END DO
168	ELSE IF (zdim == 2) THEN
169	DO i=1, d1
170	clt2D2(i) = var_clt(cldfra2D(:,i), d2)
171	END DO
172	ELSE
173	PRINT *,TRIM(ErrWarnMsg('err'))
174	PRINT *,' ' // TRIM(fname) // ': wrong zdim:', zdim,' for Ndim=', Ndim, ' !!'
175	PRINT *,' accepted values: 1,2'
176	STOP
177	END IF
178	CASE (3)
179	IF (zdim == 1) THEN
180	DO i=1, d2
181	DO j=1, d3
182	clt3D1(i,j) = var_clt(cldfra3D(:,i,j), d1)
183	END DO
184	END DO
185	ELSE IF (zdim == 2) THEN
186	DO i=1, d1
187	DO j=1, d3
188	clt3D2(i,j) = var_clt(cldfra3D(i,:,j), d2)
189	END DO
190	END DO
191	ELSE IF (zdim == 3) THEN
192	DO i=1, d1
193	DO j=1, d2
194	clt3D3(i,j) = var_clt(cldfra3D(i,j,:), d3)
195	END DO
196	END DO
197	ELSE
198	PRINT *,TRIM(ErrWarnMsg('err'))
199	PRINT *,' ' // TRIM(fname) // ': wrong zdim:', zdim,' for Ndim=', Ndim, ' !!'
200	PRINT *,' accepted values: 1,2,3'
201	STOP
202	END IF
203	CASE (4)
204	IF (zdim == 1) THEN
205	DO i=1, d2
206	DO j=1, d3
207	DO k=1, d4
208	clt4D1(i,j,k) = var_clt(cldfra4D(:,i,j,k), d1)
209	END DO
210	END DO
211	END DO
212	ELSE IF (zdim == 2) THEN
213	DO i=1, d1
214	DO j=1, d3
215	DO k=1, d4
216	clt4D2(i,j,k) = var_clt(cldfra4D(i,:,j,k), d2)
217	END DO
218	END DO
219	END DO
220	ELSE IF (zdim == 3) THEN
221	DO i=1, d2
222	DO j=1, d3
223	DO k=1, d4
224	clt4D3(i,j,k) = var_clt(cldfra4D(i,j,:,k), d3)
225	END DO
226	END DO
227	END DO
228	ELSE IF (zdim == 4) THEN
229	DO i=1, d1
230	DO j=1, d2
231	DO k=1, d3
232	clt4D4(i,j,k) = var_clt(cldfra4D(i,j,k,:), d4)
233	END DO
234	END DO
235	END DO
236	ELSE
237	PRINT *,TRIM(ErrWarnMsg('err'))
238	PRINT *,' ' // TRIM(fname) // ': wrong zdim:', zdim,' for Ndim=', Ndim, ' !!'
239	PRINT *,' accepted values: 1,2,3,4'
240	STOP
241	END IF
242	CASE DEFAULT
243	PRINT *,TRIM(ErrWarnMsg('err'))
244	PRINT *,' ' // TRIM(fname) // ': Ndim:', Ndim,' not ready !!'
245	STOP
246	END SELECT
247
248	RETURN
249
250	END SUBROUTINE compute_clt
251
252	END MODULE module_ForDiagnostics

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

Download in other formats:

Original Format