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

Last change on this file since 4180 was 4180, checked in by scharf, 22 months ago

removed comments in 'Former revisions' section that are older than 01.01.2019

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