Changeset 3464 for palm/trunk/SOURCE/biometeorology_mod.f90

Timestamp:

Oct 30, 2018 6:08:55 PM (4 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)

File:

• palm/trunk/SOURCE/biometeorology_mod.f90 (modified) (10 diffs)

palm/trunk/SOURCE/biometeorology_mod.f90

@@ -27 +27 @@
 ! -----------------
 ! $Id$
+! From branch resler@3462, pavelkrc:
+! make use of basic_constants_and_equations_mod
+! 
+! 3448 2018-10-29 18:14:31Z kanani
 ! Initial revision
 !
@@ -60 +64 @@
 
     USE basic_constants_and_equations_mod,                                     &
-       ONLY:  magnus
+       ONLY:  degc_to_k, magnus, sigma_sb
 
     USE biometeorology_ipt_mod
@@ -113 +117 @@
     REAL ( wp )    ::  biom_output_height  !< height output is calculated in m
     REAL ( wp )    ::  time_biom_results   !< the time, the last set of biom results have been calculated for
-    REAL ( wp ), PARAMETER ::  cels_offs = 273.15_wp  !< Kelvin-Celsius offset (K)
-    REAL ( wp ), PARAMETER ::  sigma_sb  = 5.67037321E-8_wp  !< Stefan-Boltzmann constant
     REAL ( wp ), PARAMETER ::  human_absorb = 0.7_wp  !< SW absorbtivity of a human body (Fanger 1972)
     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(:) + &
                           ((human_absorb*mrtinsw(:) + human_emiss*mrtinlw(:))  &
-                          / (human_emiss*sigma_sb)) ** .25_wp - cels_offs
+                          / (human_emiss*sigma_sb)) ** .25_wp - degc_to_k
                     ELSE
                        biom_mrt_av(:) = biom_mrt_av(:) + &
                           (human_emiss * mrtinlw(:) / sigma_sb) ** .25_wp      &
-                          - cels_offs
+                          - degc_to_k
                     ENDIF
                  ENDIF
@@ -1046 +1048 @@
 
 !-- Compute mean radiant temperature
-    tmrt = ( nrfd / (human_emiss * sigma_sb) )**0.25_wp - cels_offs
+    tmrt = ( nrfd / (human_emiss * sigma_sb) )**0.25_wp - degc_to_k
 
  END SUBROUTINE calculate_tmrt_6_directions
@@ -1122 +1124 @@
 
     sw_side = sw_in * 0.125_wp  ! distribute half of upper sw_in to the 4 sides
-    lw_air = ( sigma_sb * 0.95_wp * ( ta + cels_offs )**4 )
+    lw_air = ( sigma_sb * 0.95_wp * ( ta + degc_to_k )**4 )
 
 !-- Compute mean radiation flux density absorbed by rotational symetric human
@@ -1133 +1135 @@
 
 !-- Compute mean radiant temperature
-    tmrt = ( nrfd / (human_emiss * sigma_sb) )**0.25_wp - cels_offs
+    tmrt = ( nrfd / (human_emiss * sigma_sb) )**0.25_wp - degc_to_k
 
  END SUBROUTINE calculate_tmrt_2_directions
@@ -1221 +1223 @@
     IF ( average_input ) THEN
 !--    Calculate ta from Tp assuming dry adiabatic laps rate
-       ta = pt_av(k, j, i) - ( 0.0098_wp * dz(1) * (  k + .5_wp ) ) - cels_offs
+       ta = pt_av(k, j, i) - ( 0.0098_wp * dz(1) * (  k + .5_wp ) ) - degc_to_k
 
        vp = 0.034_wp
@@ -1233 +1235 @@
     ELSE
 !-- Calculate ta from Tp assuming dry adiabatic laps rate
-       ta = pt(k, j, i) - ( 0.0098_wp * dz(1) * (  k + .5_wp ) ) - cels_offs
+       ta = pt(k, j, i) - ( 0.0098_wp * dz(1) * (  k + .5_wp ) ) - degc_to_k
 
        vp = q(k, j, i)
@@ -1249 +1251 @@
 !-- The magnus formula is limited to temperatures up to 333.15 K to
 !   avoid negative values of vp_sat
-    vp_sat = 0.01_wp * magnus( MIN( ta + cels_offs, 333.15_wp ) )
+    vp_sat = 0.01_wp * magnus( MIN( ta + degc_to_k, 333.15_wp ) )
     vp  = vp * pair / ( vp + 0.622_wp )
     IF ( vp > vp_sat ) vp = vp_sat