source: palm/trunk/SOURCE/init_cloud_physics.f90 @ 1361

Last change on this file since 1361 was 1361, checked in by hoffmann, 10 years ago

improved version of two-moment cloud physics

  • Property svn:keywords set to Id
File size: 5.6 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-2014 Leibniz Universitaet Hannover
18!--------------------------------------------------------------------------------!
19!
20! Current revisions:
21! -----------------
22! sed_qc_const is now calculated here (2-moment microphysics)
23!
24! Former revisions:
25! ------------------
26! $Id: init_cloud_physics.f90 1361 2014-04-16 15:17:48Z hoffmann $
27!
28! 1353 2014-04-08 15:21:23Z heinze
29! REAL constants provided with KIND-attribute
30!
31! 1334 2014-03-25 12:21:40Z heinze
32! Bugfix: REAL constants provided with KIND-attribute
33!
34! 1322 2014-03-20 16:38:49Z raasch
35! REAL constants defined as wp-kind
36!
37! 1320 2014-03-20 08:40:49Z raasch
38! ONLY-attribute added to USE-statements,
39! kind-parameters added to all INTEGER and REAL declaration statements,
40! kinds are defined in new module mod_kinds,
41! revision history before 2012 removed,
42! comment fields (!:) to be used for variable explanations added to
43! all variable declaration statements
44!
45! 1065 2012-11-22 17:42:36Z hoffmann
46! The Courant number of sedimentation can be controlled with c_sedimentation.
47!
48! 1053 2012-11-13 17:11:03Z hoffmann
49! calculation of the maximum timestep according to the terminal velocity of rain
50! drops in the two moment cloud scheme
51!
52! calculation of frequently used constants (pirho_l, dpirho_l, schmidt_p_1d3,
53! hyrho)
54!
55! 1036 2012-10-22 13:43:42Z raasch
56! code put under GPL (PALM 3.9)
57!
58! 824 2012-02-17 09:09:57Z raasch
59! calculation of b_cond replaced by calculation of bfactor
60!
61! Revision 1.1  2000/04/13 14:37:22  schroeter
62! Initial revision
63!
64!
65! Description:
66! ------------
67! Initialization of parameters for handling cloud-physics
68!------------------------------------------------------------------------------!
69
70    USE arrays_3d,                                                             &
71        ONLY:  dzu, hyp, pt_init, zu
72       
73    USE cloud_parameters,                                                      &
74        ONLY:  bfactor, cp, c_sedimentation, dpirho_l, dt_precipitation,       &
75               hyrho, k_st, l_d_cp, l_d_r, l_d_rv, l_v, mass_of_solute,  &
76               molecular_weight_of_solute, molecular_weight_of_water, pirho_l, &
77               pt_d_t, rho_l, r_d, r_v, sed_qc_const, schmidt, schmidt_p_1d3,  &
78               sigma_gc, t_d_pt, vanthoff, w_precipitation
79       
80    USE constants,                                                             &
81        ONLY:  pi
82       
83    USE control_parameters,                                                    &
84        ONLY:  g, icloud_scheme, message_string, precipitation, pt_surface,    &
85               rho_surface, surface_pressure
86   
87    USE indices,                                                               &
88        ONLY:  nzb, nzt
89   
90    USE kinds
91
92    IMPLICIT NONE
93
94    INTEGER(iwp) ::  k      !:
95   
96    REAL(wp) ::  t_surface  !:
97
98    ALLOCATE( hyp(nzb:nzt+1), pt_d_t(nzb:nzt+1), t_d_pt(nzb:nzt+1),            &
99              hyrho(nzb:nzt+1) )
100
101!
102!-- Calculate frequently used parameters
103    l_d_cp = l_v / cp
104    l_d_r  = l_v / r_d
105    l_d_rv = l_v / r_v
106
107    schmidt_p_1d3 = schmidt**( 1.0_wp / 3.0_wp )
108
109    pirho_l  = pi * rho_l / 6.0_wp
110    dpirho_l = 1.0_wp / pirho_l
111!
112!-- constant fot the sedimentation of cloud water (2-moment cloud physics)
113    sed_qc_const = k_st * ( 3.0_wp / ( 4.0_wp * pi * rho_l )                   &
114                          )**( 2.0_wp / 3.0_wp ) *                             &
115                   EXP( 5.0_wp * LOG( sigma_gc )**2 )
116!
117!-- Calculate timestep according to precipitation
118    IF ( icloud_scheme == 0  .AND.  precipitation )  THEN
119       dt_precipitation = c_sedimentation * MINVAL( dzu(nzb+2:nzt) ) /         &
120                          w_precipitation
121    ENDIF
122!
123!-- Calculate factor used in equation for droplet growth by condensation
124    bfactor = 3.0_wp * vanthoff * mass_of_solute * molecular_weight_of_water   &
125              / ( 4.0_wp * pi * rho_l * molecular_weight_of_solute )
126!
127!-- Calculate:
128!-- pt / t : ratio of potential and actual temperature (pt_d_t)
129!-- t / pt : ratio of actual and potential temperature (t_d_pt)
130!-- p_0(z) : vertical profile of the hydrostatic pressure (hyp)
131    t_surface = pt_surface * ( surface_pressure / 1000.0_wp )**0.286_wp
132    DO  k = nzb, nzt+1
133!
134!--    Check temperature in case of too large domain height
135       IF ( ( t_surface - g/cp * zu(k) ) < 0.0_wp )  THEN
136          WRITE( message_string, * )  'absolute temperature < 0.0 at zu(', k, &
137                                      ') = ', zu(k)
138          CALL message( 'init_cloud_physics', 'PA0142', 1, 2, 0, 6, 0 )
139       ENDIF
140       hyp(k)    = surface_pressure * 100.0_wp * &
141                   ( (t_surface - g/cp * zu(k)) / t_surface )**(1.0_wp/0.286_wp)
142       pt_d_t(k) = ( 100000.0_wp / hyp(k) )**0.286_wp
143       t_d_pt(k) = 1.0_wp / pt_d_t(k)
144       hyrho(k)  = hyp(k) / ( r_d * t_d_pt(k) * pt_init(k) )       
145    ENDDO
146
147!
148!-- Compute reference density
149    rho_surface = surface_pressure * 100.0_wp / ( r_d * t_surface )
150
151
152 END SUBROUTINE init_cloud_physics
Note: See TracBrowser for help on using the repository browser.