source: lmdz_wrf/trunk/tools/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
RevLine 
[770]1!! Fortran version of different diagnostics
2! L. Fita. LMD May 2016
3! gfortran module_generic.o -c module_ForDiagnostics.F90
4MODULE 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
252END MODULE module_ForDiagnostics
Note: See TracBrowser for help on using the repository browser.