reproj_diag_isban.F90

Go to the documentation of this file.

!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt  
!SFX_LIC for details. version 1.
!     #########
SUBROUTINE reproj_diag_isba_n (DK, DEK, DMK, PEK, OSURF_BUDGET, OSURF_EVAP_BUDGET, &
                               OWATER_BUDGET, OSURF_MISC_BUDGET, OPROSNOW, &
                               OMEB_PATCH, PSLOPECOS    )  
!     ###############################################################################
!
!!****  *REPROJ_DIAG-ISBA_n * - additional diagnostics for ISBA
!!
!!    PURPOSE
!!    -------
!
!!**  METHOD
!!    ------
!!
!!    REFERENCE
!!    ---------
!!      
!!
!!    AUTHOR
!!    ------
!!     S. Faroux 
!!
!!------------------------------------------------------------------
!
USE modd_diag_n, ONLY : diag_t
USE modd_diag_evap_isba_n, ONLY : diag_evap_isba_t
USE modd_diag_misc_isba_n, ONLY : diag_misc_isba_t
USE modd_isba_n, ONLY : isba_pe_t
USE modd_surf_par, ONLY : xundef
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*      0.1    declarations of arguments
!
TYPE(diag_t), INTENT(INOUT) :: DK
TYPE(diag_evap_isba_t), INTENT(INOUT) :: DEK
TYPE(diag_misc_isba_t), INTENT(INOUT) :: DMK
TYPE(isba_pe_t), INTENT(INOUT) :: PEK
!
LOGICAL, INTENT(IN) :: OSURF_BUDGET
LOGICAL, INTENT(IN) :: OSURF_EVAP_BUDGET 
LOGICAL, INTENT(IN) :: OWATER_BUDGET 
LOGICAL, INTENT(IN) :: OSURF_MISC_BUDGET
LOGICAL, INTENT(IN) :: OPROSNOW
!
LOGICAL, INTENT(IN) :: OMEB_PATCH
!
REAL, DIMENSION(:), INTENT(IN) :: PSLOPECOS ! cosine of the slope for Crocus
!    
!*      0.2    declarations of local variables
!
REAL, DIMENSION(SIZE(PEK%XPSN))    :: ZCORR_SLOPE
REAL, DIMENSION(SIZE(PEK%TSNOW%WSNOW,1),SIZE(PEK%TSNOW%WSNOW,2)) :: ZCORR_SLOPE_2D
!
INTEGER :: JL, JSW
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('REPROJ_DIAG_ISBA_N',0,zhook_handle)
!
IF ( oprosnow ) THEN
  !
  !this variable is used further to project diagnostics on the verticale
  zcorr_slope(:) = 1. / pslopecos(:)
  DO jl = 1,SIZE(pek%TSNOW%WSNOW,2)
    WHERE (pek%TSNOW%WSNOW(:,jl)>0.) 
      zcorr_slope_2d(:,jl) = zcorr_slope(:)
    ELSEWHERE
      zcorr_slope_2d(:,jl) = 1.
    ENDWHERE
  ENDDO
  !
  IF ( osurf_budget ) THEN
    !
    dk%XRN    (:)    = dk%XRN         (:) * zcorr_slope(:)
    dk%XH     (:)    = dk%XH          (:) * zcorr_slope(:)
    dk%XGFLUX (:)    = dk%XGFLUX      (:) * zcorr_slope(:)
    dk%XLEI   (:)    = dk%XLEI        (:) * zcorr_slope(:)
    dk%XSWD   (:)    = dk%XSWD        (:) * zcorr_slope(:)
    dk%XSWU   (:)    = dk%XSWU        (:) * zcorr_slope(:)
    dk%XLWD   (:)    = dk%XLWD        (:) * zcorr_slope(:)
    dk%XLWU   (:)    = dk%XLWU        (:) * zcorr_slope(:)
    dk%XFMU   (:)    = dk%XFMU        (:) * zcorr_slope(:)
    dk%XFMV   (:)    = dk%XFMV        (:) * zcorr_slope(:)
    !
    DO jsw=1,SIZE(dk%XSWBD,2)
      dk%XSWBD   (:, jsw) = dk%XSWBD  (:,jsw) * zcorr_slope(:)
      dk%XSWBU   (:, jsw) = dk%XSWBU  (:,jsw) * zcorr_slope(:)
    ENDDO
    !
  END IF
  !
  IF ( osurf_evap_budget ) THEN
     !
     dk%XEVAP       (:)  =  dk%XEVAP        (:) * zcorr_slope(:)
     dk%XSUBL       (:)  =  dk%XSUBL        (:) * zcorr_slope(:)
     !
     dek%XLEG       (:)  =  dek%XLEG        (:) * zcorr_slope(:)
     dek%XLEGI      (:)  =  dek%XLEGI       (:) * zcorr_slope(:)
     dek%XLEV       (:)  =  dek%XLEV        (:) * zcorr_slope(:)
     dek%XLES       (:)  =  dek%XLES        (:) * zcorr_slope(:)
     dek%XLER       (:)  =  dek%XLER        (:) * zcorr_slope(:)
     dek%XLETR      (:)  =  dek%XLETR       (:) * zcorr_slope(:)
     dek%XDRAIN     (:)  =  dek%XDRAIN      (:) * zcorr_slope(:)
     dek%XQSB       (:)  =  dek%XQSB        (:) * zcorr_slope(:)
     dek%XRUNOFF    (:)  =  dek%XRUNOFF     (:) * zcorr_slope(:)
     dek%XHORT      (:)  =  dek%XHORT       (:) * zcorr_slope(:)
     dek%XDRIP      (:)  =  dek%XDRIP       (:) * zcorr_slope(:)
     dek%XRRVEG     (:)  =  dek%XRRVEG      (:) * zcorr_slope(:)
     dek%XMELT      (:)  =  dek%XMELT       (:) * zcorr_slope(:)
     dek%XIFLOOD    (:)  =  dek%XIFLOOD     (:) * zcorr_slope(:)
     dek%XPFLOOD    (:)  =  dek%XPFLOOD     (:) * zcorr_slope(:)
     dek%XLE_FLOOD  (:)  =  dek%XLE_FLOOD   (:) * zcorr_slope(:)
     dek%XLEI_FLOOD (:)  =  dek%XLEI_FLOOD  (:) * zcorr_slope(:)
     dek%XIRRIG_FLUX(:)  =  dek%XIRRIG_FLUX (:) * zcorr_slope(:)
     !
     IF ( omeb_patch ) THEN
       !
       dek%XLEV_CV   (:) = dek%XLEV_CV   (:) * zcorr_slope(:)
       dek%XLES_CV   (:) = dek%XLES_CV   (:) * zcorr_slope(:)
       dek%XLETR_CV  (:) = dek%XLETR_CV  (:) * zcorr_slope(:)
       dek%XLELITTER (:) = dek%XLELITTER (:) * zcorr_slope(:)
       dek%XLELITTERI(:) = dek%XLELITTERI(:) * zcorr_slope(:)
       dek%XDRIPLIT  (:) = dek%XDRIPLIT  (:) * zcorr_slope(:)
       dek%XRRLIT    (:) = dek%XRRLIT    (:) * zcorr_slope(:)
       dek%XLER_CV   (:) = dek%XLER_CV   (:) * zcorr_slope(:)
       dek%XLE_CA    (:) = dek%XLE_CA    (:) * zcorr_slope(:)
       dek%XLE_CV    (:) = dek%XLE_CV    (:) * zcorr_slope(:)
       dek%XLE_GV    (:) = dek%XLE_GV    (:) * zcorr_slope(:)
       dek%XLE_GN    (:) = dek%XLE_GN    (:) * zcorr_slope(:)
       !
       dek%XSWNET_V  (:) = dek%XSWNET_V  (:) * zcorr_slope(:)
       dek%XSWNET_G  (:) = dek%XSWNET_G  (:) * zcorr_slope(:)
       dek%XSWNET_N  (:) = dek%XSWNET_N  (:) * zcorr_slope(:)
       dek%XSWNET_NS (:) = dek%XSWNET_NS (:) * zcorr_slope(:)
       dek%XLWNET_V  (:) = dek%XLWNET_V  (:) * zcorr_slope(:)
       dek%XLWNET_G  (:) = dek%XLWNET_G  (:) * zcorr_slope(:)
       dek%XLWNET_N  (:) = dek%XLWNET_N  (:) * zcorr_slope(:)
       dek%XSWDOWN_GN(:) = dek%XSWDOWN_GN(:) * zcorr_slope(:)
       dek%XLWDOWN_GN(:) = dek%XLWDOWN_GN(:) * zcorr_slope(:)
       dek%XH_CV     (:) = dek%XH_CV     (:) * zcorr_slope(:)
       dek%XH_GV     (:) = dek%XH_GV     (:) * zcorr_slope(:)
       dek%XH_CA     (:) = dek%XH_CA     (:) * zcorr_slope(:)
       dek%XH_GN     (:) = dek%XH_GN     (:) * zcorr_slope(:)
       dek%XSR_GN    (:) = dek%XSR_GN    (:) * zcorr_slope(:)
       dek%XMELT_CV  (:) = dek%XMELT_CV  (:) * zcorr_slope(:)
       dek%XFRZ_CV   (:) = dek%XFRZ_CV   (:) * zcorr_slope(:)
       !
     ENDIF
     !
     IF ( pek%TSNOW%SCHEME=='3-L' .OR. pek%TSNOW%SCHEME=='CRO') THEN
       !
       dek%XLESL    (:)  =  dek%XLESL       (:) * zcorr_slope(:)
       dek%XSNDRIFT (:)  =  dek%XSNDRIFT    (:) * zcorr_slope(:)
       !
     END IF
     !
     IF ( owater_budget )THEN
       !
       dek%XDWG   (:)  =  dek%XDWG   (:) * zcorr_slope(:)
       dek%XDWGI  (:)  =  dek%XDWGI  (:) * zcorr_slope(:)
       dek%XDWR   (:)  =  dek%XDWR   (:) * zcorr_slope(:)
       dek%XDSWE  (:)  =  dek%XDSWE  (:) * zcorr_slope(:)
       dek%XWATBUD(:)  =  dek%XWATBUD(:) * zcorr_slope(:)
       !
     ENDIF
     !
  END IF
  !
  IF (osurf_misc_budget) THEN
    !
    dmk%XTWSNOW(:) = dmk%XTWSNOW(:) * zcorr_slope(:)
    dmk%XTDSNOW(:) = dmk%XTDSNOW(:) * zcorr_slope(:)
    !
    IF ( pek%TSNOW%SCHEME=='3-L' .OR. pek%TSNOW%SCHEME=='CRO' ) THEN
      !
      WHERE(dmk%XSNOWDZ/=xundef)
        dmk%XSNOWLIQ(:,:) = dmk%XSNOWLIQ(:,:) * zcorr_slope_2d(:,:)
        dmk%XSNOWDZ (:,:) = dmk%XSNOWDZ (:,:) * zcorr_slope_2d(:,:)
      ENDWHERE
      !
      IF ( pek%TSNOW%SCHEME=='CRO' ) THEN
        !PRINT*,ZCORR_SLOPE(:)
        !PRINT*,DMK%XSNDPT_1DY     (:)
        !PRINT*,DMK%XTDSNOW(:)
        !PRINT*,DMK%XTSNOW(:)
        WHERE(dmk%XTWSNOW>0.)
          dmk%XSNDPT_1DY     (:) = dmk%XSNDPT_1DY     (:) * zcorr_slope(:)
          dmk%XSNDPT_3DY     (:) = dmk%XSNDPT_3DY     (:) * zcorr_slope(:)
          dmk%XSNDPT_5DY     (:) = dmk%XSNDPT_5DY     (:) * zcorr_slope(:)
          dmk%XSNDPT_7DY     (:) = dmk%XSNDPT_7DY     (:) * zcorr_slope(:)   
          dmk%XSNSWE_1DY     (:) = dmk%XSNSWE_1DY     (:) * zcorr_slope(:)
          dmk%XSNSWE_3DY     (:) = dmk%XSNSWE_3DY     (:) * zcorr_slope(:)
          dmk%XSNSWE_5DY     (:) = dmk%XSNSWE_5DY     (:) * zcorr_slope(:)
          dmk%XSNSWE_7DY     (:) = dmk%XSNSWE_7DY     (:) * zcorr_slope(:)
          dmk%XSNRAM_SONDE   (:) = dmk%XSNRAM_SONDE   (:) * zcorr_slope(:)
          dmk%XSN_REFRZNTHCKN(:) = dmk%XSN_REFRZNTHCKN(:) * zcorr_slope(:) 
          dmk%XSN_WETTHCKN   (:) = dmk%XSN_WETTHCKN   (:) * zcorr_slope(:)
        ENDWHERE
      ENDIF
      !
    ENDIF
    !
  ENDIF
  !
ENDIF
!
IF (lhook) CALL dr_hook('REPROJ_DIAG_ISBA_N',1,zhook_handle)
!-------------------------------------------------------------------------------------
!
END SUBROUTINE reproj_diag_isba_n