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

Last change on this file since 2233 was 2101, checked in by suehring, 7 years ago

last commit documented

  • Property svn:keywords set to Id
File size: 4.8 KB
Line 
1!> @file init_cloud_physics.f90
2!------------------------------------------------------------------------------!
3! This file is part of PALM.
4!
5! PALM is free software: you can redistribute it and/or modify it under the
6! terms of the GNU General Public License as published by the Free Software
7! Foundation, either version 3 of the License, or (at your option) any later
8! 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-2017 Leibniz Universitaet Hannover
18!------------------------------------------------------------------------------!
19!
20! Current revisions:
21! -----------------
22!
23!
24! Former revisions:
25! ------------------
26! $Id: init_cloud_physics.f90 2101 2017-01-05 16:42:31Z suehring $
27!
28! 2000 2016-08-20 18:09:15Z knoop
29! Forced header and separation lines into 80 columns
30!
31! 1849 2016-04-08 11:33:18Z hoffmann
32! bfactor removed and microphysics constants moved microphysics_mod
33!
34! 1822 2016-04-07 07:49:42Z hoffmann
35! icloud_scheme replaced by microphysics_*
36!
37! 1691 2015-10-26 16:17:44Z maronga
38! Removed typo
39!
40! 1682 2015-10-07 23:56:08Z knoop
41! Code annotations made doxygen readable
42!
43! 1361 2014-04-16 15:17:48Z hoffmann
44! sed_qc_const is now calculated here (2-moment microphysics)
45!
46! 1353 2014-04-08 15:21:23Z heinze
47! REAL constants provided with KIND-attribute
48!
49! 1334 2014-03-25 12:21:40Z heinze
50! Bugfix: REAL constants provided with KIND-attribute
51!
52! 1322 2014-03-20 16:38:49Z raasch
53! REAL constants defined as wp-kind
54!
55! 1320 2014-03-20 08:40:49Z raasch
56! ONLY-attribute added to USE-statements,
57! kind-parameters added to all INTEGER and REAL declaration statements,
58! kinds are defined in new module mod_kinds,
59! revision history before 2012 removed,
60! comment fields (!:) to be used for variable explanations added to
61! all variable declaration statements
62!
63! 1065 2012-11-22 17:42:36Z hoffmann
64! The Courant number of sedimentation can be controlled with c_sedimentation.
65!
66! 1053 2012-11-13 17:11:03Z hoffmann
67! calculation of the maximum timestep according to the terminal velocity of rain
68! drops in the two moment cloud scheme
69!
70! calculation of frequently used constants (pirho_l, dpirho_l, schmidt_p_1d3,
71! hyrho)
72!
73! 1036 2012-10-22 13:43:42Z raasch
74! code put under GPL (PALM 3.9)
75!
76! 824 2012-02-17 09:09:57Z raasch
77! calculation of b_cond replaced by calculation of bfactor
78!
79! Revision 1.1  2000/04/13 14:37:22  schroeter
80! Initial revision
81!
82!
83! Description:
84! ------------
85!> Initialization of parameters for handling cloud-physics
86!------------------------------------------------------------------------------!
87 SUBROUTINE init_cloud_physics
88 
89
90    USE arrays_3d,                                                             &
91        ONLY:  dzu, hyp, pt_init, zu
92       
93    USE cloud_parameters,                                                      &
94        ONLY:  cp, hyrho, l_d_cp, l_d_r, l_d_rv, l_v, pt_d_t, rho_l, r_d, r_v, &
95               t_d_pt
96               
97    USE control_parameters,                                                    &
98        ONLY:  g, message_string, pt_surface, rho_surface, surface_pressure
99   
100    USE indices,                                                               &
101        ONLY:  nzb, nzt
102   
103    USE kinds
104
105    IMPLICIT NONE
106
107    INTEGER(iwp) ::  k      !<
108   
109    REAL(wp) ::  t_surface  !<
110
111    ALLOCATE( hyp(nzb:nzt+1), pt_d_t(nzb:nzt+1), t_d_pt(nzb:nzt+1),            &
112              hyrho(nzb:nzt+1) )
113
114!
115!-- Calculate frequently used parameters
116    l_d_cp = l_v / cp
117    l_d_r  = l_v / r_d
118    l_d_rv = l_v / r_v
119
120!
121!-- Calculate:
122!-- pt / t : ratio of potential and actual temperature (pt_d_t)
123!-- t / pt : ratio of actual and potential temperature (t_d_pt)
124!-- p_0(z) : vertical profile of the hydrostatic pressure (hyp)
125    t_surface = pt_surface * ( surface_pressure / 1000.0_wp )**0.286_wp
126    DO  k = nzb, nzt+1
127!
128!--    Check temperature in case of too large domain height
129       IF ( ( t_surface - g/cp * zu(k) ) < 0.0_wp )  THEN
130          WRITE( message_string, * )  'absolute temperature < 0.0 at zu(', k, &
131                                      ') = ', zu(k)
132          CALL message( 'init_cloud_physics', 'PA0142', 1, 2, 0, 6, 0 )
133       ENDIF
134       hyp(k)    = surface_pressure * 100.0_wp * &
135                   ( (t_surface - g/cp * zu(k)) / t_surface )**(1.0_wp/0.286_wp)
136       pt_d_t(k) = ( 100000.0_wp / hyp(k) )**0.286_wp
137       t_d_pt(k) = 1.0_wp / pt_d_t(k)
138       hyrho(k)  = hyp(k) / ( r_d * t_d_pt(k) * pt_init(k) )       
139    ENDDO
140
141!
142!-- Compute reference density
143    rho_surface = surface_pressure * 100.0_wp / ( r_d * t_surface )
144
145
146 END SUBROUTINE init_cloud_physics
Note: See TracBrowser for help on using the repository browser.