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

Last change on this file since 4329 was 4329, checked in by motisi, 18 months ago

Renamed wall_flags_0 to wall_flags_static_0

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