SURFEX  V8_0
Surfex V8_0 release
 All Classes Files Functions Variables
diag_surf_budget_teb.F90
Go to the documentation of this file.
1 !SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
2 !SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
3 !SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
4 !SFX_LIC for details. version 1.
5 ! #########
6  SUBROUTINE diag_surf_budget_teb (PDIR_SW, PSCA_SW, PDIR_ALB, PSCA_ALB, &
7  plw, pemis, ptrad, &
8  pswd, pswu, pswbd, pswbu, plwd, plwu )
9 ! ###############################################################################
10 !
11 !!**** *DIAG_SURF_BUDGET_TEB * - Computes diagnostics over TEB
12 !!
13 !! PURPOSE
14 !! -------
15 !
16 !!** METHOD
17 !! ------
18 !!
19 !! REFERENCE
20 !! ---------
21 !!
22 !!
23 !! AUTHOR
24 !! ------
25 !! P. Le Moigne
26 !!
27 !! MODIFICATIONS
28 !! -------------
29 !! Original 04/2006
30 !!------------------------------------------------------------------
31 !
32 
33 !
34 !
35 USE modd_csts, ONLY : xstefan
36 !
37 !
38 !
39 USE yomhook ,ONLY : lhook, dr_hook
40 USE parkind1 ,ONLY : jprb
41 !
42 IMPLICIT NONE
43 !
44 !* 0.1 declarations of arguments
45 !
46 REAL, DIMENSION(:,:),INTENT(IN) :: pdir_sw ! direct solar radiation (on horizontal surf.)
47 ! ! (W/m2)
48 REAL, DIMENSION(:,:),INTENT(IN) :: psca_sw ! diffuse solar radiation (on horizontal surf.)
49 ! ! (W/m2)
50 REAL, DIMENSION(:), INTENT(IN) :: plw ! longwave radiation (on horizontal surf.)
51 REAL, DIMENSION(:), INTENT(IN) :: ptrad ! radiative temperature (K)
52 REAL, DIMENSION(:,:),INTENT(IN) :: pdir_alb ! direct albedo for each spectral band (-)
53 REAL, DIMENSION(:,:),INTENT(IN) :: psca_alb ! diffuse albedo for each spectral band (-)
54 REAL, DIMENSION(:), INTENT(IN) :: pemis ! emissivity (-)
55 !
56 REAL, DIMENSION(:,:), INTENT(OUT):: pswbd ! incoming short wave radiation by spectral band (W/m2)
57 REAL, DIMENSION(:,:), INTENT(OUT):: pswbu ! upward short wave radiation by spectral band (W/m2)
58 REAL, DIMENSION(:), INTENT(OUT) :: pswd ! total incoming short wave radiation (W/m2)
59 REAL, DIMENSION(:), INTENT(OUT) :: pswu ! total upward short wave radiation (W/m2)
60 REAL, DIMENSION(:), INTENT(OUT) :: plwd ! Downward long wave radiation (W/m2)
61 REAL, DIMENSION(:), INTENT(OUT) :: plwu ! upward long wave radiation (W/m2)
62 !
63 
64 !
65 !* 0.2 declarations of local variables
66 !
67 INTEGER :: iswb ! number of SW bands
68 INTEGER :: jswb ! loop counter on number of SW bands
69 REAL(KIND=JPRB) :: zhook_handle
70 !-------------------------------------------------------------------------------------
71 !
72 !
73 IF (lhook) CALL dr_hook('DIAG_SURF_BUDGET_TEB',0,zhook_handle)
74 iswb = SIZE(pdir_sw,2)
75 !
76 !* total incoming and outgoing SW
77 !
78 DO jswb=1,iswb
79  pswbd(:,jswb) = pdir_sw(:,jswb) + psca_sw(:,jswb)
80  pswbu(:,jswb) = pdir_sw(:,jswb) * pdir_alb(:,jswb) + psca_sw(:,jswb) * psca_alb(:,jswb)
81 ENDDO
82 !
83 pswd(:) = 0.
84 pswu(:) = 0.
85 DO jswb=1,iswb
86  pswd(:)=pswd(:)+pswbd(:,jswb)
87  pswu(:)=pswu(:)+pswbu(:,jswb)
88 ENDDO
89 !
90 !*incoming outgoing LW
91 !
92 plwd(:)=plw(:)
93 plwu(:)=pemis(:)*xstefan*ptrad(:)**4 + (1.-pemis(:))*plw(:)
94 IF (lhook) CALL dr_hook('DIAG_SURF_BUDGET_TEB',1,zhook_handle)
95 !
96 !-------------------------------------------------------------------------------------
97 !
98 END SUBROUTINE diag_surf_budget_teb
subroutine diag_surf_budget_teb(PDIR_SW, PSCA_SW, PDIR_ALB, PSCA_ALB, PLW, PEMIS, PTRAD, PSWD, PSWU, PSWBD, PSWBU, PLWD, PLWU)