get_fluxn.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 get_flux_n (DGU, &
                             hprogram,ki,prn,ph,ple,plei,pgflux,pt2m,pq2m,   &
                            phu2m,pzon10m,pmer10m,psurflwnet,psurfswnet,pcd,&  
                            pevap, psubl                                    )  
!     ########################################
!
!!****  *GET_FLUX_n* - routine to get some surface fields
!!
!!    PURPOSE
!!    -------
!!
!!**  METHOD
!!    ------
!!
!!    EXTERNAL
!!    --------
!!
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!    REFERENCE
!!    ---------
!!
!!
!!    AUTHOR
!!    ------
!!      V. Masson   *Meteo France*
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    01/2004
!       B. decharme 04/2013 : Add EVAP and SUBL diag
!-------------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!              ------------
!
!
USE modd_diag_surf_atm_n, ONLY : diag_surf_atm_t
!
USE modi_get_luout
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_surf_atm_t), INTENT(INOUT) :: dgu
!
 CHARACTER(LEN=6),     INTENT(IN)     :: hprogram
INTEGER,              INTENT(IN)     :: ki        ! Number of points
REAL, DIMENSION(KI),  INTENT(OUT)    :: prn       ! Net radiation at surface    (W/m2)
REAL, DIMENSION(KI),  INTENT(OUT)    :: ph        ! Sensible heat flux          (W/m2)
REAL, DIMENSION(KI),  INTENT(OUT)    :: ple       ! Total Latent heat flux      (W/m2)
REAL, DIMENSION(KI),  INTENT(OUT)    :: plei      ! Solid Latent heat flux      (W/m2)
REAL, DIMENSION(KI),  INTENT(OUT)    :: pgflux    ! Net soil-vegetation flux    (W/m2)
REAL, DIMENSION(KI),  INTENT(OUT)    :: pt2m      ! Air temperature at 2 meters (K)
REAL, DIMENSION(KI),  INTENT(OUT)    :: pq2m      ! Air humidity at 2 meters    (kg/kg)
REAL, DIMENSION(KI),  INTENT(OUT)    :: phu2m     ! Air relative humidity at 2 meters (-)
REAL, DIMENSION(KI),  INTENT(OUT)    :: pzon10m   ! zonal Wind at 10 meters     (m/s)
REAL, DIMENSION(KI),  INTENT(OUT)    :: pmer10m   ! meridian Wind at 10 meters  (m/s)
REAL, DIMENSION(KI),  INTENT(OUT)    :: psurflwnet   ! LW net at the surface
REAL, DIMENSION(KI),  INTENT(OUT)    :: psurfswnet   ! SW net at the surface
REAL, DIMENSION(KI),  INTENT(OUT)    :: pcd       ! exchange coeficient at the surface
REAL, DIMENSION(KI),  INTENT(OUT)    :: pevap     ! Total evapotranspiration  (kg/m2/s)
REAL, DIMENSION(KI),  INTENT(OUT)    :: psubl     ! Sublimation (kg/m2/s)
!
!
!*       0.2   Declarations of local variables
!              -------------------------------
!
INTEGER :: iluout
REAL(KIND=JPRB) :: zhook_handle
!
!-------------------------------------------------------------------------------
IF (lhook) CALL dr_hook('GET_FLUX_N',0,zhook_handle)
 CALL get_luout(hprogram,iluout)
!-------------------------------------------------------------------------------
!
IF (dgu%LSURF_BUDGET)      THEN 
        prn       = dgu%XAVG_RN      
        ph        = dgu%XAVG_H  
        ple       = dgu%XAVG_LE 
        plei      = dgu%XAVG_LEI 
        pgflux    = dgu%XAVG_GFLUX 
        psurflwnet= dgu%XAVG_LWD-dgu%XAVG_LWU
        psurfswnet= dgu%XAVG_SWD-dgu%XAVG_SWU
        pevap     = dgu%XAVG_EVAP
        psubl     = dgu%XAVG_SUBL
   ELSE 
        prn       = xundef
        ph        = xundef
        ple       = xundef
        plei      = xundef
        pgflux    = xundef
        psurflwnet= xundef
        psurfswnet= xundef  
        pevap     = xundef
        psubl     = xundef        
ENDIF           
!
IF (dgu%N2M>0)      THEN 
        pt2m      = dgu%XAVG_T2M
        pq2m      = dgu%XAVG_Q2M
        phu2m     = dgu%XAVG_HU2M
        pzon10m   = dgu%XAVG_ZON10M
        pmer10m   = dgu%XAVG_MER10M
   ELSE 
        pt2m     = xundef
        pq2m     = xundef
        phu2m    = xundef
        pzon10m  = xundef
        pmer10m  = xundef
ENDIF   
!
IF (dgu%LCOEF) THEN
  pcd      = dgu%XAVG_CD
ELSE
  pcd      = xundef
ENDIF
!
IF (lhook) CALL dr_hook('GET_FLUX_N',1,zhook_handle)
!==============================================================================
!
END SUBROUTINE get_flux_n