average_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 average_diag_isba_n (DGO, D, DC, ND, NDC, NP, KNPATCH, OSURF_BUDGETC, &
                                      OCANOPY, PHW, PHT ,PSFCO2, PTRAD)
!     #######################################
!
!
!!****  *AVERAGE_DIAG_ISBA_n*  
!!
!!    PURPOSE
!!    -------
!      Average the diagnostics from all ISBA tiles
!     
!!**  METHOD
!!    ------
!
!!    EXTERNAL
!!    --------
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------ 
!!
!!      
!!    REFERENCE
!!    ---------
!!      
!!    AUTHOR
!!    ------
!!      S. Belair           * Meteo-France *
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    10/03/95 
!!      V.Masson    20/03/96  remove abnormal averages and average TS**4 instead
!!                            of TS
!!      (J.Stein)   27/03/96 use only H and LE in the soil scheme
!!      A. Boone    27/11/02 revised to output ALMA variables, and general applications
!!      B. Decharme 17/08/09 cumulative radiatif budget
!!      V. Masson   10/2013  coherence between canopy and min/max T2M diagnostics
!!      B. Decharme    04/13 Averaged Trad already done in average_diag.F90
!!                           Good dimension for CO2 flux
!!      P. Samuelsson  10/13 Added min max for XT2M
!!      B. Decharme    02/15 No dependence on HW for 10M Wind diags
!-------------------------------------------------------------------------------
!
!*       0.     DECLARATIONS
!               ------------
!
USE modd_diag_n, ONLY : diag_t, diag_np_t, diag_options_t
USE modd_isba_n, ONLY : isba_np_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_options_t), INTENT(INOUT) :: DGO
TYPE(diag_t), INTENT(INOUT) :: D
TYPE(diag_t), INTENT(INOUT) :: DC
TYPE(diag_np_t), INTENT(INOUT) :: ND
TYPE(diag_np_t), INTENT(INOUT) :: NDC
TYPE(isba_np_t), INTENT(INOUT) :: NP
INTEGER, INTENT(IN) :: KNPATCH
!
LOGICAL, INTENT(IN) :: OSURF_BUDGETC
LOGICAL, INTENT(IN) :: OCANOPY
!
REAL, DIMENSION(:), INTENT(IN)       :: PHW    ! atmospheric level height for wind (m)
REAL, DIMENSION(:), INTENT(IN)       :: PHT    ! atmospheric level height (m)
REAL, DIMENSION(:), INTENT(IN)       :: PSFCO2 ! CO2 flux (m/s*kg_CO2/kg_air)
REAL, DIMENSION(:), INTENT(IN)       :: PTRAD  ! Radiative temperature (K)
!
!*      0.2    declarations of local variables
!
INTEGER                              :: JP, JI, IMASK ! tile loop counter
INTEGER                              :: JSWB   ! band loop counter
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------
!
!       0.     Initialization
!              --------------
!
IF (lhook) CALL dr_hook('AVERAGE_DIAG_ISBA_N',0,zhook_handle)
!
!       1.     Energy fluxes
!              -------------
!
IF (dgo%LSURF_BUDGET) THEN
  !
  CALL make_average(d,nd)
  !
  d%XSWBD(:,:) = 0.
  d%XSWBU(:,:) = 0.
  !
  DO jp=1,knpatch
    DO ji = 1,np%AL(jp)%NSIZE_P
      imask = np%AL(jp)%NR_P(ji)

      DO jswb =1,SIZE(d%XSWBD,2)
        !
        ! Downwards SW radiation for each spectral band
        d%XSWBD(imask,jswb) = d%XSWBD(imask,jswb) + np%AL(jp)%XPATCH(ji) * nd%AL(jp)%XSWBD(ji,jswb)
        !
        ! Upwards SW radiation for each spectral band
        d%XSWBU(imask,jswb) = d%XSWBU(imask,jswb) + np%AL(jp)%XPATCH(ji) * nd%AL(jp)%XSWBU(ji,jswb)
        !
      END DO

    ENDDO
  END DO
  !
END IF
!
IF (osurf_budgetc) THEN
  !
  CALL make_average(dc,ndc)
  !
ENDIF    
!
!       2.     surface temperature and 2 meters parameters
!              -------------------------------------------
!
d%XTS  (:) = 0.0
d%XALBT(:) = 0.0
DO jp=1,knpatch
  DO ji = 1,np%AL(jp)%NSIZE_P
    imask = np%AL(jp)%NR_P(ji)

    d%XTS(imask) = d%XTS(imask) + np%AL(jp)%XPATCH(ji) * nd%AL(jp)%XTS(ji)
    !   Total albedo
    d%XALBT(imask) = d%XALBT(imask) + np%AL(jp)%XPATCH(ji) * nd%AL(jp)%XALBT(ji)  

  ENDDO
