!! Fortran version of different diagnostics ! L. Fita. LMD May 2016 ! gfortran module_generic.o -c module_ForDiagnostics.F90 MODULE module_ForDiagnostics USE module_generic IMPLICIT NONE INTEGER, PARAMETER :: r_k = KIND(1.d0) REAL(r_k), PARAMETER :: ZEPSEC=1.0D-12 ! Low limit pressure for medium clouds [Pa] REAL(r_k), PARAMETER :: prmhc = 44000.d0 ! Low limit pressure for High clouds [Pa] REAL(r_k), PARAMETER :: prmlc = 68000.d0 REAL(r_k), PARAMETER :: zero=0.d0 REAL(r_k), PARAMETER :: one=1.d0 REAL(r_k), PARAMETER :: two=2.d0 CONTAINS !!!!!!! Variables ! var_clt: total cloudiness [1,0] !!!!!!! Calculations ! compute_clt: Computation of total cloudiness !!! ! Variables !!! REAL(r_k), FUNCTION var_cllmh(clfra, p, dz): ! Function to compute cllmh on a 1D column IMPLICIT NONE INTEGER, INTENT(in) :: dz REAL(r_k), DIMENSION(dz), INTENT(in) :: clfra, p ! Local INTEGER :: iz CHARACTER(LEN=50) :: fname REAL(r_k) :: zclearl, zcloudl, zclearm, zcloudm, & zclearh, zcloudh !!!!!!! Variables ! clfra: cloudfraction as 1D verical-column [1] ! p: pressure values of the column fname = 'var_cllmh' zclearl = one zcloudl = zero zclearm = one zcloudm = zero zclearh = one zcloudh = zero DO iz=1, dz IF (p(iz) < prmhc) THEN cllmh(2) = cllmh(2)*(one-MAX(clfra(iz), zcloudh))/(one-MIN(zcloudh,one-ZEPSEC)) zcloudh = clfra(iz) ELSE IF ( (p(iz) >= prmhc).AND.(p(iz) < prmlc)) ) THEN cllmh[1] = cllmh[1]*(1.-np.max([cfra[iz], zcloudm]))/(1.- \ np.min([zcloudm,1.-ZEPSEC])) zcloudm = cfra[iz] elif p[iz] >= prmlc: cllmh[0] = cllmh[0]*(1.-np.max([cfra[iz], zcloudl]))/(1.- \ np.min([zcloudl,1.-ZEPSEC])) zcloudl = cfra[iz] cllmh = 1.- cllmh RETURN END FUNCTION var_clmh REAL(r_k) FUNCTION var_clt(clfra, dz) ! Function to compute the total cloud fraction following 'newmicro.F90' from LMDZ using 1D vertical ! column values IMPLICIT NONE REAL(r_k), DIMENSION(dz), INTENT(in) :: clfra INTEGER, INTENT(in) :: dz ! Local INTEGER :: iz REAL(r_k) :: zclear, zcloud CHARACTER(LEN=50) :: fname !!!!!!! Variables ! cfra: 1-column cloud fraction values fname = 'var_clt' zclear = one zcloud = zero DO iz=1,dz zclear = zclear*(one-MAX(clfra(iz),zcloud))/(one-MIN(zcloud,1.-ZEPSEC)) var_clt = one - zclear zcloud = clfra(iz) END DO RETURN END FUNCTION var_clt !!! ! Calculations !!! SUBROUTINE compute_clt(cldfra1D, cldfra2D, cldfra3D, cldfra4D, Ndim, d1, d2, d3, d4, zdim, clt1D, & clt2D1, clt2D2, clt3D1, clt3D2, clt3D3, clt4D1, clt4D2, clt4D3, clt4D4) ! Subroutine to compute the total cloud fraction following 'newmicro.F90' from LMDZ IMPLICIT NONE 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 REAL(r_k) :: var_clt 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