source: palm/trunk/SOURCE/subsidence_mod.f90 @ 1851

Last change on this file since 1851 was 1851, checked in by maronga, 5 years ago

last commit documented

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