SURFEX v7.3
General documentation of Surfex
 All Classes Files Functions Variables Typedefs
/home/dasprezs/EXPORT_v7_3/src/SURFEX/diag_surf_budget_teb.F90
Go to the documentation of this file.
00001 !     #########
00002        SUBROUTINE DIAG_SURF_BUDGET_TEB (PDIR_SW, PSCA_SW, PDIR_ALB, PSCA_ALB,  &
00003                                           PLW, PEMIS, PTRAD,                     &
00004                                           PSWD, PSWU, PSWBD, PSWBU, PLWD, PLWU   )  
00005 !     ###############################################################################
00006 !
00007 !!****  *DIAG_SURF_BUDGET_TEB * - Computes diagnostics over TEB
00008 !!
00009 !!    PURPOSE
00010 !!    -------
00011 !
00012 !!**  METHOD
00013 !!    ------
00014 !!
00015 !!    REFERENCE
00016 !!    ---------
00017 !!      
00018 !!
00019 !!    AUTHOR
00020 !!    ------
00021 !!     P. Le Moigne 
00022 !!
00023 !!    MODIFICATIONS
00024 !!    -------------
00025 !!      Original    04/2006
00026 !!------------------------------------------------------------------
00027 !
00028 
00029 !
00030 !
00031 USE MODD_CSTS,           ONLY : XSTEFAN
00032 !
00033 ! 
00034 !
00035 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00036 USE PARKIND1  ,ONLY : JPRB
00037 !
00038 IMPLICIT NONE
00039 !
00040 !*      0.1    declarations of arguments
00041 !
00042 REAL, DIMENSION(:,:),INTENT(IN)  :: PDIR_SW   ! direct  solar radiation (on horizontal surf.)
00043 !                                             !                                       (W/m2)
00044 REAL, DIMENSION(:,:),INTENT(IN)  :: PSCA_SW   ! diffuse solar radiation (on horizontal surf.)
00045 !                                             !                                       (W/m2)
00046 REAL, DIMENSION(:), INTENT(IN)   :: PLW       ! longwave radiation (on horizontal surf.)
00047 REAL, DIMENSION(:), INTENT(IN)   :: PTRAD     ! radiative temperature                 (K)
00048 REAL, DIMENSION(:,:),INTENT(IN)  :: PDIR_ALB  ! direct albedo for each spectral band  (-)
00049 REAL, DIMENSION(:,:),INTENT(IN)  :: PSCA_ALB  ! diffuse albedo for each spectral band (-)
00050 REAL, DIMENSION(:), INTENT(IN)   :: PEMIS     ! emissivity                            (-)
00051 !
00052 REAL, DIMENSION(:,:), INTENT(OUT):: PSWBD     ! incoming short wave radiation by spectral band (W/m2)
00053 REAL, DIMENSION(:,:), INTENT(OUT):: PSWBU     ! upward  short wave radiation by spectral band (W/m2)
00054 REAL, DIMENSION(:), INTENT(OUT)  :: PSWD      ! total incoming short wave radiation (W/m2)
00055 REAL, DIMENSION(:), INTENT(OUT)  :: PSWU      ! total upward short wave radiation (W/m2)
00056 REAL, DIMENSION(:), INTENT(OUT)  :: PLWD      ! Downward long wave radiation (W/m2)
00057 REAL, DIMENSION(:), INTENT(OUT)  :: PLWU      ! upward long wave radiation (W/m2)  
00058 !
00059                                         
00060 !
00061 !*      0.2    declarations of local variables
00062 !
00063 INTEGER                          :: ISWB      ! number of SW bands
00064 INTEGER                          :: JSWB      ! loop counter on number of SW bands
00065 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00066 !-------------------------------------------------------------------------------------
00067 !
00068 !
00069 IF (LHOOK) CALL DR_HOOK('DIAG_SURF_BUDGET_TEB',0,ZHOOK_HANDLE)
00070 ISWB = SIZE(PDIR_SW,2)
00071 ! 
00072 !* total incoming and outgoing SW
00073 !
00074 DO JSWB=1,ISWB
00075   PSWBD(:,JSWB) = PDIR_SW(:,JSWB)                    + PSCA_SW(:,JSWB)
00076   PSWBU(:,JSWB) = PDIR_SW(:,JSWB) * PDIR_ALB(:,JSWB) + PSCA_SW(:,JSWB) * PSCA_ALB(:,JSWB) 
00077 ENDDO
00078 !
00079 PSWD(:) = 0.
00080 PSWU(:) = 0.
00081 DO JSWB=1,ISWB
00082    PSWD(:)=PSWD(:)+PSWBD(:,JSWB)
00083    PSWU(:)=PSWU(:)+PSWBU(:,JSWB)
00084 ENDDO
00085 !
00086 !*incoming outgoing LW
00087 !
00088 PLWD(:)=PLW(:)
00089 PLWU(:)=PEMIS(:)*XSTEFAN*PTRAD(:)**4 + (1.-PEMIS(:))*PLW(:)
00090 IF (LHOOK) CALL DR_HOOK('DIAG_SURF_BUDGET_TEB',1,ZHOOK_HANDLE)
00091 !
00092 !-------------------------------------------------------------------------------------
00093 !
00094 END SUBROUTINE DIAG_SURF_BUDGET_TEB