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 (DGEI, DGI, I, &
                                      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_evap_isba_n, ONLY : diag_evap_isba_t
USE modd_diag_isba_n, ONLY : diag_isba_t
USE modd_isba_n, ONLY : isba_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_evap_isba_t), INTENT(INOUT) :: dgei
TYPE(diag_isba_t), INTENT(INOUT) :: dgi
TYPE(isba_t), INTENT(INOUT) :: i
!
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                              :: jpatch ! tile loop counter
INTEGER                              :: jswb   ! band loop counter
REAL, DIMENSION(SIZE(I%XPATCH,1))      :: zsumpatch
REAL(KIND=JPRB) :: zhook_handle
!
!-------------------------------------------------------------------------------
!
!       0.     Initialization
!              --------------
!
IF (lhook) CALL dr_hook('AVERAGE_DIAG_ISBA_N',0,zhook_handle)
zsumpatch(:) = 0.
DO jpatch=1,SIZE(i%XPATCH,2)
  zsumpatch(:) = zsumpatch(:) + i%XPATCH(:,jpatch)
END DO
!
!       1.     Energy fluxes
!              -------------
!
IF (dgi%LSURF_BUDGET) THEN
  dgi%XAVG_RN(:)     = 0.
  dgi%XAVG_H (:)     = 0.
  dgi%XAVG_LE(:)     = 0.
  dgi%XAVG_LEI(:)    = 0.
  dgi%XAVG_GFLUX(:)  = 0.
  dgi%XAVG_SWD(:)    = 0.
  dgi%XAVG_SWU(:)    = 0.
  dgi%XAVG_LWD(:)    = 0.
  dgi%XAVG_LWU(:)    = 0.
  dgi%XAVG_FMU(:)    = 0.
  dgi%XAVG_FMV(:)    = 0.
  dgi%XAVG_SWBD(:,:) = 0.
  dgi%XAVG_SWBU(:,:) = 0.
  !
  DO jpatch=1,SIZE(i%XPATCH,2)
    WHERE (zsumpatch(:) > 0.)
!
! Net radiation
!
      dgi%XAVG_RN(:)  = dgi%XAVG_RN(:) +i%XPATCH(:,jpatch) * dgi%XRN(:,jpatch)
!
! Sensible heat flux
!
      dgi%XAVG_H (:)  = dgi%XAVG_H (:) +i%XPATCH(:,jpatch) * dgi%XH (:,jpatch)
!
! Total latent heat flux
!
      dgi%XAVG_LE(:)  = dgi%XAVG_LE(:) +i%XPATCH(:,jpatch) * i%XLE(:,jpatch)
!
! Sublimation latent heat flux
!
      dgi%XAVG_LEI(:) = dgi%XAVG_LEI(:) +i%XPATCH(:,jpatch) * dgi%XLEI(:,jpatch)
!
! Storage flux
!
      dgi%XAVG_GFLUX(:)  = dgi%XAVG_GFLUX(:) +i%XPATCH(:,jpatch) * dgi%XGFLUX(:,jpatch)
!
! Downwards SW radiation
!
      dgi%XAVG_SWD(:)  = dgi%XAVG_SWD(:) +i%XPATCH(:,jpatch) * dgi%XSWD(:,jpatch)
!
! Upwards SW radiation
!
      dgi%XAVG_SWU(:)  = dgi%XAVG_SWU(:) +i%XPATCH(:,jpatch) * dgi%XSWU(:,jpatch)
!
! Downwards LW radiation
!
      dgi%XAVG_LWD(:)  = dgi%XAVG_LWD(:) +i%XPATCH(:,jpatch) * dgi%XLWD(:,jpatch)
!
! Upwards LW radiation
!
      dgi%XAVG_LWU(:)  = dgi%XAVG_LWU(:) +i%XPATCH(:,jpatch) * dgi%XLWU(:,jpatch)
!
! Zonal wind stress
!
      dgi%XAVG_FMU(:)  = dgi%XAVG_FMU(:) +i%XPATCH(:,jpatch) * dgi%XFMU(:,jpatch)
!
! Meridian wind stress
!
      dgi%XAVG_FMV(:)  = dgi%XAVG_FMV(:) +i%XPATCH(:,jpatch) * dgi%XFMV(:,jpatch)
!
    END WHERE
  END DO
!
  DO jpatch=1,SIZE(i%XPATCH,2)
    DO jswb=1,SIZE(dgi%XSWBD,2)
      WHERE (zsumpatch(:) > 0.)
!
! Downwards SW radiation for each spectral band
!
        dgi%XAVG_SWBD(:,jswb)  = dgi%XAVG_SWBD(:,jswb) +i%XPATCH(:,jpatch) * dgi%XSWBD(:,jswb,jpatch)
