Changeset 3464


Ignore:
Timestamp:
Oct 30, 2018 6:08:55 PM (3 years ago)
Author:
kanani
Message:

from branch resler@3462: add MRT shaping function (radiation_model_mod), use basic constants (biometeorology_mod), adjust precision to wp (biometeorology_pt_mod)

Location:
palm/trunk/SOURCE
Files:
5 edited

Legend:

Unmodified
Added
Removed
  • palm/trunk/SOURCE/biometeorology_mod.f90

    r3448 r3464  
    2727! -----------------
    2828! $Id$
     29! From branch resler@3462, pavelkrc:
     30! make use of basic_constants_and_equations_mod
     31!
     32! 3448 2018-10-29 18:14:31Z kanani
    2933! Initial revision
    3034!
     
    6064
    6165    USE basic_constants_and_equations_mod,                                     &
    62        ONLY:  magnus
     66       ONLY:  degc_to_k, magnus, sigma_sb
    6367
    6468    USE biometeorology_ipt_mod
     
    113117    REAL ( wp )    ::  biom_output_height  !< height output is calculated in m
    114118    REAL ( wp )    ::  time_biom_results   !< the time, the last set of biom results have been calculated for
    115     REAL ( wp ), PARAMETER ::  cels_offs = 273.15_wp  !< Kelvin-Celsius offset (K)
    116     REAL ( wp ), PARAMETER ::  sigma_sb  = 5.67037321E-8_wp  !< Stefan-Boltzmann constant
    117119    REAL ( wp ), PARAMETER ::  human_absorb = 0.7_wp  !< SW absorbtivity of a human body (Fanger 1972)
    118120    REAL ( wp ), PARAMETER ::  human_emiss = 0.97_wp  !< LW emissivity of a human body after (Fanger 1972)
     
    313315                       biom_mrt_av(:) = biom_mrt_av(:) + &
    314316                          ((human_absorb*mrtinsw(:) + human_emiss*mrtinlw(:))  &
    315                           / (human_emiss*sigma_sb)) ** .25_wp - cels_offs
     317                          / (human_emiss*sigma_sb)) ** .25_wp - degc_to_k
    316318                    ELSE
    317319                       biom_mrt_av(:) = biom_mrt_av(:) + &
    318320                          (human_emiss * mrtinlw(:) / sigma_sb) ** .25_wp      &
    319                           - cels_offs
     321                          - degc_to_k
    320322                    ENDIF
    321323                 ENDIF
     
    10461048
    10471049!-- Compute mean radiant temperature
    1048     tmrt = ( nrfd / (human_emiss * sigma_sb) )**0.25_wp - cels_offs
     1050    tmrt = ( nrfd / (human_emiss * sigma_sb) )**0.25_wp - degc_to_k
    10491051
    10501052 END SUBROUTINE calculate_tmrt_6_directions
     
    11221124
    11231125    sw_side = sw_in * 0.125_wp  ! distribute half of upper sw_in to the 4 sides
    1124     lw_air = ( sigma_sb * 0.95_wp * ( ta + cels_offs )**4 )
     1126    lw_air = ( sigma_sb * 0.95_wp * ( ta + degc_to_k )**4 )
    11251127
    11261128!-- Compute mean radiation flux density absorbed by rotational symetric human
     
    11331135
    11341136!-- Compute mean radiant temperature
    1135     tmrt = ( nrfd / (human_emiss * sigma_sb) )**0.25_wp - cels_offs
     1137    tmrt = ( nrfd / (human_emiss * sigma_sb) )**0.25_wp - degc_to_k
    11361138
    11371139 END SUBROUTINE calculate_tmrt_2_directions
     
    12211223    IF ( average_input ) THEN
    12221224!--    Calculate ta from Tp assuming dry adiabatic laps rate
    1223        ta = pt_av(k, j, i) - ( 0.0098_wp * dz(1) * (  k + .5_wp ) ) - cels_offs
     1225       ta = pt_av(k, j, i) - ( 0.0098_wp * dz(1) * (  k + .5_wp ) ) - degc_to_k
    12241226
    12251227       vp = 0.034_wp
     
    12331235    ELSE
    12341236!-- Calculate ta from Tp assuming dry adiabatic laps rate
    1235        ta = pt(k, j, i) - ( 0.0098_wp * dz(1) * (  k + .5_wp ) ) - cels_offs
     1237       ta = pt(k, j, i) - ( 0.0098_wp * dz(1) * (  k + .5_wp ) ) - degc_to_k
    12361238
    12371239       vp = q(k, j, i)
     
    12491251!-- The magnus formula is limited to temperatures up to 333.15 K to
    12501252!   avoid negative values of vp_sat
    1251     vp_sat = 0.01_wp * magnus( MIN( ta + cels_offs, 333.15_wp ) )
     1253    vp_sat = 0.01_wp * magnus( MIN( ta + degc_to_k, 333.15_wp ) )
    12521254    vp  = vp * pair / ( vp + 0.622_wp )
    12531255    IF ( vp > vp_sat ) vp = vp_sat
  • palm/trunk/SOURCE/biometeorology_pt_mod.f90

    r3448 r3464  
    2020!--------------------------------------------------------------------------------!
    2121!
    22 ! Current revisions: 001
    23 ! -----------------
     22! Current revisions:
     23! ------------------
    2424!
    2525!
    26 ! Former revisions: 001
     26! Former revisions:
    2727! -----------------
    2828! $Id$
    29 ! Initial revision 001
     29! From branch resler@3462, pavelkrc:
     30! replace specific precision DLOG, DMOD intrinsics with generic precision for
     31! compatibility with 'wp'
     32!
     33!
     34! Initial revision
    3035!
    3136!
     
    116121! Description:
    117122! ------------
    118 !> PT_BASIC.F90   Version of perceived temperature (PT, °C) for
     123!> PT_BASIC.F90   Version of perceived temperature (PT, ï¿œC) for
    119124!> - standard measured/predicted meteorological values and TMRT
    120125!> as input;
     
    131136
    132137!-- Type of input of the argument list
    133     REAL(wp), INTENT ( IN )  :: tt2m   !< Local air temperature (°C)
     138    REAL(wp), INTENT ( IN )  :: tt2m   !< Local air temperature (ï¿œC)
    134139    REAL(wp), INTENT ( IN )  :: el2m   !< Local vapour pressure (hPa)
    135     REAL(wp), INTENT ( IN )  :: tmrt   !< Local mean radiant temperature (°C)
     140    REAL(wp), INTENT ( IN )  :: tmrt   !< Local mean radiant temperature (ï¿œC)
    136141    REAL(wp), INTENT ( IN )  :: vau1m  !< Local wind velocitry (m/s)
    137142    REAL(wp), INTENT ( IN )  :: pb     !< Local barometric air pressure (hPa)
    138143
    139144!-- Type of output of the argument list
    140     REAL(wp), INTENT ( OUT ) :: pt_basic  !< Perceived temperature (°C)
     145    REAL(wp), INTENT ( OUT ) :: pt_basic  !< Perceived temperature (ï¿œC)
    141146    REAL(wp), INTENT ( OUT ) :: clo       !< Clothing index (dimensionless)
    142147
     
    301306! ------------
    302307!> The SUBROUTINE calculates the saturation water vapour pressure
    303 !> (hPa = hecto Pascal) for a given temperature tt (°C).
     308!> (hPa = hecto Pascal) for a given temperature tt (ï¿œC).
    304309!> For example, tt can be the air temperature or the dew point temperature.
    305310!------------------------------------------------------------------------------!
     
    308313    IMPLICIT NONE
    309314
    310     REAL(wp), INTENT ( IN )  ::  tt   !< ambient air temperature (°C)
     315    REAL(wp), INTENT ( IN )  ::  tt   !< ambient air temperature (ï¿œC)
    311316    REAL(wp), INTENT ( OUT ) ::  p_st !< saturation water vapour pressure (hPa)
    312317
     
    316321
    317322    IF ( tt < 0._wp ) THEN
    318 !--    tt  < 0 (°C): saturation water vapour pressure over ice
     323!--    tt  < 0 (ï¿œC): saturation water vapour pressure over ice
    319324       b = 17.84362_wp
    320325       c = 245.425_wp
    321326    ELSE
    322 !--    tt >= 0 (°C): saturation water vapour pressure over water
     327!--    tt >= 0 (ï¿œC): saturation water vapour pressure over water
    323328       b = 17.08085_wp
    324329       c = 234.175_wp
     
    346351
    347352!-- Input variables of argument list:
    348     REAL(wp), INTENT ( IN )  :: tt2m     !< Ambient temperature (°C)
    349     REAL(wp), INTENT ( IN )  :: tmrt     !< Mean radiant temperature (°C)
     353    REAL(wp), INTENT ( IN )  :: tt2m     !< Ambient temperature (ï¿œC)
     354    REAL(wp), INTENT ( IN )  :: tmrt     !< Mean radiant temperature (ï¿œC)
    350355    REAL(wp), INTENT ( IN )  :: el2m     !< Water vapour pressure (hPa)
    351356    REAL(wp), INTENT ( IN )  :: vau1m    !< Wind speed (m/s) 1 m above ground
     
    362367! Output variables of argument list:
    363368    REAL(wp), INTENT ( OUT ) :: pmva     !< 0 (set to zero, because clo is evaluated for comfort)
    364     REAL(wp), INTENT ( OUT ) :: top      !< Operative temperature (°C) at found root of Fanger's PMV
     369    REAL(wp), INTENT ( OUT ) :: top      !< Operative temperature (ï¿œC) at found root of Fanger's PMV
    365370    REAL(wp), INTENT ( OUT ) :: clo_res  !< Resulting clothing insulation value (clo)
    366371    INTEGER(iwp), INTENT ( OUT ) :: nerr !< Error status / quality flag
     
    488493    REAL(wp), INTENT ( IN ) ::  pmv   !< Fangers predicted mean vote (dimensionless)
    489494    REAL(wp), INTENT ( IN ) ::  clo   !< clothing insulation index (clo)
    490     REAL(wp), INTENT ( OUT ) ::  pt   !< pt (°C) corresponding to given PMV / clo
     495    REAL(wp), INTENT ( OUT ) ::  pt   !< pt (ï¿œC) corresponding to given PMV / clo
    491496
    492497    IF ( pmv <= -0.11_wp ) THEN
     
    517522
    518523!-- Input variables of argument list:
    519     REAL(wp), INTENT ( IN ) ::  tt       !< Ambient air temperature (°C)
    520     REAL(wp), INTENT ( IN ) ::  tmrt     !< Mean radiant temperature (°C)
     524    REAL(wp), INTENT ( IN ) ::  tt       !< Ambient air temperature (ï¿œC)
     525    REAL(wp), INTENT ( IN ) ::  tmrt     !< Mean radiant temperature (ï¿œC)
    521526    REAL(wp), INTENT ( IN ) ::  pa       !< Water vapour pressure (hPa)
    522527    REAL(wp), INTENT ( IN ) ::  pb       !< Barometric pressure (hPa) at site
     
    530535!            to Fanger corresponding to meteorological (tt,tmrt,pa,vau,pb)
    531536!            and individual variables (clo, actlev, eta)
    532     REAL(wp), INTENT ( OUT ) ::  top      !< operative temperature (°C)
     537    REAL(wp), INTENT ( OUT ) ::  top      !< operative temperature (ï¿œC)
    533538
    534539!-- Internal variables
     
    638643!-- Input variables of argument list:
    639644    REAL(wp),     INTENT ( IN )  :: pmva     !< Actual Predicted Mean Vote (PMV) according to Fanger
    640     REAL(wp),     INTENT ( IN )  :: tt2m     !< Ambient temperature (°C) at screen level
     645    REAL(wp),     INTENT ( IN )  :: tt2m     !< Ambient temperature (ï¿œC) at screen level
    641646    REAL(wp),     INTENT ( IN )  :: el2m     !< Water vapour pressure (hPa) at screen level
    642647    REAL(wp),     INTENT ( IN )  :: svp_tt   !< Saturation water vapour pressure (hPa) at tt2m
    643     REAL(wp),     INTENT ( IN )  :: tmrt     !< Mean radiant temperature (°C) at screen level
     648    REAL(wp),     INTENT ( IN )  :: tmrt     !< Mean radiant temperature (ï¿œC) at screen level
    644649    REAL(wp),     INTENT ( IN )  :: vau1m    !< Wind speed (m/s) 1 m above ground
    645650
     
    724729       nerr = -3_iwp
    725730       IF ( el2m < p10 ) THEN
    726 !--       Due to conditions of regressíon: r.H. >= 5 %
     731!--       Due to conditions of regressï¿œon: r.H. >= 5 %
    727732          pa = p10
    728733       ELSE
    729 !--       Due to conditions of regressíon: r.H. <= 95 %
     734!--       Due to conditions of regressï¿œon: r.H. <= 95 %
    730735          pa = p95
    731736       ENDIF
     
    733738    IF ( pa > 0._wp ) THEN
    734739!--    Natural logarithm of pa
    735        apa = DLOG ( pa )
     740       apa = LOG ( pa )
    736741    ELSE
    737742       apa = -5._wp
     
    741746    pa_p50   = 0.5_wp * svp_tt
    742747    IF ( pa_p50 > 0._wp .AND. pa > 0._wp ) THEN
    743        dapa   = apa - DLOG ( pa_p50 )
     748       dapa   = apa - LOG ( pa_p50 )
    744749       pa_p50 = pa / pa_p50
    745750    ELSE
     
    765770       RETURN
    766771    ENDIF
    767     gew = DMOD ( pmv, 1._wp )
     772    gew = MOD ( pmv, 1._wp )
    768773    IF ( gew < 0._wp ) gew = 0._wp
    769774    IF ( nreg > 5_iwp ) THEN
     
    834839!> velocity:
    835840!> - defined only under warm conditions: gtc based on 0.5 (clo) and
    836 !>                                       gtc > 16.826 (°C)
     841!>                                       gtc > 16.826 (ï¿œC)
    837842!> - undefined: sultr_res set at +99.
    838843!------------------------------------------------------------------------------!
     
    904909!-- Type of input arguments
    905910    REAL(wp), INTENT ( IN ) :: pmva      !< Fanger's classical predicted mean vote
    906     REAL(wp), INTENT ( IN ) :: tt2m      !< Air temperature (°C) 2 m above ground
     911    REAL(wp), INTENT ( IN ) :: tt2m      !< Air temperature (ï¿œC) 2 m above ground
    907912    REAL(wp), INTENT ( IN ) :: vau1m     !< Relative wind velocity 1 m above ground (m/s)
    908     REAL(wp), INTENT ( IN ) :: tmrt      !< Mean radiant temperature (°C)
     913    REAL(wp), INTENT ( IN ) :: tmrt      !< Mean radiant temperature (ï¿œC)
    909914
    910915!-- Type of output argument
     
    10361041!> (neither body cooling nor body heating). It is related to the Klima-
    10371042!> Michel activity level (134.682 W/m2). IREQ_neutral is only defined
    1038 !> for gt < 10 (°C)
     1043!> for gt < 10 (ï¿œC)
    10391044!------------------------------------------------------------------------------!
    10401045 REAL(wp) FUNCTION ireq_neutral( gt, ireq_minimal, nerr )
     
    10591064    ireq_neutral = 1.62_wp - 0.0564_wp * top02
    10601065
    1061 !-- Regression only defined for gt <= 10 (°C)
     1066!-- Regression only defined for gt <= 10 (ï¿œC)
    10621067    IF ( ireq_neutral < 0.5_wp ) THEN
    10631068       IF ( ireq_neutral < 0.48_wp ) THEN
  • palm/trunk/SOURCE/netcdf_data_input_mod.f90

    r3459 r3464  
    2020! Current revisions:
    2121! -----------------
    22 ! Define coordinate reference system (crs) and read from input dataset
    23 ! Revise default values for reference coordinates
     22!
    2423!
    2524! Former revisions:
    2625! -----------------
    2726! $Id$
     27! Define coordinate reference system (crs) and read from input dataset
     28! Revise default values for reference coordinates
     29!
     30! 3459 2018-10-30 15:04:11Z gronemeier
    2831! from chemistry branch r3443, banzhafs, Russo:
    2932! Uncommented lines on dimension of surface_fractions
  • palm/trunk/SOURCE/netcdf_interface_mod.f90

    r3459 r3464  
    2020! Current revisions:
    2121! ------------------
     22!
     23!
     24! Former revisions:
     25! -----------------
     26! $Id$
    2227! - Add variable crs to output files
    2328! - Add long_name to UTM coordinates
     
    2530!   only written if parallel output is used.
    2631!
    27 ! Former revisions:
    28 ! -----------------
    29 ! $Id$
     32! 3459 2018-10-30 15:04:11Z gronemeier
    3033! Adjustment of biometeorology calls
    3134!
  • palm/trunk/SOURCE/radiation_model_mod.f90

    r3449 r3464  
    2828! -----------------
    2929! $Id$
     30! From branch resler@3462, pavelkrc:
     31! add MRT shaping function for human
     32!
     33! 3449 2018-10-29 19:36:56Z suehring
    3034! New RTM version 3.0: (Pavel Krc, Jaroslav Resler, ICS, Prague)
    3135!   - Interaction of plant canopy with LW radiation
     
    902906    LOGICAL                                        ::  mrt_skip_roof = .TRUE.             !< do not calculate MRT above roof surfaces
    903907    LOGICAL                                        ::  mrt_include_sw = .TRUE.            !< should MRT calculation include SW radiation as well?
     908    LOGICAL                                        ::  mrt_geom_human = .TRUE.            !< MRT direction weights simulate human body instead of a sphere
    904909    INTEGER(iwp)                                   ::  nrefsteps = 3                      !< number of reflection steps to perform
    905910    REAL(wp), PARAMETER                            ::  ext_coef = 0.6_wp                  !< extinction coefficient (a.k.a. alpha)
     
    11721177!-- Public variables and constants / NEEDS SORTING
    11731178    PUBLIC albedo, albedo_type, decl_1, decl_2, decl_3, dots_rad, dt_radiation,&
    1174            emissivity, force_radiation_call, lat, lon,                         &
     1179           emissivity, force_radiation_call, lat, lon, mrt_geom_human,         &
    11751180           mrt_include_sw, mrt_nlevels, mrtbl, mrtinsw, mrtinlw, nmrtbl,       &
    11761181           rad_net_av, radiation, radiation_scheme, rad_lw_in,                 &
     
    29422947                                  constant_albedo, dt_radiation, emissivity,    &
    29432948                                  lw_radiation, max_raytracing_dist,            &
    2944                                   min_irrf_value, mrt_include_sw, mrt_nlevels,  &
     2949                                  min_irrf_value, mrt_geom_human,               &
     2950                                  mrt_include_sw, mrt_nlevels,                  &
    29452951                                  mrt_skip_roof, net_radiation, nrefsteps,      &
    29462952                                  plant_lw_interact, rad_angular_discretization,&
     
    29572963                                  constant_albedo, dt_radiation, emissivity,    &
    29582964                                  lw_radiation, max_raytracing_dist,            &
    2959                                   min_irrf_value, mrt_include_sw, mrt_nlevels,  &
     2965                                  min_irrf_value, mrt_geom_human,               &
     2966                                  mrt_include_sw, mrt_nlevels,                  &
    29602967                                  mrt_skip_roof, net_radiation, nrefsteps,      &
    29612968                                  plant_lw_interact, rad_angular_discretization,&
     
    65536560           zbdry(:) = (/( zn0+REAL(izn,wp)*zns, izn=0, nzn )/)
    65546561           vffrac0(:) = (COS(zbdry(0:nzn-1)) - COS(zbdry(1:nzn))) / 2._wp / REAL(naz, wp)
     6562           !
     6563           !--Modify direction weights to simulate human body (lower weight for top-down)
     6564           IF ( mrt_geom_human )  THEN
     6565              vffrac0(:) = vffrac0(:) * MAX(0._wp, SIN(zcent(:))*0.88_wp + COS(zcent(:))*0.12_wp)
     6566              vffrac0(:) = vffrac0(:) / (SUM(vffrac0) * REAL(naz, wp))
     6567           ENDIF
    65556568
    65566569           DO  imrt = 1, nmrtbl
Note: See TracChangeset for help on using the changeset viewer.