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

Last change on this file since 1914 was 1852, checked in by hoffmann, 8 years ago

last commit documented

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