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

Last change on this file since 1382 was 1382, checked in by boeske, 8 years ago

minor changes in profile data output of lsf tendencies, variables renamed

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