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

Last change on this file since 2834 was 2718, checked in by maronga, 7 years ago

deleting of deprecated files; headers updated where needed

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