!! 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_definitions
  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, INTENT(in)                                  :: d1, d2, d3, d4
    REAL(r_k), DIMENSION(d1,d2,d3,d4), INTENT(in)        :: cldfra4D, pres4D
    REAL(r_k), DIMENSION(3,d1,d3,d4), INTENT(out)        :: cllmh4D2

! Local
    INTEGER                                              :: i,j,k, zdim, Ndim

!!!!!!! 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, INTENT(in)                                  :: d1, d2, d3
    REAL(r_k), DIMENSION(d1,d2,d3), INTENT(in)           :: cldfra3D, pres3D
    REAL(r_k), DIMENSION(3,d2,d3), INTENT(out)           :: cllmh3D1

! Local
    INTEGER                                              :: i,j,k, zdim, Ndim

!!!!!!! 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, INTENT(in)                                  :: Ndim, d1, d2, d3, d4, zdim
    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
    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

!!!!!!! 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, INTENT(in)                                  :: d1, d2, d3, d4
    REAL(r_k), DIMENSION(d1,d2,d3,d4), INTENT(in)        :: cldfra4D
    REAL(r_k), DIMENSION(d1,d3,d4), INTENT(out)          :: clt4D2

! Local
    INTEGER                                              :: i,j,k, zdim, Ndim

!!!!!!! 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, INTENT(in)                                  :: d1, d2, d3
    REAL(r_k), DIMENSION(d1,d2,d3), INTENT(in)           :: cldfra3D
    REAL(r_k), DIMENSION(d2,d3), INTENT(out)             :: clt3D1

! Local
    INTEGER                                              :: i,j,k, zdim, Ndim

!!!!!!! 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, INTENT(in)                                  :: Ndim, d1, d2, d3, d4, zdim
    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
    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

!!!!!!! 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