Changeset 3464 for palm/trunk/SOURCE
 Timestamp:
 Oct 30, 2018 6:08:55 PM (5 years ago)
 Location:
 palm/trunk/SOURCE
 Files:

 5 edited
Legend:
 Unmodified
 Added
 Removed

palm/trunk/SOURCE/biometeorology_mod.f90
r3448 r3464 27 27 !  28 28 ! $Id$ 29 ! From branch resler@3462, pavelkrc: 30 ! make use of basic_constants_and_equations_mod 31 ! 32 ! 3448 20181029 18:14:31Z kanani 29 33 ! Initial revision 30 34 ! … … 60 64 61 65 USE basic_constants_and_equations_mod, & 62 ONLY: magnus66 ONLY: degc_to_k, magnus, sigma_sb 63 67 64 68 USE biometeorology_ipt_mod … … 113 117 REAL ( wp ) :: biom_output_height !< height output is calculated in m 114 118 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 !< KelvinCelsius offset (K)116 REAL ( wp ), PARAMETER :: sigma_sb = 5.67037321E8_wp !< StefanBoltzmann constant117 119 REAL ( wp ), PARAMETER :: human_absorb = 0.7_wp !< SW absorbtivity of a human body (Fanger 1972) 118 120 REAL ( wp ), PARAMETER :: human_emiss = 0.97_wp !< LW emissivity of a human body after (Fanger 1972) … … 313 315 biom_mrt_av(:) = biom_mrt_av(:) + & 314 316 ((human_absorb*mrtinsw(:) + human_emiss*mrtinlw(:)) & 315 / (human_emiss*sigma_sb)) ** .25_wp  cels_offs317 / (human_emiss*sigma_sb)) ** .25_wp  degc_to_k 316 318 ELSE 317 319 biom_mrt_av(:) = biom_mrt_av(:) + & 318 320 (human_emiss * mrtinlw(:) / sigma_sb) ** .25_wp & 319  cels_offs321  degc_to_k 320 322 ENDIF 321 323 ENDIF … … 1046 1048 1047 1049 ! Compute mean radiant temperature 1048 tmrt = ( nrfd / (human_emiss * sigma_sb) )**0.25_wp  cels_offs1050 tmrt = ( nrfd / (human_emiss * sigma_sb) )**0.25_wp  degc_to_k 1049 1051 1050 1052 END SUBROUTINE calculate_tmrt_6_directions … … 1122 1124 1123 1125 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 ) 1125 1127 1126 1128 ! Compute mean radiation flux density absorbed by rotational symetric human … … 1133 1135 1134 1136 ! Compute mean radiant temperature 1135 tmrt = ( nrfd / (human_emiss * sigma_sb) )**0.25_wp  cels_offs1137 tmrt = ( nrfd / (human_emiss * sigma_sb) )**0.25_wp  degc_to_k 1136 1138 1137 1139 END SUBROUTINE calculate_tmrt_2_directions … … 1221 1223 IF ( average_input ) THEN 1222 1224 ! 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_offs1225 ta = pt_av(k, j, i)  ( 0.0098_wp * dz(1) * ( k + .5_wp ) )  degc_to_k 1224 1226 1225 1227 vp = 0.034_wp … … 1233 1235 ELSE 1234 1236 ! Calculate ta from Tp assuming dry adiabatic laps rate 1235 ta = pt(k, j, i)  ( 0.0098_wp * dz(1) * ( k + .5_wp ) )  cels_offs1237 ta = pt(k, j, i)  ( 0.0098_wp * dz(1) * ( k + .5_wp ) )  degc_to_k 1236 1238 1237 1239 vp = q(k, j, i) … … 1249 1251 ! The magnus formula is limited to temperatures up to 333.15 K to 1250 1252 ! 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 ) ) 1252 1254 vp = vp * pair / ( vp + 0.622_wp ) 1253 1255 IF ( vp > vp_sat ) vp = vp_sat 
palm/trunk/SOURCE/biometeorology_pt_mod.f90
r3448 r3464 20 20 !! 21 21 ! 22 ! Current revisions: 00123 !  22 ! Current revisions: 23 !  24 24 ! 25 25 ! 26 ! Former revisions: 00126 ! Former revisions: 27 27 !  28 28 ! $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 30 35 ! 31 36 ! … … 116 121 ! Description: 117 122 !  118 !> PT_BASIC.F90 Version of perceived temperature (PT, °C) for123 !> PT_BASIC.F90 Version of perceived temperature (PT, ï¿œC) for 119 124 !>  standard measured/predicted meteorological values and TMRT 120 125 !> as input; … … 131 136 132 137 ! 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) 134 139 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) 136 141 REAL(wp), INTENT ( IN ) :: vau1m !< Local wind velocitry (m/s) 137 142 REAL(wp), INTENT ( IN ) :: pb !< Local barometric air pressure (hPa) 138 143 139 144 ! 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) 141 146 REAL(wp), INTENT ( OUT ) :: clo !< Clothing index (dimensionless) 142 147 … … 301 306 !  302 307 !> 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). 304 309 !> For example, tt can be the air temperature or the dew point temperature. 305 310 !! … … 308 313 IMPLICIT NONE 309 314 310 REAL(wp), INTENT ( IN ) :: tt !< ambient air temperature ( °C)315 REAL(wp), INTENT ( IN ) :: tt !< ambient air temperature (ï¿œC) 311 316 REAL(wp), INTENT ( OUT ) :: p_st !< saturation water vapour pressure (hPa) 312 317 … … 316 321 317 322 IF ( tt < 0._wp ) THEN 318 ! tt < 0 ( °C): saturation water vapour pressure over ice323 ! tt < 0 (ï¿œC): saturation water vapour pressure over ice 319 324 b = 17.84362_wp 320 325 c = 245.425_wp 321 326 ELSE 322 ! tt >= 0 ( °C): saturation water vapour pressure over water327 ! tt >= 0 (ï¿œC): saturation water vapour pressure over water 323 328 b = 17.08085_wp 324 329 c = 234.175_wp … … 346 351 347 352 ! 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) 350 355 REAL(wp), INTENT ( IN ) :: el2m !< Water vapour pressure (hPa) 351 356 REAL(wp), INTENT ( IN ) :: vau1m !< Wind speed (m/s) 1 m above ground … … 362 367 ! Output variables of argument list: 363 368 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 PMV369 REAL(wp), INTENT ( OUT ) :: top !< Operative temperature (ï¿œC) at found root of Fanger's PMV 365 370 REAL(wp), INTENT ( OUT ) :: clo_res !< Resulting clothing insulation value (clo) 366 371 INTEGER(iwp), INTENT ( OUT ) :: nerr !< Error status / quality flag … … 488 493 REAL(wp), INTENT ( IN ) :: pmv !< Fangers predicted mean vote (dimensionless) 489 494 REAL(wp), INTENT ( IN ) :: clo !< clothing insulation index (clo) 490 REAL(wp), INTENT ( OUT ) :: pt !< pt ( °C) corresponding to given PMV / clo495 REAL(wp), INTENT ( OUT ) :: pt !< pt (ï¿œC) corresponding to given PMV / clo 491 496 492 497 IF ( pmv <= 0.11_wp ) THEN … … 517 522 518 523 ! 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) 521 526 REAL(wp), INTENT ( IN ) :: pa !< Water vapour pressure (hPa) 522 527 REAL(wp), INTENT ( IN ) :: pb !< Barometric pressure (hPa) at site … … 530 535 ! to Fanger corresponding to meteorological (tt,tmrt,pa,vau,pb) 531 536 ! and individual variables (clo, actlev, eta) 532 REAL(wp), INTENT ( OUT ) :: top !< operative temperature ( °C)537 REAL(wp), INTENT ( OUT ) :: top !< operative temperature (ï¿œC) 533 538 534 539 ! Internal variables … … 638 643 ! Input variables of argument list: 639 644 REAL(wp), INTENT ( IN ) :: pmva !< Actual Predicted Mean Vote (PMV) according to Fanger 640 REAL(wp), INTENT ( IN ) :: tt2m !< Ambient temperature ( °C) at screen level645 REAL(wp), INTENT ( IN ) :: tt2m !< Ambient temperature (ï¿œC) at screen level 641 646 REAL(wp), INTENT ( IN ) :: el2m !< Water vapour pressure (hPa) at screen level 642 647 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 level648 REAL(wp), INTENT ( IN ) :: tmrt !< Mean radiant temperature (ï¿œC) at screen level 644 649 REAL(wp), INTENT ( IN ) :: vau1m !< Wind speed (m/s) 1 m above ground 645 650 … … 724 729 nerr = 3_iwp 725 730 IF ( el2m < p10 ) THEN 726 ! Due to conditions of regress íon: r.H. >= 5 %731 ! Due to conditions of regressï¿œon: r.H. >= 5 % 727 732 pa = p10 728 733 ELSE 729 ! Due to conditions of regress íon: r.H. <= 95 %734 ! Due to conditions of regressï¿œon: r.H. <= 95 % 730 735 pa = p95 731 736 ENDIF … … 733 738 IF ( pa > 0._wp ) THEN 734 739 ! Natural logarithm of pa 735 apa = DLOG ( pa )740 apa = LOG ( pa ) 736 741 ELSE 737 742 apa = 5._wp … … 741 746 pa_p50 = 0.5_wp * svp_tt 742 747 IF ( pa_p50 > 0._wp .AND. pa > 0._wp ) THEN 743 dapa = apa  DLOG ( pa_p50 )748 dapa = apa  LOG ( pa_p50 ) 744 749 pa_p50 = pa / pa_p50 745 750 ELSE … … 765 770 RETURN 766 771 ENDIF 767 gew = DMOD ( pmv, 1._wp )772 gew = MOD ( pmv, 1._wp ) 768 773 IF ( gew < 0._wp ) gew = 0._wp 769 774 IF ( nreg > 5_iwp ) THEN … … 834 839 !> velocity: 835 840 !>  defined only under warm conditions: gtc based on 0.5 (clo) and 836 !> gtc > 16.826 ( °C)841 !> gtc > 16.826 (ï¿œC) 837 842 !>  undefined: sultr_res set at +99. 838 843 !! … … 904 909 ! Type of input arguments 905 910 REAL(wp), INTENT ( IN ) :: pmva !< Fanger's classical predicted mean vote 906 REAL(wp), INTENT ( IN ) :: tt2m !< Air temperature ( °C) 2 m above ground911 REAL(wp), INTENT ( IN ) :: tt2m !< Air temperature (ï¿œC) 2 m above ground 907 912 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) 909 914 910 915 ! Type of output argument … … 1036 1041 !> (neither body cooling nor body heating). It is related to the Klima 1037 1042 !> Michel activity level (134.682 W/m2). IREQ_neutral is only defined 1038 !> for gt < 10 ( °C)1043 !> for gt < 10 (ï¿œC) 1039 1044 !! 1040 1045 REAL(wp) FUNCTION ireq_neutral( gt, ireq_minimal, nerr ) … … 1059 1064 ireq_neutral = 1.62_wp  0.0564_wp * top02 1060 1065 1061 ! Regression only defined for gt <= 10 ( °C)1066 ! Regression only defined for gt <= 10 (ï¿œC) 1062 1067 IF ( ireq_neutral < 0.5_wp ) THEN 1063 1068 IF ( ireq_neutral < 0.48_wp ) THEN 
palm/trunk/SOURCE/netcdf_data_input_mod.f90
r3459 r3464 20 20 ! Current revisions: 21 21 !  22 ! Define coordinate reference system (crs) and read from input dataset 23 ! Revise default values for reference coordinates 22 ! 24 23 ! 25 24 ! Former revisions: 26 25 !  27 26 ! $Id$ 27 ! Define coordinate reference system (crs) and read from input dataset 28 ! Revise default values for reference coordinates 29 ! 30 ! 3459 20181030 15:04:11Z gronemeier 28 31 ! from chemistry branch r3443, banzhafs, Russo: 29 32 ! Uncommented lines on dimension of surface_fractions 
palm/trunk/SOURCE/netcdf_interface_mod.f90
r3459 r3464 20 20 ! Current revisions: 21 21 !  22 ! 23 ! 24 ! Former revisions: 25 !  26 ! $Id$ 22 27 !  Add variable crs to output files 23 28 !  Add long_name to UTM coordinates … … 25 30 ! only written if parallel output is used. 26 31 ! 27 ! Former revisions: 28 !  29 ! $Id$ 32 ! 3459 20181030 15:04:11Z gronemeier 30 33 ! Adjustment of biometeorology calls 31 34 ! 
palm/trunk/SOURCE/radiation_model_mod.f90
r3449 r3464 28 28 !  29 29 ! $Id$ 30 ! From branch resler@3462, pavelkrc: 31 ! add MRT shaping function for human 32 ! 33 ! 3449 20181029 19:36:56Z suehring 30 34 ! New RTM version 3.0: (Pavel Krc, Jaroslav Resler, ICS, Prague) 31 35 !  Interaction of plant canopy with LW radiation … … 902 906 LOGICAL :: mrt_skip_roof = .TRUE. !< do not calculate MRT above roof surfaces 903 907 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 904 909 INTEGER(iwp) :: nrefsteps = 3 !< number of reflection steps to perform 905 910 REAL(wp), PARAMETER :: ext_coef = 0.6_wp !< extinction coefficient (a.k.a. alpha) … … 1172 1177 ! Public variables and constants / NEEDS SORTING 1173 1178 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, & 1175 1180 mrt_include_sw, mrt_nlevels, mrtbl, mrtinsw, mrtinlw, nmrtbl, & 1176 1181 rad_net_av, radiation, radiation_scheme, rad_lw_in, & … … 2942 2947 constant_albedo, dt_radiation, emissivity, & 2943 2948 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, & 2945 2951 mrt_skip_roof, net_radiation, nrefsteps, & 2946 2952 plant_lw_interact, rad_angular_discretization,& … … 2957 2963 constant_albedo, dt_radiation, emissivity, & 2958 2964 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, & 2960 2967 mrt_skip_roof, net_radiation, nrefsteps, & 2961 2968 plant_lw_interact, rad_angular_discretization,& … … 6553 6560 zbdry(:) = (/( zn0+REAL(izn,wp)*zns, izn=0, nzn )/) 6554 6561 vffrac0(:) = (COS(zbdry(0:nzn1))  COS(zbdry(1:nzn))) / 2._wp / REAL(naz, wp) 6562 ! 6563 !Modify direction weights to simulate human body (lower weight for topdown) 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 6555 6568 6556 6569 DO imrt = 1, nmrtbl
Note: See TracChangeset
for help on using the changeset viewer.