source: palm/tags/release-3.10/SOURCE/init_cloud_physics.f90 @ 1614

Last change on this file since 1614 was 1066, checked in by hoffmann, 11 years ago

last commit documented

  • Property svn:keywords set to Id
File size: 4.1 KB
Line 
1 SUBROUTINE init_cloud_physics
2
3!--------------------------------------------------------------------------------!
4! This file is part of PALM.
5!
6! PALM is free software: you can redistribute it and/or modify it under the terms
7! of the GNU General Public License as published by the Free Software Foundation,
8! either version 3 of the License, or (at your option) any later version.
9!
10! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
11! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
12! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
13!
14! You should have received a copy of the GNU General Public License along with
15! PALM. If not, see <http://www.gnu.org/licenses/>.
16!
17! Copyright 1997-2012  Leibniz University Hannover
18!--------------------------------------------------------------------------------!
19!
20! Current revisions:
21! -----------------
22!
23! Former revisions:
24! ------------------
25! $Id: init_cloud_physics.f90 1066 2012-11-22 17:52:43Z maronga $
26!
27! 1065 2012-11-22 17:42:36Z hoffmann
28! The Courant number of sedimentation can be controlled with c_sedimentation.
29!
30! 1053 2012-11-13 17:11:03Z hoffmann
31! calculation of the maximum timestep according to the terminal velocity of rain
32! drops in the two moment cloud scheme
33!
34! calculation of frequently used constants (pirho_l, dpirho_l, schmidt_p_1d3,
35! hyrho)
36!
37! 1036 2012-10-22 13:43:42Z raasch
38! code put under GPL (PALM 3.9)
39!
40! 824 2012-02-17 09:09:57Z raasch
41! calculation of b_cond replaced by calculation of bfactor
42!
43! 221 2009-01-12 15:32:23Z raasch
44! Bugfix: abort in case that absolute temperature is below zero
45!
46! 95 2007-06-02 16:48:38Z raasch
47! hydro_press renamed hyp
48!
49! February 2007
50! RCS Log replace by Id keyword, revision history cleaned up
51!
52! Revision 1.5  2005/06/26 19:55:58  raasch
53! Initialization of cloud droplet constants, gas_constant renamed r_d,
54! latent_heat renamed l_v
55!
56! Revision 1.1  2000/04/13 14:37:22  schroeter
57! Initial revision
58!
59!
60! Description:
61! ------------
62! Initialization of parameters for handling cloud-physics
63!------------------------------------------------------------------------------!
64
65    USE arrays_3d
66    USE cloud_parameters
67    USE constants
68    USE control_parameters
69    USE grid_variables
70    USE indices
71
72    IMPLICIT NONE
73
74    INTEGER ::  k
75    REAL    ::  t_surface
76
77    ALLOCATE( hyp(nzb:nzt+1), pt_d_t(nzb:nzt+1), t_d_pt(nzb:nzt+1),  &
78              hyrho(nzb:nzt+1) )
79
80!
81!-- Calculate frequently used parameters
82    l_d_cp = l_v / cp
83    l_d_r  = l_v / r_d
84    l_d_rv = l_v / r_v
85
86    schmidt_p_1d3 = schmidt**( 1.0 / 3.0 )
87
88    pirho_l  = pi * rho_l / 6.0
89    dpirho_l = 1.0 / pirho_l 
90!
91!-- Calculate timestep according to precipitation
92    IF ( icloud_scheme == 0  .AND.  precipitation )  THEN
93       dt_precipitation = c_sedimentation * MINVAL( dzu(nzb+2:nzt) ) /        &
94                          w_precipitation
95    ENDIF
96!
97!-- Calculate factor used in equation for droplet growth by condensation
98    bfactor = 3.0 * vanthoff * mass_of_solute * molecular_weight_of_water &
99              / ( 4.0 * pi * rho_l * molecular_weight_of_solute )
100!
101!-- Calculate:
102!-- pt / t : ratio of potential and actual temperature (pt_d_t)
103!-- t / pt : ratio of actual and potential temperature (t_d_pt)
104!-- p_0(z) : vertical profile of the hydrostatic pressure (hyp)
105    t_surface = pt_surface * ( surface_pressure / 1000.0 )**0.286
106    DO  k = nzb, nzt+1
107!
108!--    Check temperature in case of too large domain height
109       IF ( ( t_surface - g/cp * zu(k) ) < 0.0 )  THEN
110          WRITE( message_string, * )  'absolute temperature < 0.0 at zu(', k, &
111                                      ') = ', zu(k)
112          CALL message( 'init_cloud_physics', 'PA0142', 1, 2, 0, 6, 0 )
113       ENDIF
114       hyp(k)    = surface_pressure * 100.0 * &
115                   ( (t_surface - g/cp * zu(k)) / t_surface )**(1.0/0.286)
116       pt_d_t(k) = ( 100000.0 / hyp(k) )**0.286
117       t_d_pt(k) = 1.0 / pt_d_t(k)
118       hyrho(k)  = hyp(k) / ( r_d * t_d_pt(k) * pt_init(k) )       
119    ENDDO
120
121!
122!-- Compute reference density
123    rho_surface = surface_pressure * 100.0 / ( r_d * t_surface )
124
125
126 END SUBROUTINE init_cloud_physics
Note: See TracBrowser for help on using the repository browser.