source: palm/trunk/SOURCE/subsidence.f90 @ 1383

Last change on this file since 1383 was 1383, checked in by boeske, 10 years ago

last commit documented

  • Property svn:keywords set to Id
File size: 12.0 KB
Line 
1 MODULE subsidence_mod
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!
23!
24! Former revisions:
25! -----------------
26! $Id: subsidence.f90 1383 2014-04-30 12:17:54Z boeske $
27!
28! 1382 2014-04-30 12:15:41Z boeske
29! Changed the weighting factor that is used in the summation of subsidence
30! tendencies for profile data output from weight_pres to weight_substep
31! added Neumann boundary conditions for profile data output of subsidence terms
32! at nzt+1
33!
34! 1380 2014-04-28 12:40:45Z heinze
35! Shifting only necessary in case of scalar Rayleigh damping
36!
37! 1365 2014-04-22 15:03:56Z boeske
38! Summation of subsidence tendencies for data output added
39! +ls_index, sums_ls_l, tmp_tend
40!
41! 1353 2014-04-08 15:21:23Z heinze
42! REAL constants provided with KIND-attribute
43!
44! 1320 2014-03-20 08:40:49Z raasch
45! ONLY-attribute added to USE-statements,
46! kind-parameters added to all INTEGER and REAL declaration statements,
47! kinds are defined in new module kinds,
48! old module precision_kind is removed,
49! revision history before 2012 removed,
50! comment fields (!:) to be used for variable explanations added to
51! all variable declaration statements
52!
53! 1036 2012-10-22 13:43:42Z raasch
54! code put under GPL (PALM 3.9)
55!
56! Revision 3.7 2009-12-11 14:15:58Z heinze
57! Initial revision
58!
59! Description:
60! ------------
61! Impact of large-scale subsidence or ascent as tendency term for use
62! in the prognostic equation of potential temperature. This enables the
63! construction of a constant boundary layer height z_i with time.
64!-----------------------------------------------------------------------------!
65
66
67    IMPLICIT NONE
68
69    PRIVATE
70    PUBLIC  init_w_subsidence, subsidence
71
72    INTERFACE init_w_subsidence
73       MODULE PROCEDURE init_w_subsidence
74    END INTERFACE init_w_subsidence
75
76    INTERFACE subsidence
77       MODULE PROCEDURE subsidence
78       MODULE PROCEDURE subsidence_ij
79    END INTERFACE subsidence
80
81 CONTAINS
82
83    SUBROUTINE init_w_subsidence 
84
85       USE arrays_3d,                                                          &
86           ONLY:  dzu, w_subs, zu
87
88       USE control_parameters,                                                 &
89           ONLY:  message_string, ocean, subs_vertical_gradient,               &
90                  subs_vertical_gradient_level, subs_vertical_gradient_level_i
91
92       USE indices,                                                            &
93           ONLY:  nzb, nzt
94
95       USE kinds
96
97       IMPLICIT NONE
98
99       INTEGER(iwp) ::  i !:
100       INTEGER(iwp) ::  k !:
101
102       REAL(wp)     ::  gradient   !:
103       REAL(wp)     ::  ws_surface !:
104
105       IF ( .NOT. ALLOCATED( w_subs ))  THEN
106          ALLOCATE( w_subs(nzb:nzt+1) )
107          w_subs = 0.0_wp
108       ENDIF
109
110       IF ( ocean )  THEN
111          message_string = 'Applying large scale vertical motion is not ' // &
112                           'allowed for ocean runs'
113          CALL message( 'init_w_subsidence', 'PA0324', 2, 2, 0, 6, 0 )
114       ENDIF
115
116!
117!--   Compute the profile of the subsidence/ascent velocity
118!--   using the given gradients
119      i = 1
120      gradient = 0.0_wp
121      ws_surface = 0.0_wp
122     
123
124      subs_vertical_gradient_level_i(1) = 0
125      DO  k = 1, nzt+1
126         IF ( i < 11 )  THEN
127            IF ( subs_vertical_gradient_level(i) < zu(k)  .AND. &
128                 subs_vertical_gradient_level(i) >= 0.0_wp )  THEN
129               gradient = subs_vertical_gradient(i) / 100.0_wp
130               subs_vertical_gradient_level_i(i) = k - 1
131               i = i + 1
132            ENDIF
133         ENDIF
134         IF ( gradient /= 0.0_wp )  THEN
135            IF ( k /= 1 )  THEN
136               w_subs(k) = w_subs(k-1) + dzu(k) * gradient
137            ELSE
138               w_subs(k) = ws_surface   + 0.5_wp * dzu(k) * gradient
139            ENDIF
140         ELSE
141            w_subs(k) = w_subs(k-1)
142         ENDIF
143      ENDDO
144
145!
146!--   In case of no given gradients for the subsidence/ascent velocity,
147!--   choose zero gradient
148      IF ( subs_vertical_gradient_level(1) == -9999999.9_wp )  THEN
149         subs_vertical_gradient_level(1) = 0.0_wp
150      ENDIF
151
152    END SUBROUTINE init_w_subsidence
153
154
155    SUBROUTINE subsidence( tendency, var, var_init, ls_index ) 
156
157       USE arrays_3d,                                                          &
158           ONLY:  ddzu, w_subs
159
160       USE control_parameters,                                                 &
161           ONLY:  dt_3d, intermediate_timestep_count, large_scale_forcing,     &
162                  scalar_rayleigh_damping
163
164       USE indices,                                                            &
165           ONLY:  nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb, nzb_s_inner,&
166                  nzt
167
168       USE kinds
169
170       USE statistics,                                                         &
171           ONLY:  sums_ls_l, weight_substep
172
173       IMPLICIT NONE
174 
175       INTEGER(iwp) ::  i !:
176       INTEGER(iwp) ::  j !:
177       INTEGER(iwp) ::  k !:
178       INTEGER(iwp) ::  ls_index !:
179
180       REAL(wp)     ::  tmp_tend !:
181       REAL(wp)     ::  tmp_grad !:
182   
183       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  var      !:
184       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  tendency !:
185       REAL(wp), DIMENSION(nzb:nzt+1) ::  var_init                     !:
186       REAL(wp), DIMENSION(nzb:nzt+1) ::  var_mod                      !:
187
188       var_mod = var_init
189
190!
191!--    Influence of w_subsidence on the current tendency term
192       DO  i = nxl, nxr
193          DO  j = nys, nyn
194
195             DO  k = nzb_s_inner(j,i)+1, nzt 
196                IF ( w_subs(k) < 0.0_wp )  THEN    ! large-scale subsidence
197                   tmp_tend = - w_subs(k) *                                    &
198                              ( var(k+1,j,i) - var(k,j,i) ) * ddzu(k+1)
199                ELSE                               ! large-scale ascent
200                   tmp_tend = - w_subs(k) *                                    &
201                              ( var(k,j,i) - var(k-1,j,i) ) * ddzu(k)
202                ENDIF
203
204                tendency(k,j,i) = tendency(k,j,i) + tmp_tend
205
206                IF ( large_scale_forcing )  THEN
207                   sums_ls_l(k,ls_index) = sums_ls_l(k,ls_index) + tmp_tend    &
208                                   * weight_substep(intermediate_timestep_count)
209                ENDIF
210             ENDDO
211
212             sums_ls_l(nzt+1,ls_index) = sums_ls_l(nzt,ls_index)
213
214          ENDDO
215       ENDDO
216
217!
218!--    Shifting of the initial profile is especially necessary with Rayleigh
219!--    damping switched on
220       IF ( scalar_rayleigh_damping ) THEN
221          DO  k = nzb, nzt
222             IF ( w_subs(k) < 0.0_wp )  THEN      ! large-scale subsidence
223                var_mod(k) = var_init(k) - dt_3d * w_subs(k) *  &
224                                  ( var_init(k+1) - var_init(k) ) * ddzu(k+1)
225             ENDIF
226          ENDDO
227!
228!--      At the upper boundary, the initial profile is shifted with aid of
229!--      the gradient tmp_grad. (This is ok if the gradients are linear.)
230         IF ( w_subs(nzt) < 0.0_wp )  THEN
231            tmp_grad = ( var_init(nzt+1) - var_init(nzt) ) * ddzu(nzt+1)
232            var_mod(nzt+1) = var_init(nzt+1) -  &
233                                 dt_3d * w_subs(nzt+1) * tmp_grad
234         ENDIF
235       
236
237         DO  k = nzt+1, nzb+1, -1
238            IF ( w_subs(k) >= 0.0_wp )  THEN  ! large-scale ascent
239               var_mod(k) = var_init(k) - dt_3d * w_subs(k) *  &
240                                  ( var_init(k) - var_init(k-1) ) * ddzu(k) 
241            ENDIF
242         ENDDO
243!
244!--      At the lower boundary shifting is not necessary because the
245!--      subsidence velocity w_subs(nzb) vanishes.
246         IF ( w_subs(nzb+1) >= 0.0_wp )  THEN
247            var_mod(nzb) = var_init(nzb)
248         ENDIF
249
250         var_init = var_mod
251      ENDIF
252
253
254 END SUBROUTINE subsidence
255
256 SUBROUTINE subsidence_ij( i, j, tendency, var, var_init, ls_index ) 
257
258       USE arrays_3d,                                                          &
259           ONLY:  ddzu, w_subs
260
261       USE control_parameters,                                                 &
262           ONLY:  dt_3d, intermediate_timestep_count, large_scale_forcing,     &
263                  scalar_rayleigh_damping
264
265       USE indices,                                                            &
266           ONLY:  nxl, nxlg, nxrg, nyng, nys, nysg, nzb_s_inner, nzb, nzt
267
268       USE kinds
269
270       USE statistics,                                                         &
271           ONLY:  sums_ls_l, weight_substep
272
273       IMPLICIT NONE
274 
275       INTEGER(iwp) ::  i !:
276       INTEGER(iwp) ::  j !:
277       INTEGER(iwp) ::  k !:
278       INTEGER(iwp) ::  ls_index !:
279
280       REAL(wp)     ::  tmp_tend !:
281       REAL(wp)     ::  tmp_grad !:
282   
283       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  var      !:
284       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  tendency !:
285       REAL(wp), DIMENSION(nzb:nzt+1) ::  var_init                     !:
286       REAL(wp), DIMENSION(nzb:nzt+1) ::  var_mod                      !:
287
288       var_mod = var_init
289
290!
291!--    Influence of w_subsidence on the current tendency term
292       DO  k = nzb_s_inner(j,i)+1, nzt 
293          IF ( w_subs(k) < 0.0_wp )  THEN      ! large-scale subsidence
294             tmp_tend = - w_subs(k) * ( var(k+1,j,i) - var(k,j,i) ) * ddzu(k+1)
295          ELSE                                 ! large-scale ascent
296             tmp_tend = - w_subs(k) * ( var(k,j,i) - var(k-1,j,i) ) * ddzu(k)
297          ENDIF
298
299          tendency(k,j,i) = tendency(k,j,i) + tmp_tend
300
301          IF ( large_scale_forcing )  THEN
302             sums_ls_l(k,ls_index) = sums_ls_l(k,ls_index) + tmp_tend          &
303                                   * weight_substep(intermediate_timestep_count)
304          ENDIF
305       ENDDO
306
307       sums_ls_l(nzt+1,ls_index) = sums_ls_l(nzt,ls_index)
308
309
310!
311!--    Shifting of the initial profile is especially necessary with Rayleigh
312!--    damping switched on
313       IF ( scalar_rayleigh_damping ) THEN
314          IF ( i == nxl .AND. j == nys )  THEN ! shifting only once per PE
315
316             DO  k = nzb, nzt
317                IF ( w_subs(k) < 0.0_wp )  THEN      ! large-scale subsidence
318                   var_mod(k) = var_init(k) - dt_3d * w_subs(k) *  &
319                                     ( var_init(k+1) - var_init(k) ) * ddzu(k+1)
320                ENDIF
321             ENDDO
322!
323!--          At the upper boundary, the initial profile is shifted with aid of
324!--          the gradient tmp_grad. (This is ok if the gradients are linear.)
325             IF ( w_subs(nzt) < 0.0_wp )  THEN
326                tmp_grad = ( var_init(nzt+1) - var_init(nzt) ) * ddzu(nzt+1)
327                var_mod(nzt+1) = var_init(nzt+1) -  &
328                                     dt_3d * w_subs(nzt+1) * tmp_grad
329             ENDIF
330       
331
332             DO  k = nzt+1, nzb+1, -1
333                IF ( w_subs(k) >= 0.0_wp )  THEN  ! large-scale ascent
334                   var_mod(k) = var_init(k) - dt_3d * w_subs(k) *  &
335                                      ( var_init(k) - var_init(k-1) ) * ddzu(k)
336                ENDIF
337             ENDDO
338!
339!--          At the lower boundary shifting is not necessary because the
340!--          subsidence velocity w_subs(nzb) vanishes.
341             IF ( w_subs(nzb+1) >= 0.0_wp )  THEN
342                var_mod(nzb) = var_init(nzb)
343             ENDIF
344
345             var_init = var_mod 
346
347          ENDIF
348       ENDIF
349
350 END SUBROUTINE subsidence_ij
351
352
353 END MODULE subsidence_mod
Note: See TracBrowser for help on using the repository browser.