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

Last change on this file since 1924 was 1863, checked in by hoffmann, 9 years ago

last commit documented

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