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 (DGO, D, &
                             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_n, ONLY : diag_t, diag_options_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_options_t), INTENT(IN) :: DGO
TYPE(diag_t), INTENT(INOUT) :: D
!
 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 (dgo%LSURF_BUDGET)      THEN 
        prn       = d%XRN      
        ph        = d%XH  
        ple       = d%XLE 
        plei      = d%XLEI 
        pgflux    = d%XGFLUX 
        psurflwnet= d%XLWD-d%XLWU
        psurfswnet= d%XSWD-d%XSWU
        pevap     = d%XEVAP
        psubl     = d%XSUBL
   ELSE 
        prn       = xundef
        ph        = xundef
        ple       = xundef
        plei      = xundef
        pgflux    = xundef
        psurflwnet= xundef
        psurfswnet= xundef  
        pevap     = xundef
        psubl     = xundef        
ENDIF           
!
IF (dgo%N2M>0)      THEN 
        pt2m      = d%XT2M
        pq2m      = d%XQ2M
        phu2m     = d%XHU2M
        pzon10m   = d%XZON10M
        pmer10m   = d%XMER10M
   ELSE 
        pt2m     = xundef
        pq2m     = xundef
        phu2m    = xundef
        pzon10m  = xundef
        pmer10m  = xundef
ENDIF   
!
IF (dgo%LCOEF) THEN
  pcd      = d%XCD
ELSE
  pcd      = xundef
ENDIF
!
IF (lhook) CALL dr_hook('GET_FLUX_N',1,zhook_handle)
!==============================================================================
!
END SUBROUTINE get_flux_n