[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] | 7 | MODULE 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 | |
---|
| 462 | END MODULE module_ForDiagnostics |
---|