!! Fortran version of different diagnostics ! L. Fita. LMD May 2016 ! gfortran module_generic.o module_ForDiagnosticsVars.o -c module_ForDiagnostics.F90 ! ! f2py -m module_ForDiagnostics --f90exec=/usr/bin/gfortran-4.7 -c module_generic.F90 module_ForDiagnosticsVars.F90 module_ForDiagnostics.F90 MODULE module_ForDiagnostics USE module_generic USE module_ForDiagnosticsVars CONTAINS !!!!!!! Calculations ! compute_cllmh4D3: Computation of low, medium and high cloudiness from a 4D CLDFRA and pressure being 3rd dimension the z-dim ! compute_cllmh3D3: Computation of low, medium and high cloudiness from a 3D CLDFRA and pressure being 3rd dimension the z-dim ! compute_cllmh: Computation of low, medium and high cloudiness ! compute_clt4D3: Computation of total cloudiness from a 4D CLDFRA being 3rd dimension the z-dim ! compute_clt3D3: Computation of total cloudiness from a 3D CLDFRA being 3rd dimension the z-dim ! compute_clt: Computation of total cloudiness !!! ! Calculations !!! SUBROUTINE compute_cllmh4D2(cldfra4D, pres4D, cllmh4D2, d1, d2, d3, d4) ! Subroutine to compute the low, medium and high cloudiness following 'newmicro.F90' from LMDZ from a 4D CLDFRA and pressure ! where zdim is the 2nd dimension (thus, cldfra4D(d1,d2,d3,d4) --> cllmh(3,d1,d3,d4) 1: low, 2: medium, 3: high ! It should be properly done via an 'INTERFACE', but... IMPLICIT NONE INTEGER, PARAMETER :: r_k = KIND(1.d0) REAL(r_k), DIMENSION(d1,d2,d3,d4), INTENT(in) :: cldfra4D, pres4D INTEGER, INTENT(in) :: d1, d2, d3, d4 REAL(r_k), DIMENSION(3,d1,d3,d4), INTENT(out) :: cllmh4D2 ! Local INTEGER :: i,j,k, zdim, Ndim CHARACTER(LEN=50) :: fname !!!!!!! Variables ! cldfra4D: 4D cloud fraction values [1] ! pres4D: 4D pressure values [Pa] ! Ndim: number of dimensions of the input data ! d[1-4]: dimensions of 'cldfra4D' ! zdim: number of the vertical-dimension within the matrix ! cltlmh4D2: low, medium, high cloudiness for the 4D cldfra and d2 being 'zdim' fname = 'compute_cllmh4D2' zdim = 2 Ndim = 4 DO i=1, d1 DO j=1, d3 DO k=1, d4 cllmh4D2(:,i,j,k) = var_cllmh(cldfra4D(i,:,j,k), pres4D(i,:,j,k), d2) END DO END DO END DO RETURN END SUBROUTINE compute_cllmh4D2 SUBROUTINE compute_cllmh3D1(cldfra3D, pres3D, cllmh3D1, d1, d2, d3) ! Subroutine to compute the low, medium and high cloudiness following 'newmicro.F90' from LMDZ from a 3D CLDFRA and pressure ! where zdim is the 1st dimension (thus, cldfra3D(d1,d2,d3) --> cllmh(3,d2,d3) 1: low, 2: medium, 3: high ! It should be properly done via an 'INTERFACE', but... IMPLICIT NONE INTEGER, PARAMETER :: r_k = KIND(1.d0) REAL(r_k), DIMENSION(d1,d2,d3), INTENT(in) :: cldfra3D, pres3D INTEGER, INTENT(in) :: d1, d2, d3 REAL(r_k), DIMENSION(3,d2,d3), INTENT(out) :: cllmh3D1 ! Local INTEGER :: i,j,k, zdim, Ndim CHARACTER(LEN=50) :: fname !!!!!!! Variables ! cldfra3D: 3D cloud fraction values [1] ! pres3D: 3D pressure values [Pa] ! Ndim: number of dimensions of the input data ! d[1-3]: dimensions of 'cldfra3D' ! zdim: number of the vertical-dimension within the matrix ! cltlmh3D1: low, medium, high cloudiness for the 3D cldfra and d1 being 'zdim' fname = 'compute_cllmh3D1' zdim = 1 Ndim = 3 DO i=1, d1 DO j=1, d2 cllmh3D1(:,i,j) = var_cllmh(cldfra3D(:,i,j), pres3D(:,i,j), d1) END DO END DO RETURN END SUBROUTINE compute_cllmh3D1 SUBROUTINE compute_cllmh(cldfra1D, cldfra2D, cldfra3D, cldfra4D, pres1D, pres2D, pres3D, pres4D, & Ndim, zdim, cllmh1D, cllmh2D1, cllmh2D2, cllmh3D1, cllmh3D2, cllmh3D3, cllmh4D1, cllmh4D2, & cllmh4D3, cllmh4D4, d1, d2, d3, d4) ! Subroutine to compute the low, medium and high cloudiness following 'newmicro.F90' from LMDZ IMPLICIT NONE INTEGER, PARAMETER :: r_k = KIND(1.d0) REAL(r_k), DIMENSION(d1), OPTIONAL, INTENT(in) :: cldfra1D, pres1D REAL(r_k), DIMENSION(d1,d2), OPTIONAL, INTENT(in) :: cldfra2D, pres2D REAL(r_k), DIMENSION(d1,d2,d3), OPTIONAL, INTENT(in) :: cldfra3D, pres3D REAL(r_k), DIMENSION(d1,d2,d3,d4), OPTIONAL, & INTENT(in) :: cldfra4D, pres4D INTEGER, INTENT(in) :: Ndim, d1, d2, d3, d4, zdim REAL(r_k), DIMENSION(3), OPTIONAL, INTENT(out) :: cllmh1D REAL(r_k), DIMENSION(d1,3), OPTIONAL, INTENT(out) :: cllmh2D1 REAL(r_k), DIMENSION(d2,3), OPTIONAL, INTENT(out) :: cllmh2D2 REAL(r_k), DIMENSION(d2,d3,3), OPTIONAL, INTENT(out) :: cllmh3D1 REAL(r_k), DIMENSION(d1,d3,3), OPTIONAL, INTENT(out) :: cllmh3D2 REAL(r_k), DIMENSION(d1,d2,3), OPTIONAL, INTENT(out) :: cllmh3D3 REAL(r_k), DIMENSION(d2,d3,d4,3), OPTIONAL, & INTENT(out) :: cllmh4D1 REAL(r_k), DIMENSION(d1,d3,d4,3), OPTIONAL, & INTENT(out) :: cllmh4D2 REAL(r_k), DIMENSION(d1,d2,d4,3), OPTIONAL, & INTENT(out) :: cllmh4D3 REAL(r_k), DIMENSION(d1,d2,d3,3), OPTIONAL, & INTENT(out) :: cllmh4D4 ! Local INTEGER :: i,j,k CHARACTER(LEN=50) :: fname !!!!!!! Variables ! cldfra[1-4]D: cloud fraction values [1] ! pres[1-4]D: pressure values [Pa] ! Ndim: number of dimensions of the input data ! d[1-4]: dimensions of 'cldfra' ! zdim: number of the vertical-dimension within the matrix ! cllmh1D: low, medium and high cloudiness for the 1D cldfra ! cllmh2D1: low, medium and high cloudiness for the 2D cldfra and d1 being 'zdim' ! cllmh2D2: low, medium and high cloudiness for the 2D cldfra and d2 being 'zdim' ! cllmh3D1: low, medium and high cloudiness for the 3D cldfra and d1 being 'zdim' ! cllmh3D2: low, medium and high cloudiness for the 3D cldfra and d2 being 'zdim' ! cllmh3D3: low, medium and high cloudiness for the 3D cldfra and d3 being 'zdim' ! cllmh4D1: low, medium and high cloudiness for the 4D cldfra and d1 being 'zdim' ! cllmh4D2: low, medium and high cloudiness for the 4D cldfra and d2 being 'zdim' ! cllmh4D3: low, medium and high cloudiness for the 4D cldfra and d3 being 'zdim' ! cllmh4D4: low, medium and high cloudiness for the 4D cldfra and d4 being 'zdim' fname = 'compute_cllmh' SELECT CASE (Ndim) CASE (1) cllmh1D = var_cllmh(cldfra1D, pres1D, d1) CASE (2) IF (zdim == 1) THEN DO i=1, d2 cllmh2D1(i,:) = var_cllmh(cldfra2D(:,i), pres2D(:,i), d1) END DO ELSE IF (zdim == 2) THEN DO i=1, d1 cllmh2D2(i,:) = var_cllmh(cldfra2D(:,i), pres2D(i,:), d2) END DO ELSE PRINT *,TRIM(ErrWarnMsg('err')) PRINT *,' ' // TRIM(fname) // ': wrong zdim:', zdim,' for Ndim=', Ndim, ' !!' PRINT *,' accepted values: 1,2' STOP END IF CASE (3) IF (zdim == 1) THEN DO i=1, d2 DO j=1, d3 cllmh3D1(i,j,:) = var_cllmh(cldfra3D(:,i,j), pres3D(:,i,j), d1) END DO END DO ELSE IF (zdim == 2) THEN DO i=1, d1 DO j=1, d3 cllmh3D2(i,j,:) = var_cllmh(cldfra3D(i,:,j), pres3D(i,:,j), d2) END DO END DO ELSE IF (zdim == 3) THEN DO i=1, d1 DO j=1, d2 cllmh3D3(i,j,:) = var_cllmh(cldfra3D(i,j,:), pres3D(i,j,:), d3) END DO END DO ELSE PRINT *,TRIM(ErrWarnMsg('err')) PRINT *,' ' // TRIM(fname) // ': wrong zdim:', zdim,' for Ndim=', Ndim, ' !!' PRINT *,' accepted values: 1,2,3' STOP END IF CASE (4) IF (zdim == 1) THEN DO i=1, d2 DO j=1, d3 DO k=1, d4 cllmh4D1(i,j,k,:) = var_cllmh(cldfra4D(:,i,j,k), pres4D(:,i,j,k), d1) END DO END DO END DO ELSE IF (zdim == 2) THEN DO i=1, d1 DO j=1, d3 DO k=1, d4 cllmh4D2(i,j,k,:) = var_cllmh(cldfra4D(i,:,j,k), pres4D(i,:,j,k), d2) END DO END DO END DO ELSE IF (zdim == 3) THEN DO i=1, d2 DO j=1, d3 DO k=1, d4 cllmh4D3(i,j,k,:) = var_cllmh(cldfra4D(i,j,:,k), pres4D(i,j,:,k), d3) END DO END DO END DO ELSE IF (zdim == 4) THEN DO i=1, d1 DO j=1, d2 DO k=1, d3 cllmh4D4(i,j,k,:) = var_cllmh(cldfra4D(i,j,k,:), pres4D(i,j,k,:), d4) END DO END DO END DO ELSE PRINT *,TRIM(ErrWarnMsg('err')) PRINT *,' ' // TRIM(fname) // ': wrong zdim:', zdim,' for Ndim=', Ndim, ' !!' PRINT *,' accepted values: 1,2,3,4' STOP END IF CASE DEFAULT PRINT *,TRIM(ErrWarnMsg('err')) PRINT *,' ' // TRIM(fname) // ': Ndim:', Ndim,' not ready !!' STOP END SELECT RETURN END SUBROUTINE compute_cllmh SUBROUTINE compute_clt4D2(cldfra4D, clt4D2, d1, d2, d3, d4) ! Subroutine to compute the total cloudiness following 'newmicro.F90' from LMDZ from a 4D CLDFRA ! where zdim is the 2nd dimension (thus, cldfra4D(d1,d2,d3,d4) --> clt(d1,d3,d4) ! It should be properly done via an 'INTERFACE', but... IMPLICIT NONE INTEGER, PARAMETER :: r_k = KIND(1.d0) REAL(r_k), DIMENSION(d1,d2,d3,d4), INTENT(in) :: cldfra4D INTEGER, INTENT(in) :: d1, d2, d3, d4 REAL(r_k), DIMENSION(d1,d3,d4), INTENT(out) :: clt4D2 ! Local INTEGER :: i,j,k, zdim, Ndim CHARACTER(LEN=50) :: fname !!!!!!! Variables ! cldfra4D: 4D cloud fraction values [1] ! Ndim: number of dimensions of the input data ! d[1-4]: dimensions of 'cldfra4D' ! zdim: number of the vertical-dimension within the matrix ! clt4D2: total cloudiness for the 4D cldfra and d2 being 'zdim' fname = 'compute_clt4D2' zdim = 2 Ndim = 4 DO i=1, d1 DO j=1, d3 DO k=1, d4 clt4D2(i,j,k) = var_clt(cldfra4D(i,:,j,k), d2) END DO END DO END DO RETURN END SUBROUTINE compute_clt4D2 SUBROUTINE compute_clt3D1(cldfra3D, clt3D1, d1, d2, d3) ! Subroutine to compute the total cloudiness following 'newmicro.F90' from LMDZ from a 3D CLDFRA ! where zdim is the 1st dimension (thus, cldfra4D(d1,d2,d3) --> clt(d2,d3) ! It should be properly done via an 'INTERFACE', but... IMPLICIT NONE INTEGER, PARAMETER :: r_k = KIND(1.d0) REAL(r_k), DIMENSION(d1,d2,d3), INTENT(in) :: cldfra3D INTEGER, INTENT(in) :: d1, d2, d3 REAL(r_k), DIMENSION(d2,d3), INTENT(out) :: clt3D1 ! Local INTEGER :: i,j,k, zdim, Ndim CHARACTER(LEN=50) :: fname !!!!!!! Variables ! cldfra3D: 3D cloud fraction values [1] ! Ndim: number of dimensions of the input data ! d[1-3]: dimensions of 'cldfra3D' ! zdim: number of the vertical-dimension within the matrix ! clt3D1: total cloudiness for the 3D cldfra and d1 being 'zdim' fname = 'compute_clt3D1' zdim = 1 Ndim = 3 DO i=1, d2 DO j=1, d3 clt3D1(i,j) = var_clt(cldfra3D(:,i,j), d1) END DO END DO RETURN END SUBROUTINE compute_clt3D1 SUBROUTINE compute_clt(cldfra1D, cldfra2D, cldfra3D, cldfra4D, Ndim, zdim, clt1D, clt2D1, clt2D2, & clt3D1, clt3D2, clt3D3, clt4D1, clt4D2, clt4D3, clt4D4, d1, d2, d3, d4) ! Subroutine to compute the total cloudiness following 'newmicro.F90' from LMDZ IMPLICIT NONE INTEGER, PARAMETER :: r_k = KIND(1.d0) REAL(r_k), DIMENSION(d1), OPTIONAL, INTENT(in) :: cldfra1D REAL(r_k), DIMENSION(d1,d2), OPTIONAL, INTENT(in) :: cldfra2D REAL(r_k), DIMENSION(d1,d2,d3), OPTIONAL, INTENT(in) :: cldfra3D REAL(r_k), DIMENSION(d1,d2,d3,d4), OPTIONAL, & INTENT(in) :: cldfra4D INTEGER, INTENT(in) :: Ndim, d1, d2, d3, d4, zdim REAL(r_k), OPTIONAL, INTENT(out) :: clt1D REAL(r_k), DIMENSION(d1), OPTIONAL, INTENT(out) :: clt2D1 REAL(r_k), DIMENSION(d2), OPTIONAL, INTENT(out) :: clt2D2 REAL(r_k), DIMENSION(d2,d3), OPTIONAL, INTENT(out) :: clt3D1 REAL(r_k), DIMENSION(d1,d3), OPTIONAL, INTENT(out) :: clt3D2 REAL(r_k), DIMENSION(d1,d2), OPTIONAL, INTENT(out) :: clt3D3 REAL(r_k), DIMENSION(d2,d3,d4), OPTIONAL,INTENT(out) :: clt4D1 REAL(r_k), DIMENSION(d1,d3,d4), OPTIONAL,INTENT(out) :: clt4D2 REAL(r_k), DIMENSION(d1,d2,d4), OPTIONAL,INTENT(out) :: clt4D3 REAL(r_k), DIMENSION(d1,d2,d3), OPTIONAL,INTENT(out) :: clt4D4 ! Local INTEGER :: i,j,k CHARACTER(LEN=50) :: fname !!!!!!! Variables ! cldfra[1-4]D: cloud fraction values [1] ! Ndim: number of dimensions of the input data ! d[1-4]: dimensions of 'cldfra' ! zdim: number of the vertical-dimension within the matrix ! clt1D: total cloudiness for the 1D cldfra ! clt2D1: total cloudiness for the 2D cldfra and d1 being 'zdim' ! clt2D2: total cloudiness for the 2D cldfra and d2 being 'zdim' ! clt3D1: total cloudiness for the 3D cldfra and d1 being 'zdim' ! clt3D2: total cloudiness for the 3D cldfra and d2 being 'zdim' ! clt3D3: total cloudiness for the 3D cldfra and d3 being 'zdim' ! clt4D1: total cloudiness for the 4D cldfra and d1 being 'zdim' ! clt4D2: total cloudiness for the 4D cldfra and d2 being 'zdim' ! clt4D3: total cloudiness for the 4D cldfra and d3 being 'zdim' ! clt4D4: total cloudiness for the 4D cldfra and d4 being 'zdim' fname = 'compute_clt' SELECT CASE (Ndim) CASE (1) clt1D = var_clt(cldfra1D, d1) CASE (2) IF (zdim == 1) THEN DO i=1, d2 clt2D1(i) = var_clt(cldfra2D(:,i), d1) END DO ELSE IF (zdim == 2) THEN DO i=1, d1 clt2D2(i) = var_clt(cldfra2D(:,i), d2) END DO ELSE PRINT *,TRIM(ErrWarnMsg('err')) PRINT *,' ' // TRIM(fname) // ': wrong zdim:', zdim,' for Ndim=', Ndim, ' !!' PRINT *,' accepted values: 1,2' STOP END IF CASE (3) IF (zdim == 1) THEN DO i=1, d2 DO j=1, d3 clt3D1(i,j) = var_clt(cldfra3D(:,i,j), d1) END DO END DO ELSE IF (zdim == 2) THEN DO i=1, d1 DO j=1, d3 clt3D2(i,j) = var_clt(cldfra3D(i,:,j), d2) END DO END DO ELSE IF (zdim == 3) THEN DO i=1, d1 DO j=1, d2 clt3D3(i,j) = var_clt(cldfra3D(i,j,:), d3) END DO END DO ELSE PRINT *,TRIM(ErrWarnMsg('err')) PRINT *,' ' // TRIM(fname) // ': wrong zdim:', zdim,' for Ndim=', Ndim, ' !!' PRINT *,' accepted values: 1,2,3' STOP END IF CASE (4) IF (zdim == 1) THEN DO i=1, d2 DO j=1, d3 DO k=1, d4 clt4D1(i,j,k) = var_clt(cldfra4D(:,i,j,k), d1) END DO END DO END DO ELSE IF (zdim == 2) THEN DO i=1, d1 DO j=1, d3 DO k=1, d4 clt4D2(i,j,k) = var_clt(cldfra4D(i,:,j,k), d2) END DO END DO END DO ELSE IF (zdim == 3) THEN DO i=1, d2 DO j=1, d3 DO k=1, d4 clt4D3(i,j,k) = var_clt(cldfra4D(i,j,:,k), d3) END DO END DO END DO ELSE IF (zdim == 4) THEN DO i=1, d1 DO j=1, d2 DO k=1, d3 clt4D4(i,j,k) = var_clt(cldfra4D(i,j,k,:), d4) END DO END DO END DO ELSE PRINT *,TRIM(ErrWarnMsg('err')) PRINT *,' ' // TRIM(fname) // ': wrong zdim:', zdim,' for Ndim=', Ndim, ' !!' PRINT *,' accepted values: 1,2,3,4' STOP END IF CASE DEFAULT PRINT *,TRIM(ErrWarnMsg('err')) PRINT *,' ' // TRIM(fname) // ': Ndim:', Ndim,' not ready !!' STOP END SELECT RETURN END SUBROUTINE compute_clt END MODULE module_ForDiagnostics