source: palm/tags/release-3.10/SOURCE/subsidence.f90 @ 4480

Last change on this file since 4480 was 1037, checked in by raasch, 11 years ago

last commit documented

  • Property svn:keywords set to Id
File size: 8.5 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-2012  Leibniz University Hannover
18!--------------------------------------------------------------------------------!
19!
20! Current revisions:
21! -----------------
22!
23! Former revisions:
24! -----------------
25! $Id: subsidence.f90 1037 2012-10-22 14:10:22Z Giersch $
26!
27! 1036 2012-10-22 13:43:42Z raasch
28! code put under GPL (PALM 3.9)
29!
30! 671 2011-01-11 12:04:00Z heinze $
31! bugfix: access to ddzu(nzt+2) which is not defined
32!
33! 667 2010-12-23 12:06:00Z suehring
34! nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng
35!
36! 580 2010-10-05 13:59:11Z heinze
37! Renaming of ws_vertical_gradient to subs_vertical_gradient,
38! ws_vertical_gradient_level to subs_vertical_gradient_level and
39! ws_vertical_gradient_level_ind to subs_vertical_gradient_level_i
40!
41! Revision 3.7 2009-12-11 14:15:58Z heinze
42! Initial revision
43!
44! Description:
45! ------------
46! Impact of large-scale subsidence or ascent as tendency term for use
47! in the prognostic equation of potential temperature. This enables the
48! construction of a constant boundary layer height z_i with time.
49!-----------------------------------------------------------------------------!
50
51
52    IMPLICIT NONE
53
54    PRIVATE
55    PUBLIC  init_w_subsidence, subsidence
56
57    INTERFACE init_w_subsidence
58       MODULE PROCEDURE init_w_subsidence
59    END INTERFACE init_w_subsidence
60
61    INTERFACE subsidence
62       MODULE PROCEDURE subsidence
63       MODULE PROCEDURE subsidence_ij
64    END INTERFACE subsidence
65
66 CONTAINS
67
68    SUBROUTINE init_w_subsidence 
69
70       USE arrays_3d
71       USE control_parameters
72       USE grid_variables
73       USE indices
74       USE pegrid
75       USE statistics 
76
77       IMPLICIT NONE
78
79       INTEGER :: i, k
80       REAL    :: gradient, ws_surface
81
82       IF ( .NOT. ALLOCATED( w_subs )) THEN
83          ALLOCATE( w_subs(nzb:nzt+1) )
84          w_subs = 0.0
85       ENDIF
86
87      IF ( ocean )  THEN
88          message_string = 'Applying large scale vertical motion is not ' // &
89                           'allowed for ocean runs'
90          CALL message( 'init_w_subsidence', 'PA0324', 2, 2, 0, 6, 0 )
91       ENDIF
92
93!
94!--   Compute the profile of the subsidence/ascent velocity
95!--   using the given gradients
96      i = 1
97      gradient = 0.0
98      ws_surface = 0.0
99     
100
101      subs_vertical_gradient_level_i(1) = 0
102      DO  k = 1, nzt+1
103         IF ( i < 11 ) THEN
104            IF ( subs_vertical_gradient_level(i) < zu(k)  .AND. &
105                 subs_vertical_gradient_level(i) >= 0.0 )  THEN
106               gradient = subs_vertical_gradient(i) / 100.0
107               subs_vertical_gradient_level_i(i) = k - 1
108               i = i + 1
109            ENDIF
110         ENDIF
111         IF ( gradient /= 0.0 )  THEN
112            IF ( k /= 1 )  THEN
113               w_subs(k) = w_subs(k-1) + dzu(k) * gradient
114            ELSE
115               w_subs(k) = ws_surface   + 0.5 * dzu(k) * gradient
116            ENDIF
117         ELSE
118            w_subs(k) = w_subs(k-1)
119         ENDIF
120      ENDDO
121
122!
123!--   In case of no given gradients for the subsidence/ascent velocity,
124!--   choose zero gradient
125      IF ( subs_vertical_gradient_level(1) == -9999999.9 )  THEN
126         subs_vertical_gradient_level(1) = 0.0
127      ENDIF
128
129    END SUBROUTINE init_w_subsidence
130
131
132    SUBROUTINE subsidence( tendency, var, var_init ) 
133
134       USE arrays_3d
135       USE control_parameters
136       USE grid_variables
137       USE indices
138       USE pegrid
139       USE statistics 
140
141       IMPLICIT NONE
142 
143       INTEGER :: i, j, k
144
145       REAL :: tmp_grad
146   
147       REAL, DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: var, tendency
148       REAL, DIMENSION(nzb:nzt+1) :: var_init, var_mod
149
150       var_mod = var_init
151
152!
153!--    Influence of w_subsidence on the current tendency term
154       DO  i = nxl, nxr
155          DO  j = nys, nyn
156             DO  k = nzb_s_inner(j,i)+1, nzt 
157                IF ( w_subs(k) < 0.0 ) THEN    ! large-scale subsidence
158                   tendency(k,j,i) = tendency(k,j,i) - w_subs(k) *  &
159                                     ( var(k+1,j,i) - var(k,j,i) ) * ddzu(k+1)
160                ELSE                           ! large-scale ascent
161                   tendency(k,j,i) = tendency(k,j,i) - w_subs(k) *  &
162                                     ( var(k,j,i) - var(k-1,j,i) ) * ddzu(k)
163                ENDIF
164             ENDDO
165          ENDDO
166       ENDDO
167
168!
169!--    Shifting of the initial profile is especially necessary with Rayleigh
170!--    damping switched on
171
172       DO  k = nzb, nzt
173          IF ( w_subs(k) < 0.0 ) THEN      ! large-scale subsidence
174             var_mod(k) = var_init(k) - dt_3d * w_subs(k) *  &
175                               ( var_init(k+1) - var_init(k) ) * ddzu(k+1)
176          ENDIF
177       ENDDO
178!
179!--   At the upper boundary, the initial profile is shifted with aid of
180!--   the gradient tmp_grad. (This is ok if the gradients are linear.)
181      IF ( w_subs(nzt) < 0.0 ) THEN
182         tmp_grad = ( var_init(nzt+1) - var_init(nzt) ) * ddzu(nzt+1)
183         var_mod(nzt+1) = var_init(nzt+1) -  &
184                              dt_3d * w_subs(nzt+1) * tmp_grad
185      ENDIF
186       
187
188      DO  k = nzt+1, nzb+1, -1
189         IF ( w_subs(k) >= 0.0 ) THEN  ! large-scale ascent
190            var_mod(k) = var_init(k) - dt_3d * w_subs(k) *  &
191                               ( var_init(k) - var_init(k-1) ) * ddzu(k) 
192         ENDIF
193      ENDDO
194!
195!--   At the lower boundary shifting is not necessary because the
196!--   subsidence velocity w_subs(nzb) vanishes.
197
198
199      IF ( w_subs(nzb+1) >= 0.0 ) THEN
200         var_mod(nzb) = var_init(nzb)
201      ENDIF
202
203      var_init = var_mod
204
205
206 END SUBROUTINE subsidence
207
208 SUBROUTINE subsidence_ij( i, j, tendency, var, var_init ) 
209
210       USE arrays_3d
211       USE control_parameters
212       USE grid_variables
213       USE indices
214       USE pegrid
215       USE statistics 
216
217       IMPLICIT NONE
218 
219       INTEGER :: i, j, k
220
221       REAL :: tmp_grad
222   
223       REAL, DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: var, tendency
224       REAL, DIMENSION(nzb:nzt+1) :: var_init, var_mod
225
226       var_mod = var_init
227
228!
229!--    Influence of w_subsidence on the current tendency term
230       DO  k = nzb_s_inner(j,i)+1, nzt 
231          IF ( w_subs(k) < 0.0 ) THEN      ! large-scale subsidence
232             tendency(k,j,i) = tendency(k,j,i) - w_subs(k) *  &
233                               ( var(k+1,j,i) - var(k,j,i) ) * ddzu(k+1)
234          ELSE                             ! large-scale ascent
235             tendency(k,j,i) = tendency(k,j,i) - w_subs(k) *  &
236                               ( var(k,j,i) - var(k-1,j,i) ) * ddzu(k)
237          ENDIF
238       ENDDO
239
240
241!
242!--    Shifting of the initial profile is especially necessary with Rayleigh
243!--    damping switched on
244       IF ( i == nxl .AND. j == nys ) THEN ! shifting only once per PE
245
246          DO  k = nzb, nzt
247             IF ( w_subs(k) < 0.0 ) THEN      ! large-scale subsidence
248                var_mod(k) = var_init(k) - dt_3d * w_subs(k) *  &
249                                  ( var_init(k+1) - var_init(k) ) * ddzu(k+1)
250             ENDIF
251          ENDDO
252!
253!--       At the upper boundary, the initial profile is shifted with aid of
254!--       the gradient tmp_grad. (This is ok if the gradients are linear.)
255          IF ( w_subs(nzt) < 0.0 ) THEN
256             tmp_grad = ( var_init(nzt+1) - var_init(nzt) ) * ddzu(nzt+1)
257             var_mod(nzt+1) = var_init(nzt+1) -  &
258                                  dt_3d * w_subs(nzt+1) * tmp_grad
259          ENDIF
260       
261
262          DO  k = nzt+1, nzb+1, -1
263             IF ( w_subs(k) >= 0.0 ) THEN  ! large-scale ascent
264                var_mod(k) = var_init(k) - dt_3d * w_subs(k) *  &
265                                   ( var_init(k) - var_init(k-1) ) * ddzu(k)
266             ENDIF
267          ENDDO
268!
269!--       At the lower boundary shifting is not necessary because the
270!--       subsidence velocity w_subs(nzb) vanishes.
271
272
273          IF ( w_subs(nzb+1) >= 0.0 ) THEN
274             var_mod(nzb) = var_init(nzb)
275          ENDIF
276
277          var_init = var_mod 
278
279       ENDIF
280
281 END SUBROUTINE subsidence_ij
282
283
284 END MODULE subsidence_mod
Note: See TracBrowser for help on using the repository browser.