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

Last change on this file since 1353 was 1353, checked in by heinze, 10 years ago

REAL constants provided with KIND-attribute

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