SURFEX v7.3
General documentation of Surfex
|
00001 ! ############################################################################### 00002 SUBROUTINE flake_interface (KI, & 00003 ! Atmospheric forcing 00004 dMsnowdt_in, I_atm_in, Q_atm_lw_in, height_u_in, height_tq_in, & 00005 U_a_in, T_a_in, q_a_in, P_a_in, & 00006 ! Constant parameters 00007 depth_w, fetch, depth_bs, T_bs, par_Coriolis, del_time, & 00008 ! Parameters that may change 00009 emis_water, albedo_water, albedo_ice, albedo_snow, & 00010 extincoef_water, extincoef_ice, extincoef_snow, & 00011 ! Flake variables 00012 T_snow, T_ice, T_mnw, T_wML, T_bot, T_B1, C_T, h_snow, h_ice, & 00013 h_ML, H_B1, T_sfc, & 00014 ! Surface heat and momentum fluxes 00015 Q_sensible, Q_latent ,Q_momentum, z0, z0t, Ri, ustar, Cd_a, & 00016 ! Switches to configure FLake runs 00017 lflk_botsed, hflk_flux, PPEW_A_COEF, PPEW_B_COEF, rho_a, & 00018 HIMPLICIT_WIND ) 00019 !------------------------------------------------------------------------------ 00020 ! 00021 ! Description: 00022 ! 00023 ! The FLake interface is 00024 ! a communication routine between "flake_driver" 00025 ! and a prediction system that uses FLake. 00026 ! It assigns the FLake variables at the previous time step 00027 ! to their input values given by the driving model, 00028 ! calls a number of routines to compute the heat and radiation fluxes, 00029 ! calls "flake_driver", 00030 ! and returns the updated FLake variables to the driving model. 00031 ! The "flake_interface" does not contain any Flake physics. 00032 ! It only serves as a convenient means to organize calls of "flake_driver" 00033 ! and of external routines that compute heat and radiation fluxes. 00034 ! The interface may (should) be changed so that to provide 00035 ! the most convenient use of FLake. 00036 ! Within a 3D atmospheric prediction system, 00037 ! "flake_driver" may be called in a DO loop within "flake_interface" 00038 ! for each grid-point where a lake is present. 00039 ! In this way, the driving atmospheric model should call "flake_interface" 00040 ! only once, passing the FLake variables to "flake_interface" as 2D fields. 00041 ! 00042 ! Lines embraced with "!_tmp" contain temporary parts of the code. 00043 ! These should be removed prior to using FLake in applications. 00044 ! Lines embraced/marked with "!_dev" may be replaced 00045 ! as improved parameterizations are developed and tested. 00046 ! Lines embraced/marked with "!_dm" are DM's comments 00047 ! that may be helpful to a user. 00048 ! 00049 ! 00050 ! Current Code Owner: DWD, Dmitrii Mironov 00051 ! Phone: +49-69-8062 2705 00052 ! Fax: +49-69-8062 3721 00053 ! E-mail: dmitrii.mironov@dwd.de 00054 ! 00055 ! History: 00056 ! Version Date Name 00057 ! ---------- ---------- ---- 00058 ! 1.00 2005/11/17 Dmitrii Mironov 00059 ! Initial release 00060 ! !VERSION! !DATE! <Your name> 00061 ! <Modification comments> 00062 ! 00063 ! Code Description: 00064 ! Language: Fortran 90. 00065 ! Software Standards: "European Standards for Writing and 00066 ! Documenting Exchangeable Fortran 90 Code". 00067 !============================================================================== 00068 ! 00069 ! Declarations: 00070 ! 00071 ! Modules used: 00072 00073 !USE modd_data_parameters , ONLY : & 00074 ! ireals, &! KIND-type parameter for real variables 00075 ! iintegers ! KIND-type parameter for "normal" integer variables 00076 00077 USE modd_flake_derivedtypes ! Definitions of several derived TYPEs 00078 00079 USE modd_flake_parameters , ONLY : & 00080 tpl_T_f , &! Fresh water freezing point [K] 00081 tpl_rho_w_r , &! Maximum density of fresh water [kg m^{-3}] 00082 h_Snow_min_flk , &! Minimum snow thickness [m] 00083 h_Ice_min_flk ! Minimum ice thickness [m] 00084 00085 USE modd_flake_paramoptic_ref ! Reference values of the optical characteristics 00086 ! of the lake water, lake ice and snow 00087 00088 USE modd_flake_albedo_ref ! Reference values the albedo for the lake water, lake ice and snow 00089 00090 USE mode_flake , ONLY : & 00091 flake_driver , &! Subroutine, FLake driver 00092 flake_radflux , &! Subroutine, computes radiation fluxes at various depths 00093 ! 00094 T_snow_p_flk, T_snow_n_flk , &! Temperature at the air-snow interface [K] 00095 T_ice_p_flk, T_ice_n_flk , &! Temperature at the snow-ice or air-ice interface [K] 00096 T_mnw_p_flk, T_mnw_n_flk , &! Mean temperature of the water column [K] 00097 T_wML_p_flk, T_wML_n_flk , &! Mixed-layer temperature [K] 00098 T_bot_p_flk, T_bot_n_flk , &! Temperature at the water-bottom sediment interface [K] 00099 T_B1_p_flk, T_B1_n_flk , &! Temperature at the bottom of the upper layer of the sediments [K] 00100 C_T_p_flk, C_T_n_flk , &! Shape factor (thermocline) 00101 h_snow_p_flk, h_snow_n_flk , &! Snow thickness [m] 00102 h_ice_p_flk, h_ice_n_flk , &! Ice thickness [m] 00103 h_ML_p_flk, h_ML_n_flk , &! Thickness of the mixed-layer [m] 00104 H_B1_p_flk, H_B1_n_flk , &! Thickness of the upper layer of bottom sediments [m] 00105 ! 00106 Q_snow_flk , &! Heat flux through the air-snow interface [W m^{-2}] 00107 Q_ice_flk , &! Heat flux through the snow-ice or air-ice interface [W m^{-2}] 00108 Q_w_flk , &! Heat flux through the ice-water or air-water interface [W m^{-2}] 00109 Q_bot_flk , &! Heat flux through the water-bottom sediment interface [W m^{-2}] 00110 I_atm_flk , &! Radiation flux at the lower boundary of the atmosphere [W m^{-2}], 00111 ! i.e. the incident radiation flux with no regard for the surface albedo 00112 I_snow_flk , &! Radiation flux through the air-snow interface [W m^{-2}] 00113 I_ice_flk , &! Radiation flux through the snow-ice or air-ice interface [W m^{-2}] 00114 I_w_flk , &! Radiation flux through the ice-water or air-water interface [W m^{-2}] 00115 I_h_flk , &! Radiation flux through the mixed-layer-thermocline interface [W m^{-2}] 00116 I_bot_flk , &! Radiation flux through the water-bottom sediment interface [W m^{-2}] 00117 I_intm_0_h_flk , &! Mean radiation flux over the mixed layer [W m^{-1}] 00118 I_intm_h_D_flk , &! Mean radiation flux over the thermocline [W m^{-1}] 00119 Q_star_flk , &! A generalized heat flux scale [W m^{-2}] 00120 u_star_w_flk , &! Friction velocity in the surface layer of lake water [m s^{-1}] 00121 w_star_sfc_flk , &! Convective velocity scale, using a generalized heat flux scale [m s^{-1}] 00122 dMsnowdt_flk ! The rate of snow accumulation [kg m^{-2} s^{-1}] 00123 00124 00125 USE mode_sfcflx , ONLY : & 00126 sfcflx_lwradwsfc , &! Function, returns the surface long-wave radiation flux 00127 sfcflx_momsenlat , &! Subroutine, computes fluxes of momentum and of sensible and latent heat 00128 z0u_sf , &! Roughness length with respect to wind velocity [m] 00129 z0t_sf ! Roughness length with respect to potential temperature [m] 00130 00131 00132 USE modd_flake_configure, ONLY : lflk_botsed_use 00133 !============================================================================== 00134 ! 00135 USE MODI_WIND_THRESHOLD 00136 ! 00137 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00138 USE PARKIND1 ,ONLY : JPRB 00139 ! 00140 ! 00141 IMPLICIT NONE 00142 00143 !============================================================================== 00144 ! 00145 ! Declarations 00146 00147 ! 00148 !* 0.1 declarations of arguments 00149 ! 00150 ! Input (procedure arguments) 00151 ! 00152 INTEGER, INTENT(IN) :: KI ! number of points 00153 ! 00154 INTEGER :: i ! DO loop index 00155 ! 00156 REAL, DIMENSION(KI), INTENT(IN) :: 00157 dMsnowdt_in , ! The rate of snow accumulation [kg m^{-2} s^{-1}] 00158 I_atm_in , ! Solar radiation flux at the surface [W m^{-2}] 00159 Q_atm_lw_in , ! Long-wave radiation flux from the atmosphere [W m^{-2}] 00160 height_u_in , ! Height above the lake surface where the wind speed is measured [m] 00161 height_tq_in , ! Height where temperature and humidity are measured [m] 00162 U_a_in , ! Wind speed at z=height_u_in [m s^{-1}] 00163 T_a_in , ! Air temperature at z=height_tq_in [K] 00164 q_a_in , ! Air specific humidity at z=height_tq_in 00165 P_a_in ! Surface air pressure [N m^{-2} = kg m^{-1} s^{-2}] 00166 00167 REAL, DIMENSION(KI), INTENT(IN) :: 00168 depth_w , ! The lake depth [m] 00169 fetch , ! Typical wind fetch [m] 00170 depth_bs , ! Depth of the thermally active layer of the bottom sediments [m] 00171 T_bs , ! Temperature at the outer edge of 00172 ! the thermally active layer of the bottom sediments [K] 00173 par_Coriolis , &! The Coriolis parameter [s^{-1}] 00174 del_time , &! The model time step [s] 00175 PPEW_A_COEF , &! coefficient A (m^2 s kg^{-1}) and B (m s^{-1}) 00176 PPEW_B_COEF , &! for wind implicitation : V+ = - A * rho_a u'w' + B 00177 rho_a , &! Air density (kg m ^{-3}) (from forcing atm. data) 00178 emis_water ! Water surface emissivity 00179 ! 00180 CHARACTER(LEN=*), INTENT(IN) :: HIMPLICIT_WIND ! wind implicitation option 00181 ! ! 'OLD' = direct 00182 ! ! 'NEW' = Taylor serie, order 1 00183 ! 00184 LOGICAL :: lflk_botsed ! Switch, .TRUE. -> use the bottom-sediment scheme 00185 CHARACTER(LEN=5) :: hflk_flux ! 'DEF '/'FLAKE'/'ECUME' compute the surface fluxes if = 'FLAKE' 00186 00187 ! 00188 ! Input/Output (procedure arguments) 00189 00190 REAL, DIMENSION(KI), INTENT(INOUT) :: 00191 albedo_water , ! Water surface albedo with respect to the solar radiation 00192 albedo_ice , ! Ice surface albedo with respect to the solar radiation 00193 albedo_snow ! Snow surface albedo with respect to the solar radiation 00194 00195 REAL, DIMENSION(KI), INTENT(INOUT) :: 00196 extincoef_water , ! extintion coefficient of water 00197 extincoef_ice , ! extintion coefficient of ice 00198 extincoef_snow ! extintion coefficient of snow 00199 00200 REAL, DIMENSION(KI), INTENT(INOUT) :: 00201 T_snow , ! Temperature at the air-snow interface [K] 00202 T_ice , ! Temperature at the snow-ice or air-ice interface [K] 00203 T_mnw , ! Mean temperature of the water column [K] 00204 T_wML , ! Mixed-layer temperature [K] 00205 T_bot , ! Temperature at the water-bottom sediment interface [K] 00206 T_B1 , ! Temperature at the bottom of the upper layer of the sediments [K] 00207 C_T , ! Shape factor (thermocline) 00208 h_snow , ! Snow thickness [m] 00209 h_ice , ! Ice thickness [m] 00210 h_ML , ! Thickness of the mixed-layer [m] 00211 H_B1 , ! Thickness of the upper layer of bottom sediments [m] 00212 T_sfc ! Surface temperature at the previous time step [K] 00213 00214 ! Output (procedure arguments) 00215 00216 REAL, DIMENSION(KI), INTENT(INOUT) :: 00217 Q_sensible , ! Sensible heat flux [W m^{-2}] 00218 Q_latent , ! Latent heat flux [W m^{-2}] 00219 Q_momentum , ! Momentum flux [N m^{-2}] 00220 z0 , ! Roughness length with respect to wind velocity [m] 00221 z0t , ! Roughness length with respect to potential temperature [m] 00222 Ri , ! Gradient Richardson number 00223 ustar , ! air friction velocity 00224 Cd_a ! wind drag coefficient [no unit] 00225 00226 00227 00228 00229 ! 00230 !* 0.2 declarations of local variables 00231 ! 00232 INTEGER :: JL ! loop counter on horizontal points 00233 00234 REAL :: T_sfc_n ! Surface temperature at the new time step [K] 00235 REAL :: ustar2 ! square of air friction velocity (m2/s2) 00236 REAL :: zvmod ! wind at t+1 00237 REAL, DIMENSION(KI) :: 00238 Q_watvap, ! Flux of water vapour [kg m^{-2} s^{-1}] 00239 zwind ! thresholded wind 00240 00241 TYPE (opticpar_medium), DIMENSION(KI) :: 00242 opticpar_water , ! Optical characteristics of water 00243 opticpar_ice , ! Optical characteristics of ice 00244 opticpar_snow ! Optical characteristics of snow 00245 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00246 ! 00247 !============================================================================== 00248 ! Start calculations 00249 !------------------------------------------------------------------------------ 00250 00251 !------------------------------------------------------------------------------ 00252 ! Set albedos of the lake water, lake ice and snow 00253 !------------------------------------------------------------------------------ 00254 ! 00255 ! Use default value 00256 ! albedo_water(:) = albedo_water_ref 00257 ! Use empirical formulation proposed by Mironov and Ritter (2004) for GME 00258 IF (LHOOK) CALL DR_HOOK('FLAKE_INTERFACE',0,ZHOOK_HANDLE) 00259 albedo_ice = albedo_whiteice_ref 00260 !albedo_ice(:) = EXP(-c_albice_MR*(tpl_T_f-T_sfc(:))/tpl_T_f) 00261 !albedo_ice(:) = albedo_whiteice_ref*(1.-albedo_ice) + albedo_blueice_ref*albedo_ice 00262 ! Snow is not considered 00263 albedo_snow(:) = albedo_ice(:) 00264 !------------------------------------------------------------------------------ 00265 ! Set optical characteristics of the lake water, lake ice and snow 00266 !------------------------------------------------------------------------------ 00267 ! 00268 ! Use default values 00269 !opticpar_water = opticpar_water_ref ! don't use default values 00270 00271 opticpar_ice = opticpar_ice_opaque ! Opaque ice 00272 opticpar_snow = opticpar_snow_opaque ! Opaque snow 00273 ! 00274 lflk_botsed_use = lflk_botsed 00275 ! 00276 zwind = WIND_THRESHOLD(U_a_in,height_u_in) 00277 ! 00278 H_POINT_LOOP: DO JL = 1,KI ! begin of loop on horizontal points 00279 !------------------------------------------------------------------------------ 00280 ! Set initial values 00281 !------------------------------------------------------------------------------ 00282 00283 opticpar_water(JL) = opticpar_medium(1, & 00284 (/1., (0.,i=2,nband_optic_max)/), & 00285 (/extincoef_water(JL), (1.E+10,i=2,nband_optic_max)/)) 00286 T_snow_p_flk = T_snow(JL) 00287 T_ice_p_flk = T_ice(JL) 00288 T_mnw_p_flk = T_mnw(JL) 00289 T_wML_p_flk = T_wML(JL) 00290 T_bot_p_flk = T_bot(JL) 00291 T_B1_p_flk = T_B1(JL) 00292 C_T_p_flk = C_T(JL) 00293 h_snow_p_flk = h_snow(JL) 00294 h_ice_p_flk = h_ice(JL) 00295 h_ML_p_flk = h_ML(JL) 00296 H_B1_p_flk = H_B1(JL) 00297 00298 !------------------------------------------------------------------------------ 00299 ! Set the rate of snow accumulation 00300 !------------------------------------------------------------------------------ 00301 00302 dMsnowdt_flk = dMsnowdt_in(JL) 00303 00304 !------------------------------------------------------------------------------ 00305 ! Compute solar radiation fluxes (positive downward) 00306 !------------------------------------------------------------------------------ 00307 00308 I_atm_flk = I_atm_in(JL) 00309 CALL flake_radflux ( depth_w(JL), albedo_water(JL), albedo_ice(JL), & 00310 albedo_snow(JL), opticpar_water(JL), & 00311 opticpar_ice(JL), opticpar_snow(JL) ) 00312 00313 !------------------------------------------------------------------------------ 00314 ! Compute long-wave radiation fluxes (positive downward) 00315 !------------------------------------------------------------------------------ 00316 00317 Q_w_flk = Q_atm_lw_in(JL) ! Radiation of the atmosphere 00318 Q_w_flk = Q_w_flk - SfcFlx_lwradwsfc(emis_water(JL),T_sfc(JL)) ! Radiation of the surface (notice the sign) 00319 00320 !------------------------------------------------------------------------------ 00321 ! Compute the surface friction velocity and fluxes of sensible and latent heat 00322 !------------------------------------------------------------------------------ 00323 00324 IF (hflk_flux=='FLAKE') THEN 00325 z0t(JL)=1.E-7 ! bug correction V. Masson: default value if 00326 ! computations cannot be done in SfxFlx_momsenlat 00327 Q_momentum(JL) = - rho_a(JL) * ustar(JL)**2 00328 CALL SfcFlx_momsenlat ( height_u_in(JL), height_tq_in(JL), fetch(JL), & 00329 U_a_in(JL), T_a_in(JL), q_a_in(JL), T_sfc(JL), & 00330 P_a_in(JL), h_ice_p_flk, Q_momentum(JL), & 00331 Q_sensible(JL), Q_latent(JL), Q_watvap(JL), & 00332 Ri(JL), z0(JL), z0t(JL) ) 00333 z0(JL)= z0u_sf 00334 z0t(JL)=z0t_sf 00335 ! recomputes the future wind speed and associated momentum flux 00336 ! in the case wind speed is implicited (V. Masson, Meteo-France) 00337 ! 1st step : drag coefficient 00338 ! It is retrieved assumed a relationship between momentum flux 00339 ! and previous time-step wind : Q_mom = - rho_a * Cd_a * U_a_in**2 00340 ! 00341 Cd_a(JL) = - Q_momentum(JL) / rho_a(JL) / zwind(JL)**2 00342 ! 2nd step : friction velocity (for air) computed with future wind speed 00343 ! (the latter computed using implicit coefficients) 00344 ustar2 = 0.0 00345 zvmod = U_a_in(JL) 00346 IF(HIMPLICIT_WIND=='OLD')THEN 00347 ! old implicitation 00348 ustar2 = (Cd_a(JL)*U_a_in(JL)*PPEW_B_COEF(JL))/ & 00349 (1.0-rho_a(JL)*Cd_a(JL)*U_a_in(JL)*PPEW_A_COEF(JL)) 00350 ELSE 00351 ! new implicitation 00352 ustar2 = (Cd_a(JL)*U_a_in(JL)*(2.*PPEW_B_COEF(JL)-U_a_in(JL)))/ & 00353 (1.0-2.0*rho_a(JL)*Cd_a(JL)*U_a_in(JL)*PPEW_A_COEF(JL)) 00354 zvmod = rho_a(JL)*PPEW_A_COEF(JL)*ustar2 + PPEW_B_COEF(JL) 00355 zvmod = max(0.0,zvmod) 00356 IF(PPEW_A_COEF(JL)/= 0.)THEN 00357 ustar2 = max((zvmod-PPEW_B_COEF(JL))/(rho_a(JL)*PPEW_A_COEF(JL)),0.0) 00358 ENDIF 00359 ENDIF 00360 ustar(JL) =sqrt(ustar2) 00361 ! 3rd step : momentum flux computed with the future wind speed 00362 Q_momentum(JL) = - rho_a(JL) * ustar2 00363 00364 END IF 00365 u_star_w_flk = SQRT(-Q_momentum(JL)/tpl_rho_w_r) 00366 00367 !------------------------------------------------------------------------------ 00368 ! Compute heat fluxes Q_snow_flk, Q_ice_flk, Q_w_flk 00369 !------------------------------------------------------------------------------ 00370 00371 Q_w_flk = Q_w_flk - Q_sensible(JL) - Q_latent(JL) ! Add sensible and latent heat fluxes 00372 ! (notice the signs) 00373 IF(h_ice_p_flk.GE.h_Ice_min_flk) THEN ! Ice exists 00374 IF(h_snow_p_flk.GE.h_Snow_min_flk) THEN ! There is snow above the ice 00375 Q_snow_flk = Q_w_flk 00376 Q_ice_flk = 0. 00377 Q_w_flk = 0. 00378 ELSE ! No snow above the ice 00379 Q_snow_flk = 0. 00380 Q_ice_flk = Q_w_flk 00381 Q_w_flk = 0. 00382 END IF 00383 ELSE ! No ice-snow cover 00384 Q_snow_flk = 0. 00385 Q_ice_flk = 0. 00386 END IF 00387 00388 !------------------------------------------------------------------------------ 00389 ! Advance FLake variables 00390 !------------------------------------------------------------------------------ 00391 CALL flake_driver ( depth_w(JL), depth_bs(JL), T_bs(JL), par_Coriolis(JL), & 00392 opticpar_water(JL)%extincoef_optic(1), & 00393 del_time(JL), T_sfc(JL), T_sfc_n ) 00394 00395 !------------------------------------------------------------------------------ 00396 ! Set output values 00397 !------------------------------------------------------------------------------ 00398 00399 T_snow(JL) = T_snow_n_flk 00400 T_ice(JL) = T_ice_n_flk 00401 T_mnw(JL) = T_mnw_n_flk 00402 T_wML(JL) = T_wML_n_flk 00403 T_bot(JL) = T_bot_n_flk 00404 T_B1(JL) = T_B1_n_flk 00405 C_T(JL) = C_T_n_flk 00406 h_snow(JL) = h_snow_n_flk 00407 h_ice(JL) = h_ice_n_flk 00408 h_ML(JL) = h_ML_n_flk 00409 H_B1(JL) = H_B1_n_flk 00410 T_sfc(JL) = T_sfc_n 00411 00412 ENDDO H_POINT_LOOP 00413 IF (LHOOK) CALL DR_HOOK('FLAKE_INTERFACE',1,ZHOOK_HANDLE) 00414 00415 !------------------------------------------------------------------------------ 00416 ! End calculations 00417 !============================================================================== 00418 00419 END SUBROUTINE flake_interface 00420