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

Last change on this file since 689 was 672, checked in by heinze, 14 years ago

last commit documented

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