source: lmdz_wrf/trunk/tools/module_ForDiagnostics.F90 @ 1549

Last change on this file since 1549 was 1141, checked in by lfita, 8 years ago

Fixinf some variable definition order which does not like to `ifort'

File size: 17.1 KB
RevLine 
[770]1!! Fortran version of different diagnostics
2! L. Fita. LMD May 2016
[772]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
[770]7MODULE module_ForDiagnostics
8
9  USE module_generic
[772]10  USE module_ForDiagnosticsVars
[770]11
[772]12  CONTAINS
[770]13
[772]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
[770]21
[772]22!!!
23! Calculations
24!!!
[770]25
[772]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...
[770]30
[772]31    IMPLICIT NONE
32
33    INTEGER, PARAMETER                                   :: r_k = KIND(1.d0)
[1141]34    INTEGER, INTENT(in)                                  :: d1, d2, d3, d4
[772]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    CHARACTER(LEN=50)                                    :: fname
41
[770]42!!!!!!! Variables
[772]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'
[770]49
[772]50    fname = 'compute_cllmh4D2'
51    zdim = 2
52    Ndim = 4
[770]53
[772]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
[770]63
[772]64  END SUBROUTINE compute_cllmh4D2
[770]65
[772]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...
[770]70
[772]71    IMPLICIT NONE
[770]72
[772]73    INTEGER, PARAMETER                                   :: r_k = KIND(1.d0)
[1141]74    INTEGER, INTENT(in)                                  :: d1, d2, d3
[772]75    REAL(r_k), DIMENSION(d1,d2,d3), INTENT(in)           :: cldfra3D, pres3D
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
[770]109    IMPLICIT NONE
110
[772]111    INTEGER, PARAMETER                                   :: r_k = KIND(1.d0)
[1141]112    INTEGER, INTENT(in)                                  :: Ndim, d1, d2, d3, d4, zdim
[772]113    REAL(r_k), DIMENSION(d1), OPTIONAL, INTENT(in)       :: cldfra1D, pres1D
114    REAL(r_k), DIMENSION(d1,d2), OPTIONAL, INTENT(in)    :: cldfra2D, pres2D
115    REAL(r_k), DIMENSION(d1,d2,d3), OPTIONAL, INTENT(in) :: cldfra3D, pres3D
116    REAL(r_k), DIMENSION(d1,d2,d3,d4), OPTIONAL,                                                      &
117      INTENT(in)                                         :: cldfra4D, pres4D
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
[770]132
133! Local
[772]134    INTEGER                                              :: i,j,k
[770]135    CHARACTER(LEN=50)                                    :: fname
136
137!!!!!!! Variables
[772]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'
[770]153
[772]154    fname = 'compute_cllmh'
[770]155
[772]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
[770]243
244    RETURN
245
[772]246  END SUBROUTINE compute_cllmh
[770]247
[772]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...
[770]252
253    IMPLICIT NONE
254
[772]255    INTEGER, PARAMETER                                   :: r_k = KIND(1.d0)
[1141]256    INTEGER, INTENT(in)                                  :: d1, d2, d3, d4
[772]257    REAL(r_k), DIMENSION(d1,d2,d3,d4), INTENT(in)        :: cldfra4D
258    REAL(r_k), DIMENSION(d1,d3,d4), INTENT(out)          :: clt4D2
259
[770]260! Local
[772]261    INTEGER                                              :: i,j,k, zdim, Ndim
[770]262    CHARACTER(LEN=50)                                    :: fname
[772]263
[770]264!!!!!!! Variables
[772]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'
[770]270
[772]271    fname = 'compute_clt4D2'
272    zdim = 2
273    Ndim = 4
[770]274
[772]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
[770]281    END DO
[772]282   
283    RETURN
[770]284
[772]285  END SUBROUTINE compute_clt4D2
[770]286
[772]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...
[770]291
[772]292    IMPLICIT NONE
[770]293
[772]294    INTEGER, PARAMETER                                   :: r_k = KIND(1.d0)
[1141]295    INTEGER, INTENT(in)                                  :: d1, d2, d3
[772]296    REAL(r_k), DIMENSION(d1,d2,d3), INTENT(in)           :: cldfra3D
297    REAL(r_k), DIMENSION(d2,d3), INTENT(out)             :: clt3D1
[770]298
[772]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
[770]328    IMPLICIT NONE
329
[772]330    INTEGER, PARAMETER                                   :: r_k = KIND(1.d0)
[1141]331    INTEGER, INTENT(in)                                  :: Ndim, d1, d2, d3, d4, zdim
[770]332    REAL(r_k), DIMENSION(d1), OPTIONAL, INTENT(in)       :: cldfra1D
333    REAL(r_k), DIMENSION(d1,d2), OPTIONAL, INTENT(in)    :: cldfra2D
334    REAL(r_k), DIMENSION(d1,d2,d3), OPTIONAL, INTENT(in) :: cldfra3D
335    REAL(r_k), DIMENSION(d1,d2,d3,d4), OPTIONAL,                                                      &
336      INTENT(in)                                         :: cldfra4D
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
462END MODULE module_ForDiagnostics
Note: See TracBrowser for help on using the repository browser.