!
! Upwards SW radiation for each spectral band
!
        dgi%XAVG_SWBU(:,jswb)  = dgi%XAVG_SWBU(:,jswb) +i%XPATCH(:,jpatch) * dgi%XSWBU(:,jswb,jpatch)
!
      END WHERE
    END DO
  END DO
END IF
!
IF (dgei%LSURF_BUDGETC) THEN
   dgi%XAVG_SWDC(:) = 0.
   dgi%XAVG_SWUC(:) = 0.
   dgi%XAVG_LWDC(:) = 0.
   dgi%XAVG_LWUC(:) = 0.
   dgi%XAVG_FMUC(:) = 0.
   dgi%XAVG_FMVC(:) = 0.
   DO jpatch=1,SIZE(i%XPATCH,2)
      WHERE (zsumpatch(:) > 0.)
!
!        Downwards SW radiation
!
         dgi%XAVG_SWDC(:) = dgi%XAVG_SWDC(:) + i%XPATCH(:,jpatch) * dgi%XSWDC(:,jpatch)
!
!        Upwards SW radiation
!
         dgi%XAVG_SWUC(:) = dgi%XAVG_SWUC(:) + i%XPATCH(:,jpatch) * dgi%XSWUC(:,jpatch)
!
!        Downwards LW radiation
!
         dgi%XAVG_LWDC(:) = dgi%XAVG_LWDC(:) + i%XPATCH(:,jpatch) * dgi%XLWDC(:,jpatch)
!
!        Upwards LW radiation
!
         dgi%XAVG_LWUC(:) = dgi%XAVG_LWUC(:) + i%XPATCH(:,jpatch) * dgi%XLWUC(:,jpatch)
!
!        Zonal wind stress
!
         dgi%XAVG_FMUC(:) = dgi%XAVG_FMUC(:) + i%XPATCH(:,jpatch) * dgi%XFMUC(:,jpatch)
!
!        Meridian wind stress
!
         dgi%XAVG_FMVC(:) = dgi%XAVG_FMVC(:) + i%XPATCH(:,jpatch) * dgi%XFMVC(:,jpatch)
!
    END WHERE
  END DO
ENDIF    
!
!
!       2.     surface temperature and 2 meters parameters
!              -------------------------------------------
!
dgi%XAVG_TS(:) = 0.0
DO jpatch=1,SIZE(i%XPATCH,2)
    WHERE (zsumpatch(:) > 0.)
       dgi%XAVG_TS(:)  = dgi%XAVG_TS(:) + i%XPATCH(:,jpatch) * dgi%XTS(:,jpatch)
    END WHERE
END DO
!
IF (.NOT. i%LCANOPY .AND. dgi%N2M>=1) THEN

  dgi%XAVG_T2M(:)  = 0.
  dgi%XAVG_Q2M(:)  = 0.
  dgi%XAVG_HU2M(:)  = 0.
  !
  DO jpatch=1,SIZE(i%XPATCH,2)
    WHERE (zsumpatch(:) > 0.)
!
! 2 meters temperature
!
      dgi%XAVG_T2M(:)  = dgi%XAVG_T2M(:) + i%XPATCH(:,jpatch) * dgi%XT2M(:,jpatch)
!
! 2 meters humidity
!
      dgi%XAVG_Q2M(:)  = dgi%XAVG_Q2M(:) + i%XPATCH(:,jpatch) * dgi%XQ2M(:,jpatch)
!
! 2 meters relative humidity
!
      dgi%XAVG_HU2M(:)  = dgi%XAVG_HU2M(:) + i%XPATCH(:,jpatch) * dgi%XHU2M(:,jpatch)
!
    END WHERE
  END DO
!
! 10 meters wind
!
  dgi%XAVG_ZON10M (:)  = 0.
  dgi%XAVG_MER10M (:)  = 0.
  dgi%XAVG_WIND10M(:)  = 0.
  DO jpatch=1,SIZE(i%XPATCH,2)
    WHERE (zsumpatch(:) > 0.)
      dgi%XAVG_ZON10M(:)  = dgi%XAVG_ZON10M (:) + i%XPATCH(:,jpatch) * dgi%XZON10M (:,jpatch)
      dgi%XAVG_MER10M(:)  = dgi%XAVG_MER10M (:) + i%XPATCH(:,jpatch) * dgi%XMER10M (:,jpatch)
      dgi%XAVG_WIND10M(:) = dgi%XAVG_WIND10M(:) + i%XPATCH(:,jpatch) * dgi%XWIND10M(:,jpatch)
    END WHERE
  ENDDO
