SURFEX v7.3
General documentation of Surfex
 All Classes Files Functions Variables Typedefs
/home/dasprezs/EXPORT_v7_3/src/SURFEX/flake_interface.F90
Go to the documentation of this file.
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