Changeset 4304 for palm/trunk

Timestamp:

Nov 25, 2019 10:43:03 AM (5 years ago)

Author:

banzhafs

Message:

Precision clean-up in drydepo_aero_zhang_vd subroutine in chemistry_model_mod

File:

• palm/trunk/SOURCE/chemistry_model_mod.f90 (modified) (5 diffs)

palm/trunk/SOURCE/chemistry_model_mod.f90

@@ -27 +27 @@
 ! -----------------
 ! $Id$
+! Precision clean-up in drydepo_aero_zhang_vd subroutine
+!
+! 4292 2019-11-11 13:04:50Z banzhafs
 ! Bugfix for r4290
 !
-! 4290 2019-11-11 12:06:14Z banzhafs $
+! 4290 2019-11-11 12:06:14Z banzhafs
 ! Bugfix in sedimentation resistance calculation in drydepo_aero_zhang_vd subroutine
 !
@@ -5677 +5680 @@
 !
 !-- acceleration of gravity:
-    REAL(wp), PARAMETER         ::  grav = 9.80665   !< m/s2
+    REAL(wp), PARAMETER         ::  grav = 9.80665_wp   !< m/s2
 
 !-- sedimentation velocity
@@ -5711 +5714 @@
 !-- constants 
 
-    REAL(wp), PARAMETER ::  grav     = 9.80665             !< acceleration of gravity (m/s2)
-
-    REAL(wp), PARAMETER ::  beta     = 2.0
-    REAL(wp), PARAMETER ::  epsilon0 = 3.0
-    REAL(wp), PARAMETER ::  kb       = 1.38066e-23
+    REAL(wp), PARAMETER ::  grav     = 9.80665_wp             !< acceleration of gravity (m/s2)
+
+    REAL(wp), PARAMETER ::  beta     = 2.0_wp
+    REAL(wp), PARAMETER ::  epsilon0 = 3.0_wp
+    REAL(wp), PARAMETER ::  kb       = 1.38066E-23_wp
     REAL(wp), PARAMETER ::  pi       = 3.141592654_wp      !< pi
 
     REAL(wp), PARAMETER :: alfa_lu(nlu_dep) = & 
-         (/1.2,  1.2,   1.2,  1.0,  1.0,   100.0, 1.5,  1.2, 50.0, 100.0, 1.2, 1.0, 100.0, 1.2, 50.0/)   
+         (/1.2_wp,  1.2_wp,   1.2_wp,  1.0_wp,  1.0_wp,   100.0_wp, 1.5_wp,  1.2_wp, 50.0_wp, 100.0_wp, &
+               1.2_wp, 1.0_wp, 100.0_wp, 1.2_wp, 50.0_wp/)   
     REAL(wp), PARAMETER :: gamma_lu(nlu_dep) = &
-         (/0.54, 0.54,  0.54, 0.56, 0.56,  0.50,  0.56, 0.54, 0.58, 0.50, 0.54, 0.56, 0.50, 0.54, 0.54/)   
+         (/0.54_wp, 0.54_wp,  0.54_wp, 0.56_wp, 0.56_wp,  0.50_wp,  0.56_wp, 0.54_wp, 0.58_wp, 0.50_wp, &
+              0.54_wp, 0.56_wp, 0.50_wp, 0.54_wp, 0.54_wp/)   
     REAL(wp), PARAMETER ::A_lu(nlu_dep) = &   
-         (/3.0,  3.0,   2.0,  2.0,  7.0,  -99.,   10.0, 3.0, -99., -99.,  3.0, 7.0, -99., 2.0, -99./)
+         (/3.0_wp,  3.0_wp,   2.0_wp,  2.0_wp,  7.0_wp, -99.0_wp, 10.0_wp, 3.0_wp, -99.0_wp, -99.0_wp,  &
+              3.0_wp, 7.0_wp, -99.0_wp, 2.0_wp, -99.0_wp/)
 !
 !--   grass  arabl crops conif decid  water  urba  othr  desr  ice   sav  trf   wai  med   sem     
@@ -5740 +5746 @@
     kinvisc = viscos1 / dens1    !< only needed at surface
 
-    diff_part = kb * tsurf * slipcor / ( 3 * pi * viscos1 * partsize )
+    diff_part = kb * tsurf * slipcor / ( 3.0_wp * pi * viscos1 * partsize )
 !
 !-- Schmidt number
@@ -5751 +5757 @@
 !-- and sticking efficiency R (1 = no rebound)
     IF ( luc == ilu_ice .OR. nwet==9 .OR. luc == ilu_water_sea .OR. luc == ilu_water_inland )  THEN
-       stokes = vs1 * ustar**2 / ( grav * kinvisc )
+       stokes = vs1 * ustar**2.0_wp / ( grav * kinvisc )
        Einterc = 0.0_wp
        Reffic = 1.0_wp
     ELSE IF ( luc == ilu_other .OR. luc == ilu_desert )  THEN     !<tundra of desert
-       stokes = vs1 * ustar**2 / ( grav * kinvisc )
+       stokes = vs1 * ustar**2.0_wp / ( grav * kinvisc )
        Einterc = 0.0_wp
        Reffic = exp( -Stokes**0.5_wp )
     ELSE
-       stokes = vs1 * ustar / (grav * A_lu(luc) * 1.E-3)
-       Einterc = 0.5_wp * ( partsize / (A_lu(luc) * 1E-3 ) )**2
+       stokes = vs1 * ustar / ( grav * A_lu(luc) * 1.0E-3_wp )
+       Einterc = 0.5_wp * ( partsize / (A_lu(luc) * 1.0E-3_wp ) )**2.0_wp
        Reffic = exp( -Stokes**0.5_wp )
     END IF