!
  dgi%XAVG_T2M_MIN(:) = min(dgi%XAVG_T2M_MIN(:),dgi%XAVG_T2M(:))
  dgi%XAVG_T2M_MAX(:) = max(dgi%XAVG_T2M_MAX(:),dgi%XAVG_T2M(:))
!
  dgi%XAVG_HU2M_MIN(:) = min(dgi%XAVG_HU2M_MIN(:),dgi%XAVG_HU2M(:))
  dgi%XAVG_HU2M_MAX(:) = max(dgi%XAVG_HU2M_MAX(:),dgi%XAVG_HU2M(:))
!
  dgi%XAVG_WIND10M_MAX(:) = max(dgi%XAVG_WIND10M_MAX(:),dgi%XAVG_WIND10M(:))
!
END IF
!
! Richardson number
!
IF (dgi%N2M>=1) THEN

  dgi%XAVG_RI(:)  = 0.
  !
  dgi%XAVG_SFCO2(:)  = psfco2(:)
  !
  DO jpatch=1,SIZE(i%XPATCH,2)
    WHERE (zsumpatch(:) > 0.)
      dgi%XAVG_RI(:)  = dgi%XAVG_RI(:) + i%XPATCH(:,jpatch) * dgi%XRI(:,jpatch)
    END WHERE
  END DO
!
! min and max of XT2M
!
  dgi%XT2M_MIN(:,:) = min(dgi%XT2M_MIN(:,:),dgi%XT2M(:,:))
  dgi%XT2M_MAX(:,:) = max(dgi%XT2M_MAX(:,:),dgi%XT2M(:,:))
!
END IF
!
!       3.     Transfer coefficients
!              ---------------------
!
IF (dgi%LCOEF) THEN
  !
  dgi%XAVG_CD   (:) = 0.
  dgi%XAVG_CH   (:) = 0.
  dgi%XAVG_CE   (:) = 0.
  dgi%XAVG_Z0   (:) = 0.
  dgi%XAVG_Z0H  (:) = 0.
  dgi%XAVG_Z0EFF(:) = 0.
  !
  DO jpatch=1,SIZE(i%XPATCH,2)
    WHERE (zsumpatch(:) > 0.)
      !
      dgi%XAVG_CD(:)  = dgi%XAVG_CD(:) + i%XPATCH(:,jpatch) * dgi%XCD(:,jpatch)
      !
      dgi%XAVG_CH(:)  = dgi%XAVG_CH(:) + i%XPATCH(:,jpatch) * dgi%XCH(:,jpatch)
      !
      dgi%XAVG_CE(:)  = dgi%XAVG_CE(:) + i%XPATCH(:,jpatch) * dgi%XCE(:,jpatch)
      !
      !             
      dgi%XAVG_Z0(:)    = dgi%XAVG_Z0(:)    + i%XPATCH(:,jpatch) * 1./(log(phw(:)/dgi%XZ0_WITH_SNOW (:,jpatch)))**2
      !      
      dgi%XAVG_Z0H(:)   = dgi%XAVG_Z0H(:)   + i%XPATCH(:,jpatch) * 1./(log(pht(:)/dgi%XZ0H_WITH_SNOW(:,jpatch)))**2
      !      
      dgi%XAVG_Z0EFF(:) = dgi%XAVG_Z0EFF(:) + i%XPATCH(:,jpatch) * 1./(log(phw(:)/dgi%XZ0EFF        (:,jpatch)))**2
      !      
    END WHERE
  END DO
  !
  dgi%XAVG_Z0(:)    = phw(:) *  exp( - sqrt(1./dgi%XAVG_Z0(:)) )
  !
  dgi%XAVG_Z0H(:)   = pht(:) *  exp( - sqrt(1./dgi%XAVG_Z0H(:)) )
  !
  dgi%XAVG_Z0EFF(:) = phw(:) *  exp( - sqrt(1./dgi%XAVG_Z0EFF(:)) )
  !
END IF
!
IF (dgi%LSURF_VARS) THEN
  dgi%XAVG_QS(:)  = 0.
  !
  DO jpatch=1,SIZE(i%XPATCH,2)
    WHERE (zsumpatch(:) > 0.)
!
! specific humidity at surface
!
      dgi%XAVG_QS(:)  = dgi%XAVG_QS(:) + i%XPATCH(:,jpatch) * dgi%XQS(:,jpatch)
!
    END WHERE
  END DO
END IF
!
IF (lhook) CALL dr_hook('AVERAGE_DIAG_ISBA_N',1,zhook_handle)
!-------------------------------------------------------------------------------
!
END SUBROUTINE average_diag_isba_n