END DO
!
IF (.NOT. ocanopy .AND. dgo%N2M>=1) THEN

  d%XT2M(:)  = 0.
  d%XQ2M(:)  = 0.
  d%XHU2M(:)  = 0.
  !
  DO jp=1,knpatch
    DO ji = 1,np%AL(jp)%NSIZE_P
      imask = np%AL(jp)%NR_P(ji) 
      !
      ! 2 meters temperature
      d%XT2M(imask) = d%XT2M(imask) + np%AL(jp)%XPATCH(ji) * nd%AL(jp)%XT2M(ji)
      !
      ! 2 meters humidity
      d%XQ2M(imask) = d%XQ2M(imask) + np%AL(jp)%XPATCH(ji) * nd%AL(jp)%XQ2M(ji)
      !
      ! 2 meters relative humidity
      d%XHU2M(imask) = d%XHU2M(imask) + np%AL(jp)%XPATCH(ji) * nd%AL(jp)%XHU2M(ji)
      ! 
    ENDDO
  END DO
  !
  ! 10 meters wind
  !
  d%XZON10M (:)  = 0.
  d%XMER10M (:)  = 0.
  d%XWIND10M(:)  = 0.
  DO jp=1,knpatch
    DO ji = 1,np%AL(jp)%NSIZE_P
      imask = np%AL(jp)%NR_P(ji)  

      d%XZON10M(imask)  = d%XZON10M (imask) + np%AL(jp)%XPATCH(ji) * nd%AL(jp)%XZON10M (ji)
      d%XMER10M(imask)  = d%XMER10M (imask) + np%AL(jp)%XPATCH(ji) * nd%AL(jp)%XMER10M (ji)
      d%XWIND10M(imask) = d%XWIND10M(imask) + np%AL(jp)%XPATCH(ji) * nd%AL(jp)%XWIND10M(ji)
    ENDDO
  ENDDO
  !
  ! min and max of XT2M
  !
  DO jp=1,knpatch
    nd%AL(jp)%XT2M_MIN(:) = min(nd%AL(jp)%XT2M_MIN(:),nd%AL(jp)%XT2M(:))
    nd%AL(jp)%XT2M_MAX(:) = max(nd%AL(jp)%XT2M_MAX(:),nd%AL(jp)%XT2M(:))
  ENDDO
  !  
  d%XT2M_MIN(:) = min(d%XT2M_MIN(:),d%XT2M(:))
  d%XT2M_MAX(:) = max(d%XT2M_MAX(:),d%XT2M(:))
  !
  d%XHU2M_MIN(:) = min(d%XHU2M_MIN(:),d%XHU2M(:))
  d%XHU2M_MAX(:) = max(d%XHU2M_MAX(:),d%XHU2M(:))
  !
  d%XWIND10M_MAX(:) = max(d%XWIND10M_MAX(:),d%XWIND10M(:))
  !
END IF
!
! Richardson number
!
IF (dgo%N2M>=1) THEN

  d%XRI(:)  = 0.
  d%XSFCO2(:)  = psfco2(:)
  DO jp=1,knpatch
    DO ji = 1,np%AL(jp)%NSIZE_P
      imask = np%AL(jp)%NR_P(ji)    
      d%XRI(imask) = d%XRI(imask) + np%AL(jp)%XPATCH(ji) * nd%AL(jp)%XRI(ji)
    ENDDO
  END DO
  !
END IF
!
!       3.     Transfer coefficients
!              ---------------------
!
IF (dgo%LCOEF) THEN
  !
  d%XCD   (:) = 0.
  d%XCH   (:) = 0.
  d%XCE   (:) = 0.
  d%XZ0   (:) = 0.
  d%XZ0H  (:) = 0.
  d%XZ0EFF(:) = 0.
  !
  DO jp=1,knpatch
    DO ji = 1,np%AL(jp)%NSIZE_P
      imask = np%AL(jp)%NR_P(ji)    
      !
      d%XCD(imask)  = d%XCD(imask) + np%AL(jp)%XPATCH(ji) * nd%AL(jp)%XCD(ji)
      d%XCH(imask)  = d%XCH(imask) + np%AL(jp)%XPATCH(ji) * nd%AL(jp)%XCH(ji)
      d%XCE(imask)  = d%XCE(imask) + np%AL(jp)%XPATCH(ji) * nd%AL(jp)%XCE(ji)
      !            
      d%XZ0(imask)    = d%XZ0(imask)    + np%AL(jp)%XPATCH(ji) * &
              1./(log(phw(imask)/nd%AL(jp)%XZ0 (ji)))**2  
      d%XZ0H(imask)   = d%XZ0H(imask)   + np%AL(jp)%XPATCH(ji) * &
              1./(log(pht(imask)/nd%AL(jp)%XZ0H(ji)))**2   
      d%XZ0EFF(imask) = d%XZ0EFF(imask) + np%AL(jp)%XPATCH(ji) * &
              1./(log(phw(imask)/nd%AL(jp)%XZ0EFF(ji)))**2
      !      
    ENDDO
  END DO
  !
  d%XZ0(:)    = phw(:) *  exp( - sqrt(1./d%XZ0(:)) )
  !
  d%XZ0H(:)   = pht(:) *  exp( - sqrt(1./d%XZ0H(:)) )
  !
  d%XZ0EFF(:) = phw(:) *  exp( - sqrt(1./d%XZ0EFF(:)) )
  !
