|
SURFEX v7.3
General documentation of Surfex
|
|
SURFEX v7.3
General documentation of Surfex
|
00001 ! ######### 00002 SUBROUTINE ISBA_SNOW_AGR( HSNOW_ISBA, & 00003 PEMIS, PALB, & 00004 PPSN, PPSNG, PPSNV, & 00005 PRN, PH, PLE, PLEI, PLEG, PLEGI, PLEV, PLES, PLER, & 00006 PLETR, PEVAP, PGFLUX, PLVTT, PLSTT, & 00007 PUSTAR, & 00008 PLES3L, PLEL3L, PEVAP3L, & 00009 PRI3L, PALB3L, & 00010 PRNSNOW, PHSNOW, PHPSNOW, & 00011 PGFLUXSNOW, PUSTARSNOW, & 00012 PGRNDFLUX, PLESL, & 00013 PEMISNOW, & 00014 PSNOWTEMP, PTS_RAD, PTS, PRI, PSNOWHMASS, & 00015 PRN_ISBA, PH_ISBA, PLEG_ISBA, PLEGI_ISBA, PLEV_ISBA, & 00016 PLETR_ISBA, PUSTAR_ISBA, PLER_ISBA, PLE_ISBA, & 00017 PLEI_ISBA, PGFLUX_ISBA, PMELTADV, PTS_RAD_SNOWFREE, & 00018 PTG, PEMIST, PALBT, PLE_FLOOD, PLEI_FLOOD, PFFG, & 00019 PFFV, PFF ) 00020 ! ########################################################################## 00021 ! 00022 ! 00023 !!**** *ISBA_SNOW_AGR* aggregates snow free and snow fluxes 00024 !! 00025 !! PURPOSE 00026 !! ------- 00027 ! 00028 !!** METHOD 00029 !! ------ 00030 ! 00031 !! EXTERNAL 00032 !! -------- 00033 !! 00034 !! IMPLICIT ARGUMENTS 00035 !! ------------------ 00036 !! 00037 !! 00038 !! REFERENCE 00039 !! --------- 00040 !! 00041 !! Noilhan and Planton (1989) 00042 !! 00043 !! AUTHOR 00044 !! ------ 00045 !! V. Masson * Meteo-France * 00046 !! (following A. Boone) 00047 !! 00048 !! MODIFICATIONS 00049 !! ------------- 00050 !! Original 10/03/95 00051 !! B. Decharme 01/2009 Floodplains 00052 !! B. Decharme 01/2010 Effective surface temperature (for diag) 00053 !! B. Decharme 09/2012 Bug total sublimation flux: no PLESL 00054 00055 !------------------------------------------------------------------------------- 00056 ! 00057 !* 0. DECLARATIONS 00058 ! ------------ 00059 USE MODD_SURF_PAR, ONLY : XUNDEF 00060 ! 00061 ! 00062 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00063 USE PARKIND1 ,ONLY : JPRB 00064 ! 00065 IMPLICIT NONE 00066 ! 00067 !* 0.1 declarations of arguments 00068 ! ------------------------- 00069 ! 00070 ! 00071 !* general variables 00072 ! ----------------- 00073 ! 00074 CHARACTER(LEN=*), INTENT(IN) :: HSNOW_ISBA ! 'DEF' = Default F-R snow scheme 00075 ! ! (Douville et al. 1995) 00076 ! ! '3-L' = 3-L snow scheme (option) 00077 ! ! (Boone and Etchevers 2000) 00078 ! 00079 !* surface parameters 00080 ! ------------------ 00081 ! 00082 REAL, DIMENSION(:), INTENT(IN) :: PALB ! albedo 00083 REAL, DIMENSION(:), INTENT(IN) :: PEMIS ! emissivity 00084 ! 'D95' : they represent aggregated (snow + flood + snow-flood-free) albedo and emissivity 00085 ! '3-L' : they represent flood + snow-flood-free albedo and emissivity 00086 ! 00087 ! 00088 !* snow fractions 00089 ! -------------- 00090 ! 00091 REAL, DIMENSION(:), INTENT(IN) :: PPSN ! fraction of the grid covered 00092 ! ! by snow 00093 REAL, DIMENSION(:), INTENT(IN) :: PPSNG ! fraction of the the bare 00094 ! ! ground covered by snow 00095 REAL, DIMENSION(:), INTENT(IN) :: PPSNV ! fraction of the the veg. 00096 ! ! covered by snow 00097 ! 00098 ! 00099 !* ISBA-SNOW3L variables/parameters: 00100 ! --------------------------------- 00101 ! 00102 ! Prognostic variables: 00103 ! 00104 REAL, DIMENSION(:), INTENT(IN) :: PALB3L ! Snow albedo 00105 REAL, DIMENSION(:), INTENT(IN) :: PRI3L ! Snow Ridcharson number 00106 ! 00107 ! Diagnostics: 00108 ! 00109 REAL, DIMENSION(:), INTENT(INOUT) :: PGRNDFLUX ! snow/soil-biomass interface flux (W/m2) 00110 ! 00111 REAL, DIMENSION(:), INTENT(INOUT) :: PHPSNOW ! heat release from rainfall (W/m2) 00112 REAL, DIMENSION(:), INTENT(INOUT) :: PSNOWHMASS ! snow heat content change from mass changes (J/m2) 00113 REAL, DIMENSION(:), INTENT(INOUT) :: PRNSNOW ! net radiative flux from snow (W/m2) 00114 REAL, DIMENSION(:), INTENT(INOUT) :: PHSNOW ! sensible heat flux from snow (W/m2) 00115 REAL, DIMENSION(:), INTENT(INOUT) :: PGFLUXSNOW ! net heat flux from snow (W/m2) 00116 REAL, DIMENSION(:), INTENT(IN) :: PUSTARSNOW ! friction velocity 00117 REAL, DIMENSION(:), INTENT(OUT) :: PLESL ! Evaporation (liquid) from wet snow (W/m2) 00118 REAL, DIMENSION(:), INTENT(IN) :: PEMISNOW ! snow surface emissivity 00119 REAL, DIMENSION(:), INTENT(OUT) :: PTS_RAD ! effective radiative temperature 00120 ! of the natural surface (K) 00121 REAL, DIMENSION(:), INTENT(OUT) :: PTS ! effective surface temperature 00122 REAL, DIMENSION(:,:), INTENT(IN) :: PSNOWTEMP ! snow layer temperatures (K) 00123 REAL, DIMENSION(:), INTENT(IN) :: PLES3L ! sublimation from ISBA-ES(3L) 00124 REAL, DIMENSION(:), INTENT(IN) :: PLEL3L ! evaporation heat flux of water in the snow (W/m2) 00125 REAL, DIMENSION(:), INTENT(IN) :: PEVAP3L ! evaporation flux over snow from ISBA-ES (kg/m2/s) 00126 REAL, DIMENSION(:), INTENT(IN) :: PLVTT, PLSTT 00127 ! 00128 ! 00129 ! Prognostic variables: 00130 ! 00131 REAL, DIMENSION(:), INTENT(IN) :: PTS_RAD_SNOWFREE ! soil layer average temperatures (K) 00132 REAL, DIMENSION(:,:), INTENT(IN) :: PTG ! soil layer average temperatures (K) 00133 00134 ! 00135 ! 00136 !* diagnostic variables 00137 ! -------------------- 00138 ! 00139 REAL, DIMENSION(:), INTENT(INOUT) :: PEMIST ! total surface emissivity 00140 REAL, DIMENSION(:), INTENT(INOUT) :: PALBT ! total surface albedo 00141 ! 00142 !* surface fluxes 00143 ! -------------- 00144 ! 00145 REAL, DIMENSION(:), INTENT(INOUT) :: PRN ! net radiation 00146 REAL, DIMENSION(:), INTENT(INOUT) :: PH ! sensible heat flux 00147 REAL, DIMENSION(:), INTENT(INOUT) :: PLE ! total latent heat flux 00148 REAL, DIMENSION(:), INTENT(OUT) :: PLEI ! sublimation latent heat flux 00149 REAL, DIMENSION(:), INTENT(INOUT) :: PLEGI ! latent heat of sublimation over frozen soil 00150 REAL, DIMENSION(:), INTENT(INOUT) :: PLEG ! latent heat of evaporation 00151 ! ! over the ground 00152 REAL, DIMENSION(:), INTENT(INOUT) :: PLEV ! latent heat of evaporation 00153 ! ! over the vegetation 00154 REAL, DIMENSION(:), INTENT(INOUT) :: PLES ! latent heat of sublimation 00155 ! ! over the snow 00156 REAL, DIMENSION(:), INTENT(INOUT) :: PLER ! latent heat of the fraction 00157 ! ! delta of water retained on the 00158 ! ! foliage of the vegetation 00159 REAL, DIMENSION(:), INTENT(INOUT) :: PLETR ! evapotranspiration of the rest 00160 ! ! of the vegetation 00161 REAL, DIMENSION(:), INTENT(INOUT) :: PEVAP ! total evaporative flux (kg/m2/s) 00162 REAL, DIMENSION(:), INTENT(INOUT) :: PGFLUX ! flux through the ground 00163 REAL, DIMENSION(:), INTENT(INOUT) :: PUSTAR ! friction velocity 00164 REAL, DIMENSION(:), INTENT(INOUT) :: PMELTADV ! advection heat flux from snowmelt (W/m2) 00165 ! 00166 ! The following surface fluxes are from snow-free portion of grid 00167 ! box when the ISBA-ES option is ON. Otherwise, they are equal 00168 ! to the same variables without the _ISBA extension. 00169 ! 00170 REAL, DIMENSION(:), INTENT(OUT) :: PRN_ISBA ! net radiation 00171 REAL, DIMENSION(:), INTENT(OUT) :: PH_ISBA ! sensible heat flux 00172 REAL, DIMENSION(:), INTENT(OUT) :: PLEG_ISBA ! latent heat of evaporation (ground) 00173 REAL, DIMENSION(:), INTENT(OUT) :: PLEGI_ISBA ! latent heat of sublimation (ground) 00174 REAL, DIMENSION(:), INTENT(OUT) :: PLEV_ISBA ! latent heat of evaporation (vegetation) 00175 REAL, DIMENSION(:), INTENT(OUT) :: PLETR_ISBA ! latent heat of evaporation (transpiration) 00176 REAL, DIMENSION(:), INTENT(OUT) :: PUSTAR_ISBA! friction velocity 00177 REAL, DIMENSION(:), INTENT(OUT) :: PLER_ISBA ! latent heat of evaporation (plant interception) 00178 REAL, DIMENSION(:), INTENT(OUT) :: PLE_ISBA ! total latent heat flux 00179 REAL, DIMENSION(:), INTENT(OUT) :: PLEI_ISBA ! sublimation latent heat flux 00180 REAL, DIMENSION(:), INTENT(OUT) :: PGFLUX_ISBA! flux through the ground 00181 ! 00182 REAL, DIMENSION(:), INTENT(IN) :: PFFG,PFFV,PFF 00183 REAL, DIMENSION(:), INTENT(INOUT) :: PLE_FLOOD, PLEI_FLOOD ! Flood evaporation 00184 ! 00185 REAL, DIMENSION(:), INTENT(OUT) :: PRI ! Total Ridcharson number 00186 ! 00187 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00188 ! 00189 !* 0.2 declarations of local variables 00190 ! 00191 !------------------------------------------------------------------------------- 00192 ! 00193 IF (LHOOK) CALL DR_HOOK('ISBA_SNOW_AGR',0,ZHOOK_HANDLE) 00194 IF(HSNOW_ISBA == '3-L' .OR. HSNOW_ISBA == 'CRO')THEN 00195 ! 00196 ! Save fluxes from Force-Restore snow/explicit snow-free 00197 ! portion of grid box (vegetation/soil): 00198 ! 00199 PRN_ISBA(:) = PRN(:) 00200 PH_ISBA(:) = PH(:) 00201 PLEG_ISBA(:) = PLEG(:) 00202 PLEGI_ISBA(:) = PLEGI(:) 00203 PLEV_ISBA(:) = PLEV(:) 00204 PLETR_ISBA(:) = PLETR(:) 00205 PUSTAR_ISBA(:) = PUSTAR(:) 00206 PLER_ISBA(:) = PLER(:) 00207 PLE_ISBA(:) = PLE(:) 00208 PGFLUX_ISBA(:) = PGFLUX(:) 00209 ! 00210 PLEI_ISBA(:) = PLEGI(:)+PLEI_FLOOD(:)+PLES(:) 00211 ! 00212 ! Effective surface temperature (for diag): 00213 ! 00214 PTS(:) = (1.-PPSN(:))*PTG(:,1)+PPSN(:)*PSNOWTEMP(:,1) 00215 ! 00216 ! Effective surface radiating temperature: 00217 ! 00218 PALBT(:) = PALB(:)*(1.-PPSN(:)) + PPSN(:)*PALB3L(:) 00219 PEMIST(:) = PEMIS(:)*(1.-PPSN(:)) + PPSN(:)*PEMISNOW(:) 00220 PTS_RAD(:) = ( ((1.-PPSN(:))*PEMIS(:) *PTS_RAD_SNOWFREE(:)**4 + & 00221 PPSN(:) *PEMISNOW(:)*PSNOWTEMP(:,1)**4 )/ & 00222 PEMIST(:) )**(0.25) 00223 ! 00224 ! 00225 ! Calculate actual fluxes from snow-free natural 00226 ! portion of surface: NET flux from surface is the sum of 00227 ! fluxes from snow free and snow covered portions 00228 ! of natural portion of grid box when *ISBA-ES* in force. 00229 ! when NOT in use, then these fluxes equal those above. 00230 ! 00231 PRN(:) = (1.-PPSN(:)) * PRN(:) + PPSN(:) * PRNSNOW(:) 00232 PH(:) = (1.-PPSN(:)) * PH(:) + PPSN(:) * PHSNOW(:) 00233 ! 00234 PLEG(:) = (1.-PPSNG(:)-PFFG(:)) * PLEG(:) 00235 PLEGI(:) = (1.-PPSNG(:)-PFFG(:)) * PLEGI(:) 00236 PLEV(:) = (1.-PPSNV(:)-PFFV(:)) * PLEV(:) 00237 PLETR(:) = (1.-PPSNV(:)-PFFV(:)) * PLETR(:) 00238 PLER(:) = (1.-PPSNV(:)-PFFV(:)) * PLER(:) 00239 ! 00240 ! Total evapotranspiration flux (kg/m2/s): 00241 ! 00242 PEVAP(:) = (PLEV(:) + PLEG(:))/PLVTT(:) + PLEGI(:)/PLSTT(:) + PLE_FLOOD(:)/PLVTT(:) + & 00243 PLEI_FLOOD(:)/PLSTT(:) + PPSN(:) * PEVAP3L(:) 00244 ! 00245 ! Momentum fluxes: 00246 ! 00247 PUSTAR(:) = SQRT( (1.-PPSN(:)) * PUSTAR(:)**2 + PPSN(:) * PUSTARSNOW(:)**2 ) 00248 ! 00249 ! ISBA-ES/SNOW3L fluxes: 00250 ! 00251 PLES(:) = PPSN(:) * PLES3L(:) 00252 PLESL(:) = PPSN(:) * PLEL3L(:) 00253 PRNSNOW(:) = PPSN(:) * PRNSNOW(:) 00254 PHSNOW(:) = PPSN(:) * PHSNOW(:) 00255 PGFLUXSNOW(:)= PPSN(:) * PGFLUXSNOW(:) 00256 PSNOWHMASS(:)= PPSN(:) * PSNOWHMASS(:) ! (J m-2) 00257 PHPSNOW(:) = PPSN(:) * PHPSNOW(:) 00258 00259 ! Total heat flux between snow and soil 00260 ! 00261 PGRNDFLUX(:) = PPSN(:) * PGRNDFLUX(:) 00262 PMELTADV(:) = PPSN(:) * PMELTADV(:) 00263 ! 00264 ! Total evaporative flux: 00265 ! 00266 PLE(:) = PLEG(:) + PLEV(:) + PLES(:) + PLESL(:) + PLEGI(:) + PLE_FLOOD(:) + PLEI_FLOOD(:) 00267 ! 00268 ! Total sublimation flux: 00269 ! 00270 PLEI(:) = PLES(:) + PLEGI(:) + PLEI_FLOOD(:) 00271 ! 00272 ! Total FLUX into snow/soil/vegetation surface: 00273 ! 00274 PGFLUX(:) = PRN(:) - PH(:) - PLE(:) + PHPSNOW(:) 00275 ! 00276 ! Ridcharson number: 00277 ! 00278 PRI(:) = (1.-PPSN(:)) * PRI(:) + PPSN(:) * PRI3L(:) 00279 ! 00280 ELSE 00281 ! 00282 PTS (:) = PTG (:,1) 00283 PTS_RAD(:) = PTS_RAD_SNOWFREE(:) 00284 PALBT (:) = PALB (:) 00285 PEMIST (:) = PEMIS(:) 00286 ! 00287 ! Total sublimation flux: 00288 PLEI (:) = PLES(:) + PLEGI(:) + PLEI_FLOOD(:) 00289 ! 00290 ENDIF 00291 IF (LHOOK) CALL DR_HOOK('ISBA_SNOW_AGR',1,ZHOOK_HANDLE) 00292 ! 00293 ! 00294 ! 00295 !------------------------------------------------------------------------------- 00296 ! 00297 END SUBROUTINE ISBA_SNOW_AGR
1.8.0
