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

Last change on this file since 2000 was 2000, checked in by knoop, 5 years ago

Forced header and separation lines into 80 columns

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