SURFEX  V8_0
Surfex V8_0 release
 All Classes Files Functions Variables
isba_albedo.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 isba_albedo(HSNOW, OTR_ML, OMEB, &
7  pdir_sw, psca_sw, psw_bands, ksw, &
8  palbnir, palbvis, palbuv, &
9  palbnir_veg, palbvis_veg, palbuv_veg, &
10  palbnir_soil, palbvis_soil, palbuv_soil, &
11  pfalb, pffv, pffg, &
12  pglobal_sw, psnowfree_alb, &
13  psnowfree_alb_veg, psnowfree_alb_soil, &
14  pmeb_sca_sw, &
15  palbnir_tveg, palbvis_tveg, &
16  palbnir_tsoil, palbvis_tsoil )
17 ! ##########################################################################
18 !
19 !!**** *ISBA_ALBEDO*
20 !!
21 !! PURPOSE
22 !! -------
23 !
24 ! Calculates grid-averaged albedo and emissivity (according to snow scheme)
25 !
26 !! EXTERNAL
27 !! --------
28 !!
29 !! none
30 !!
31 !! IMPLICIT ARGUMENTS
32 !! ------------------
33 !!
34 !! AUTHOR
35 !! ------
36 !!
37 !! S. Belair * Meteo-France *
38 !!
39 !! MODIFICATIONS
40 !! -------------
41 !! Original
42 !! P. Samuelsson 02/2012 MEB
43 !!
44 !-------------------------------------------------------------------------------
45 !
46 !* 0. DECLARATIONS
47 ! ------------
48 !
49 !
50 USE modd_surf_par, ONLY : xundef
51 !
52 USE modi_albedo_from_nir_vis
53 !
54 !
55 USE yomhook ,ONLY : lhook, dr_hook
56 USE parkind1 ,ONLY : jprb
57 !
58 IMPLICIT NONE
59 !
60 !* 0.1 declarations of arguments
61 !
62  CHARACTER(LEN=*) , INTENT(IN) :: hsnow ! ISBA snow scheme
63 LOGICAL, INTENT(IN) :: otr_ml
64 LOGICAL, INTENT(IN) :: omeb ! True = patch with multi-energy balance
65 ! ! False = patch with classical ISBA
66 !
67 REAL, DIMENSION(:,:), INTENT(IN) :: pdir_sw ! direct incoming solar radiation
68 REAL, DIMENSION(:,:), INTENT(IN) :: psca_sw ! diffus incoming solar radiation
69 REAL, DIMENSION(:) , INTENT(IN) :: psw_bands ! mean wavelength of each shortwave band (m)
70 INTEGER, INTENT(IN) :: ksw ! number of short-wave spectral bands
71 REAL, DIMENSION(:) , INTENT(IN) :: palbnir ! nearIR total albedo
72 REAL, DIMENSION(:) , INTENT(IN) :: palbvis ! visible total albedo
73 REAL, DIMENSION(:) , INTENT(IN) :: palbuv ! UV total albedo
74 REAL, DIMENSION(:) , INTENT(IN) :: palbnir_veg ! nearIR veg albedo
75 REAL, DIMENSION(:) , INTENT(IN) :: palbvis_veg ! visible veg albedo
76 REAL, DIMENSION(:) , INTENT(IN) :: palbuv_veg ! UV veg albedo
77 REAL, DIMENSION(:) , INTENT(IN) :: palbnir_soil ! nearIR soil albedo
78 REAL, DIMENSION(:) , INTENT(IN) :: palbvis_soil ! visible soil albedo
79 REAL, DIMENSION(:) , INTENT(IN) :: palbuv_soil ! UV soil albedo
80 REAL, DIMENSION(:) , INTENT(IN) :: pfalb ! Floodplain albedo
81 REAL, DIMENSION(:) , INTENT(IN) :: pffv ! Floodplain fraction over vegetation
82 REAL, DIMENSION(:) , INTENT(IN) :: pffg ! Floodplain fraction over the ground
83 !
84 REAL, DIMENSION(:) , INTENT(OUT) :: pglobal_sw ! global incoming SW rad.
85 REAL, DIMENSION(:) , INTENT(OUT) :: pmeb_sca_sw ! diffuse incoming SW rad.
86 REAL, DIMENSION(:) , INTENT(OUT) :: psnowfree_alb !snow free albedo
87 REAL, DIMENSION(:) , INTENT(OUT) :: psnowfree_alb_veg !snow free albedo of vegetation for EBA
88 REAL, DIMENSION(:) , INTENT(OUT) :: psnowfree_alb_soil !snow free albedo of soil for EBA option
89 REAL, DIMENSION(:) , INTENT(OUT) :: palbnir_tveg ! nearIR veg tot albedo
90 REAL, DIMENSION(:) , INTENT(OUT) :: palbvis_tveg ! visible veg tot albedo
91 REAL, DIMENSION(:) , INTENT(OUT) :: palbnir_tsoil ! nearIR soil tot albedo
92 REAL, DIMENSION(:) , INTENT(OUT) :: palbvis_tsoil ! visible soil tot albedo
93 !
94 !-------------------------------------------------------------------------------
95 !
96 !* 0. Local variables
97 ! ---------------
98 !
99 INTEGER :: jlayer
100 INTEGER :: jswb
101 REAL, DIMENSION(SIZE(PALBNIR)) :: zsw_up
102 REAL, DIMENSION(SIZE(PALBNIR),KSW) :: zdir_alb_without_snow
103 REAL, DIMENSION(SIZE(PALBNIR),KSW) :: zsca_alb_without_snow
104 REAL, DIMENSION(SIZE(PALBNIR),KSW) :: zdir_alb_veg_without_snow
105 REAL, DIMENSION(SIZE(PALBNIR),KSW) :: zsca_alb_veg_without_snow
106 REAL, DIMENSION(SIZE(PALBNIR),KSW) :: zdir_alb_soil_without_snow
107 REAL, DIMENSION(SIZE(PALBNIR),KSW) :: zsca_alb_soil_without_snow
108 REAL(KIND=JPRB) :: zhook_handle
109 !
110 !-------------------------------------------------------------------------------
111 !
112 !* 2. Compute snow-free albedo
113 ! ------------------------
114 !
115 !* Snow-free surface albedo for each wavelength
116 !
117 IF (lhook) CALL dr_hook('ISBA_ALBEDO',0,zhook_handle)
118 !
119 IF (otr_ml )THEN
120  IF (omeb) THEN
121  palbnir_tveg(:) = palbnir_veg(:)
122  palbnir_tsoil(:) = ( 1.-pffg(:))*palbnir_soil(:) + pffg(:)*pfalb(:)
123  palbvis_tveg(:) = palbvis_veg(:)
124  palbvis_tsoil(:) = ( 1.-pffg(:))*palbvis_soil(:) + pffg(:)*pfalb(:)
125  ELSE
126  palbnir_tveg(:) = palbnir_veg(:)
127  palbnir_tsoil(:) = palbnir_soil(:)
128  palbvis_tveg(:) = palbvis_veg(:)
129  palbvis_tsoil(:) = palbvis_soil(:)
130  ENDIF
131 ELSE
132  palbnir_tveg(:) = xundef
133  palbnir_tsoil(:) = xundef
134  palbvis_tveg(:) = xundef
135  palbvis_tsoil(:) = xundef
136 ENDIF
137 !
138  CALL albedo_from_nir_vis(psw_bands, palbnir, palbvis, palbuv, &
139  zdir_alb_without_snow, zsca_alb_without_snow )
140 !
141 !* total shortwave incoming radiation
142 !
143  pglobal_sw(:) = 0.
144  pmeb_sca_sw(:) = 0.
145  DO jswb=1,ksw
146  pglobal_sw(:) = pglobal_sw(:) + (pdir_sw(:,jswb) + psca_sw(:,jswb))
147  pmeb_sca_sw(:) = pmeb_sca_sw(:) + (psca_sw(:,jswb))
148  END DO
149 !
150 !* snow-free global albedo (needed by ISBA)
151 !
152  zsw_up(:) = 0.
153  DO jswb=1,ksw
154  zsw_up(:) = zsw_up(:) &
155  + zdir_alb_without_snow(:,jswb) * pdir_sw(:,jswb) &
156  + zsca_alb_without_snow(:,jswb) * psca_sw(:,jswb)
157  END DO
158  psnowfree_alb(:) = xundef
159  WHERE(pglobal_sw(:)>0.)
160  psnowfree_alb(:) = zsw_up(:) / pglobal_sw(:)
161  ELSEWHERE
162  psnowfree_alb(:) = zdir_alb_without_snow(:,1)
163  END WHERE
164 !
165  IF(hsnow == 'EBA') THEN
166  CALL albedo_from_nir_vis(psw_bands, &
167  palbnir_veg, palbvis_veg, palbuv_veg, &
168  zdir_alb_veg_without_snow, &
169  zsca_alb_veg_without_snow )
170  zsw_up(:) = 0.
171  DO jswb=1,ksw
172  zsw_up(:) = zsw_up(:) &
173  + zdir_alb_veg_without_snow(:,jswb) * pdir_sw(:,jswb) &
174  + zsca_alb_veg_without_snow(:,jswb) * psca_sw(:,jswb)
175  END DO
176  psnowfree_alb_veg(:) = xundef
177  WHERE(pglobal_sw(:)>0.) psnowfree_alb_veg(:) = zsw_up(:) / pglobal_sw(:)
178 !
179  CALL albedo_from_nir_vis(psw_bands, &
180  palbnir_soil, palbvis_soil, palbuv_soil, &
181  zdir_alb_soil_without_snow, &
182  zsca_alb_soil_without_snow )
183  zsw_up(:) = 0.
184  DO jswb=1,ksw
185  zsw_up(:) = zsw_up(:) &
186  + zdir_alb_soil_without_snow(:,jswb) * pdir_sw(:,jswb) &
187  + zsca_alb_soil_without_snow(:,jswb) * psca_sw(:,jswb)
188  END DO
189  psnowfree_alb_soil(:) = xundef
190  WHERE(pglobal_sw(:)>0.) psnowfree_alb_soil(:) = zsw_up(:) / pglobal_sw(:)
191  ENDIF
192 IF (lhook) CALL dr_hook('ISBA_ALBEDO',1,zhook_handle)
193 !
194 !-------------------------------------------------------------------------------
195 !
196 END SUBROUTINE isba_albedo
albedo_from_nir_vis
subroutine albedo_from_nir_vis(PSW_BANDS, PALBNIR, PALBVIS, PALBUV, PDIR_ALB, PSCA_ALB)
Definition: albedo_from_nir_vis.F90:6
isba_albedo
subroutine isba_albedo(HSNOW, OTR_ML, OMEB, PDIR_SW, PSCA_SW, PSW_BANDS, KSW, PALBNIR, PALBVIS, PALBUV, PALBNIR_VEG, PALBVIS_VEG, PALBUV_VEG, PALBNIR_SOIL, PALBVIS_SOIL, PALBUV_SOIL, PFALB, PFFV, PFFG, PGLOBAL_SW, PSNOWFREE_ALB, PSNOWFREE_ALB_VEG, PSNOWFREE_ALB_SOIL, PMEB_SCA_SW, PALBNIR_TVEG, PALBVIS_TVEG, PALBNIR_TSOIL, PALBVIS_TSOIL)
Definition: isba_albedo.F90:6
modd_surf_par
Definition: modd_surf_par.F90:6
Generated on Fri May 13 2016 09:31:04 for SURFEX by   doxygen 1.8.5