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

Last change on this file since 587 was 581, checked in by heinze, 14 years ago

last commit documented

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