source: palm/trunk/SOURCE/subsidence.f90 @ 1380

Last change on this file since 1380 was 1380, checked in by heinze, 10 years ago

Upper boundary conditions for pt and q in case of nudging adjusted

  • Property svn:keywords set to Id
File size: 11.6 KB
Line 
1 MODULE subsidence_mod
2
3!--------------------------------------------------------------------------------!
4! This file is part of PALM.
5!
6! PALM is free software: you can redistribute it and/or modify it under the terms
7! of the GNU General Public License as published by the Free Software Foundation,
8! either version 3 of the License, or (at your option) any later 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-2014 Leibniz Universitaet Hannover
18!--------------------------------------------------------------------------------!
19!
20! Current revisions:
21! -----------------
22! Shifting only necessary in case of scalar Rayleigh damping
23!
24! Former revisions:
25! -----------------
26! $Id: subsidence.f90 1380 2014-04-28 12:40:45Z heinze $
27!
28! 1365 2014-04-22 15:03:56Z boeske
29! Summation of subsidence tendencies for data output added
30! +ls_index, sums_ls_l, tmp_tend
31!
32! 1353 2014-04-08 15:21:23Z heinze
33! REAL constants provided with KIND-attribute
34!
35! 1320 2014-03-20 08:40:49Z raasch
36! ONLY-attribute added to USE-statements,
37! kind-parameters added to all INTEGER and REAL declaration statements,
38! kinds are defined in new module kinds,
39! old module precision_kind is removed,
40! revision history before 2012 removed,
41! comment fields (!:) to be used for variable explanations added to
42! all variable declaration statements
43!
44! 1036 2012-10-22 13:43:42Z raasch
45! code put under GPL (PALM 3.9)
46!
47! Revision 3.7 2009-12-11 14:15:58Z heinze
48! Initial revision
49!
50! Description:
51! ------------
52! Impact of large-scale subsidence or ascent as tendency term for use
53! in the prognostic equation of potential temperature. This enables the
54! construction of a constant boundary layer height z_i with time.
55!-----------------------------------------------------------------------------!
56
57
58    IMPLICIT NONE
59
60    PRIVATE
61    PUBLIC  init_w_subsidence, subsidence
62
63    INTERFACE init_w_subsidence
64       MODULE PROCEDURE init_w_subsidence
65    END INTERFACE init_w_subsidence
66
67    INTERFACE subsidence
68       MODULE PROCEDURE subsidence
69       MODULE PROCEDURE subsidence_ij
70    END INTERFACE subsidence
71
72 CONTAINS
73
74    SUBROUTINE init_w_subsidence 
75
76       USE arrays_3d,                                                          &
77           ONLY:  dzu, w_subs, zu
78
79       USE control_parameters,                                                 &
80           ONLY:  message_string, ocean, subs_vertical_gradient,               &
81                  subs_vertical_gradient_level, subs_vertical_gradient_level_i
82
83       USE indices,                                                            &
84           ONLY:  nzb, nzt
85
86       USE kinds
87
88       IMPLICIT NONE
89
90       INTEGER(iwp) ::  i !:
91       INTEGER(iwp) ::  k !:
92
93       REAL(wp)     ::  gradient   !:
94       REAL(wp)     ::  ws_surface !:
95
96       IF ( .NOT. ALLOCATED( w_subs ))  THEN
97          ALLOCATE( w_subs(nzb:nzt+1) )
98          w_subs = 0.0_wp
99       ENDIF
100
101       IF ( ocean )  THEN
102          message_string = 'Applying large scale vertical motion is not ' // &
103                           'allowed for ocean runs'
104          CALL message( 'init_w_subsidence', 'PA0324', 2, 2, 0, 6, 0 )
105       ENDIF
106
107!
108!--   Compute the profile of the subsidence/ascent velocity
109!--   using the given gradients
110      i = 1
111      gradient = 0.0_wp
112      ws_surface = 0.0_wp
113     
114
115      subs_vertical_gradient_level_i(1) = 0
116      DO  k = 1, nzt+1
117         IF ( i < 11 )  THEN
118            IF ( subs_vertical_gradient_level(i) < zu(k)  .AND. &
119                 subs_vertical_gradient_level(i) >= 0.0_wp )  THEN
120               gradient = subs_vertical_gradient(i) / 100.0_wp
121               subs_vertical_gradient_level_i(i) = k - 1
122               i = i + 1
123            ENDIF
124         ENDIF
125         IF ( gradient /= 0.0_wp )  THEN
126            IF ( k /= 1 )  THEN
127               w_subs(k) = w_subs(k-1) + dzu(k) * gradient
128            ELSE
129               w_subs(k) = ws_surface   + 0.5_wp * dzu(k) * gradient
130            ENDIF
131         ELSE
132            w_subs(k) = w_subs(k-1)
133         ENDIF
134      ENDDO
135
136!
137!--   In case of no given gradients for the subsidence/ascent velocity,
138!--   choose zero gradient
139      IF ( subs_vertical_gradient_level(1) == -9999999.9_wp )  THEN
140         subs_vertical_gradient_level(1) = 0.0_wp
141      ENDIF
142
143    END SUBROUTINE init_w_subsidence
144
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, nzb_s_inner,&
157                  nzt
158
159       USE kinds
160
161       USE statistics,                                                         &
162           ONLY:  sums_ls_l, weight_pres
163
164       IMPLICIT NONE
165 
166       INTEGER(iwp) ::  i !:
167       INTEGER(iwp) ::  j !:
168       INTEGER(iwp) ::  k !:
169       INTEGER(iwp) ::  ls_index !:
170
171       REAL(wp)     ::  tmp_tend !:
172       REAL(wp)     ::  tmp_grad !:
173   
174       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  var      !:
175       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  tendency !:
176       REAL(wp), DIMENSION(nzb:nzt+1) ::  var_init                     !:
177       REAL(wp), DIMENSION(nzb:nzt+1) ::  var_mod                      !:
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             DO  k = nzb_s_inner(j,i)+1, nzt 
186                IF ( w_subs(k) < 0.0_wp )  THEN    ! large-scale subsidence
187                   tmp_tend = - w_subs(k) *                                    &
188                              ( var(k+1,j,i) - var(k,j,i) ) * ddzu(k+1)
189                ELSE                               ! large-scale ascent
190                   tmp_tend = - w_subs(k) *                                    &
191                              ( var(k,j,i) - var(k-1,j,i) ) * ddzu(k)
192                ENDIF
193
194                tendency(k,j,i) = tendency(k,j,i) + tmp_tend
195
196                IF ( large_scale_forcing )  THEN
197                   sums_ls_l(k,ls_index) = sums_ls_l(k,ls_index) + tmp_tend    &
198                                      * weight_pres(intermediate_timestep_count)
199                ENDIF
200             ENDDO
201          ENDDO
202       ENDDO
203
204!
205!--    Shifting of the initial profile is especially necessary with Rayleigh
206!--    damping switched on
207       IF ( scalar_rayleigh_damping ) THEN
208          DO  k = nzb, nzt
209             IF ( w_subs(k) < 0.0_wp )  THEN      ! large-scale subsidence
210                var_mod(k) = var_init(k) - dt_3d * w_subs(k) *  &
211                                  ( var_init(k+1) - var_init(k) ) * ddzu(k+1)
212             ENDIF
213          ENDDO
214!
215!--      At the upper boundary, the initial profile is shifted with aid of
216!--      the gradient tmp_grad. (This is ok if the gradients are linear.)
217         IF ( w_subs(nzt) < 0.0_wp )  THEN
218            tmp_grad = ( var_init(nzt+1) - var_init(nzt) ) * ddzu(nzt+1)
219            var_mod(nzt+1) = var_init(nzt+1) -  &
220                                 dt_3d * w_subs(nzt+1) * tmp_grad
221         ENDIF
222       
223
224         DO  k = nzt+1, nzb+1, -1
225            IF ( w_subs(k) >= 0.0_wp )  THEN  ! large-scale ascent
226               var_mod(k) = var_init(k) - dt_3d * w_subs(k) *  &
227                                  ( var_init(k) - var_init(k-1) ) * ddzu(k) 
228            ENDIF
229         ENDDO
230!
231!--      At the lower boundary shifting is not necessary because the
232!--      subsidence velocity w_subs(nzb) vanishes.
233         IF ( w_subs(nzb+1) >= 0.0_wp )  THEN
234            var_mod(nzb) = var_init(nzb)
235         ENDIF
236
237         var_init = var_mod
238      ENDIF
239
240
241 END SUBROUTINE subsidence
242
243 SUBROUTINE subsidence_ij( i, j, tendency, var, var_init, ls_index ) 
244
245       USE arrays_3d,                                                          &
246           ONLY:  ddzu, w_subs
247
248       USE control_parameters,                                                 &
249           ONLY:  dt_3d, intermediate_timestep_count, large_scale_forcing,     &
250                  scalar_rayleigh_damping
251
252       USE indices,                                                            &
253           ONLY:  nxl, nxlg, nxrg, nyng, nys, nysg, nzb_s_inner, nzb, nzt
254
255       USE kinds
256
257       USE statistics,                                                         &
258           ONLY:  sums_ls_l, weight_pres
259
260       IMPLICIT NONE
261 
262       INTEGER(iwp) ::  i !:
263       INTEGER(iwp) ::  j !:
264       INTEGER(iwp) ::  k !:
265       INTEGER(iwp) ::  ls_index !:
266
267       REAL(wp)     ::  tmp_tend !:
268       REAL(wp)     ::  tmp_grad !:
269   
270       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  var      !:
271       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  tendency !:
272       REAL(wp), DIMENSION(nzb:nzt+1) ::  var_init                     !:
273       REAL(wp), DIMENSION(nzb:nzt+1) ::  var_mod                      !:
274
275       var_mod = var_init
276
277!
278!--    Influence of w_subsidence on the current tendency term
279       DO  k = nzb_s_inner(j,i)+1, nzt 
280          IF ( w_subs(k) < 0.0_wp )  THEN      ! large-scale subsidence
281             tmp_tend = - w_subs(k) * ( var(k+1,j,i) - var(k,j,i) ) * ddzu(k+1)
282          ELSE                                 ! large-scale ascent
283             tmp_tend = - w_subs(k) * ( var(k,j,i) - var(k-1,j,i) ) * ddzu(k)
284          ENDIF
285
286          tendency(k,j,i) = tendency(k,j,i) + tmp_tend
287
288          IF ( large_scale_forcing )  THEN
289             sums_ls_l(k,ls_index) = sums_ls_l(k,ls_index) + tmp_tend          &
290                                     * weight_pres(intermediate_timestep_count)
291          ENDIF
292       ENDDO
293
294
295!
296!--    Shifting of the initial profile is especially necessary with Rayleigh
297!--    damping switched on
298       IF ( scalar_rayleigh_damping ) THEN
299          IF ( i == nxl .AND. j == nys )  THEN ! shifting only once per PE
300
301             DO  k = nzb, nzt
302                IF ( w_subs(k) < 0.0_wp )  THEN      ! large-scale subsidence
303                   var_mod(k) = var_init(k) - dt_3d * w_subs(k) *  &
304                                     ( var_init(k+1) - var_init(k) ) * ddzu(k+1)
305                ENDIF
306             ENDDO
307!
308!--          At the upper boundary, the initial profile is shifted with aid of
309!--          the gradient tmp_grad. (This is ok if the gradients are linear.)
310             IF ( w_subs(nzt) < 0.0_wp )  THEN
311                tmp_grad = ( var_init(nzt+1) - var_init(nzt) ) * ddzu(nzt+1)
312                var_mod(nzt+1) = var_init(nzt+1) -  &
313                                     dt_3d * w_subs(nzt+1) * tmp_grad
314             ENDIF
315       
316
317             DO  k = nzt+1, nzb+1, -1
318                IF ( w_subs(k) >= 0.0_wp )  THEN  ! large-scale ascent
319                   var_mod(k) = var_init(k) - dt_3d * w_subs(k) *  &
320                                      ( var_init(k) - var_init(k-1) ) * ddzu(k)
321                ENDIF
322             ENDDO
323!
324!--          At the lower boundary shifting is not necessary because the
325!--          subsidence velocity w_subs(nzb) vanishes.
326             IF ( w_subs(nzb+1) >= 0.0_wp )  THEN
327                var_mod(nzb) = var_init(nzb)
328             ENDIF
329
330             var_init = var_mod 
331
332          ENDIF
333       ENDIF
334
335 END SUBROUTINE subsidence_ij
336
337
338 END MODULE subsidence_mod
Note: See TracBrowser for help on using the repository browser.