END IF
!
IF (dgo%LSURF_VARS) THEN
  d%XQS(:)  = 0.
  !
  DO jp=1,knpatch
    DO ji = 1,np%AL(jp)%NSIZE_P  
      imask = np%AL(jp)%NR_P(ji)    
      !
      ! specific humidity at surface
      d%XQS(imask) = d%XQS(imask) + np%AL(jp)%XPATCH(ji) * nd%AL(jp)%XQS(ji)
      !
    ENDDO
  END DO
END IF
!
IF (lhook) CALL dr_hook('AVERAGE_DIAG_ISBA_N',1,zhook_handle)
!-------------------------------------------------------------------------------
CONTAINS
!
SUBROUTINE make_average(DA,NDA)
!
TYPE(diag_t), INTENT(INOUT) :: DA
TYPE(diag_np_t), INTENT(INOUT) :: NDA
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (lhook) CALL dr_hook('AVERAGE_DIAG_ISBA_N:MAKE_AVERAGE',0,zhook_handle)
!
da%XRN   (:) = 0.
da%XH    (:) = 0.
da%XLE   (:) = 0.
da%XLEI  (:) = 0.
da%XGFLUX(:) = 0.
!
da%XSWD(:) = 0.
da%XSWU(:) = 0.
da%XLWD(:) = 0.
da%XLWU(:) = 0.
da%XFMU(:) = 0.
da%XFMV(:) = 0.
!
da%XEVAP (:) = 0.
da%XSUBL (:) = 0.
!
DO jp=1,knpatch
  DO ji = 1,np%AL(jp)%NSIZE_P 
    imask = np%AL(jp)%NR_P(ji) 
    !
    ! Net radiation
    da%XRN   (imask) = da%XRN   (imask) + np%AL(jp)%XPATCH(ji) * nda%AL(jp)%XRN(ji)
    !
    ! Sensible heat flux
    da%XH    (imask) = da%XH    (imask) + np%AL(jp)%XPATCH(ji) * nda%AL(jp)%XH(ji)
    !
    ! Total latent heat flux
    da%XLE   (imask) = da%XLE   (imask) + np%AL(jp)%XPATCH(ji) * nda%AL(jp)%XLE(ji)
    !
    ! Storage flux
    da%XGFLUX(imask) = da%XGFLUX(imask) + np%AL(jp)%XPATCH(ji) * nda%AL(jp)%XGFLUX(ji)
    !
    ! Total surface sublimation
    da%XLEI  (imask) = da%XLEI  (imask) + np%AL(jp)%XPATCH(ji) * nda%AL(jp)%XLEI(ji)          
    !
    ! Evapotranspiration
    da%XEVAP (imask) = da%XEVAP (imask) + np%AL(jp)%XPATCH(ji) * nda%AL(jp)%XEVAP(ji)
    !
    !  Sublimation
    da%XSUBL (imask) = da%XSUBL (imask) + np%AL(jp)%XPATCH(ji) * nda%AL(jp)%XSUBL(ji)
    !
    !  Downwards SW radiation
    da%XSWD  (imask) = da%XSWD  (imask) + np%AL(jp)%XPATCH(ji) * nda%AL(jp)%XSWD(ji)
    !
    !    Upwards SW radiation
    da%XSWU  (imask) = da%XSWU  (imask) + np%AL(jp)%XPATCH(ji) * nda%AL(jp)%XSWU(ji)
    !
    !    Downwards LW radiation
    da%XLWD  (imask) = da%XLWD  (imask) + np%AL(jp)%XPATCH(ji) * nda%AL(jp)%XLWD(ji)
    !
    !    Upwards LW radiation
    da%XLWU  (imask) = da%XLWU  (imask) + np%AL(jp)%XPATCH(ji) * nda%AL(jp)%XLWU(ji)
    !
    !    Zonal wind stress
    da%XFMU  (imask) = da%XFMU  (imask) + np%AL(jp)%XPATCH(ji) * nda%AL(jp)%XFMU(ji)
    !
    !    Meridian wind stress
    da%XFMV  (imask) = da%XFMV  (imask) + np%AL(jp)%XPATCH(ji) * nda%AL(jp)%XFMV(ji)
    !
  ENDDO
END DO
!
IF (lhook) CALL dr_hook('AVERAGE_DIAG_ISBA_N:MAKE_AVERAGE',1,zhook_handle)
!
END SUBROUTINE make_average
!
!
END SUBROUTINE average_diag_isba_n