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

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

added _mod string to several filenames to meet the naming convection for modules

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