source: palm/trunk/SOURCE/prandtl_fluxes.f90 @ 988

Last change on this file since 988 was 979, checked in by fricke, 12 years ago

last commit documented

  • Property svn:keywords set to Id
File size: 13.0 KB
Line 
1 SUBROUTINE prandtl_fluxes
2
3!------------------------------------------------------------------------------!
4! Current revisions:
5! -----------------
6!
7!
8! Former revisions:
9! -----------------
10! $Id: prandtl_fluxes.f90 979 2012-08-09 08:50:11Z heinze $
11!
12! 978 2012-08-09 08:28:32Z fricke
13! roughness length for scalar quantities z0h added
14!
15! 759 2011-09-15 13:58:31Z raasch
16! Bugfix for ts limitation
17!
18! 709 2011-03-30 09:31:40Z raasch
19! formatting adjustments
20!
21! 667 2010-12-23 12:06:00Z suehring/gryschka
22! Changed surface boundary conditions for u and v from mirror to Dirichlet.
23! Therefore u(uzb,:,:) and v(nzb,:,:) are now representative for height z0.
24! nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng
25!
26! 315 2009-05-13 10:57:59Z raasch
27! Saturation condition at (sea) surface is not used in precursor runs (only
28! in the following coupled runs)
29! Bugfix: qsws was calculated in case of constant heatflux = .FALSE.
30!
31! 187 2008-08-06 16:25:09Z letzel
32! Bugfix: modification of the calculation of the vertical turbulent momentum
33! fluxes u'w' and v'w'
34! Bugfix: change definition of us_wall from 1D to 2D
35! Change: modification of the integrated version of the profile function for
36! momentum for unstable stratification (does not effect results)
37!
38! 108 2007-08-24 15:10:38Z letzel
39! assume saturation at k=nzb_s_inner(j,i) for atmosphere coupled to ocean
40!
41! 75 2007-03-22 09:54:05Z raasch
42! moisture renamed humidity
43!
44! RCS Log replace by Id keyword, revision history cleaned up
45!
46! Revision 1.19  2006/04/26 12:24:35  raasch
47! +OpenMP directives and optimization (array assignments replaced by DO loops)
48!
49! Revision 1.1  1998/01/23 10:06:06  raasch
50! Initial revision
51!
52!
53! Description:
54! ------------
55! Diagnostic computation of vertical fluxes in the Prandtl layer from the
56! values of the variables at grid point k=1
57!------------------------------------------------------------------------------!
58
59    USE arrays_3d
60    USE control_parameters
61    USE grid_variables
62    USE indices
63
64    IMPLICIT NONE
65
66    INTEGER ::  i, j, k
67    REAL    ::  a, b, e_q, rifm, uv_total, z_p
68
69!
70!-- Compute theta*
71    IF ( constant_heatflux )  THEN
72!
73!--    For a given heat flux in the Prandtl layer:
74!--    for u* use the value from the previous time step
75       !$OMP PARALLEL DO
76       DO  i = nxlg, nxrg
77          DO  j = nysg, nyng
78             ts(j,i) = -shf(j,i) / ( us(j,i) + 1E-30 )
79!
80!--          ts must be limited, because otherwise overflow may occur in case of
81!--          us=0 when computing rif further below
82             IF ( ts(j,i) < -1.05E5 )  ts(j,i) = -1.0E5
83             IF ( ts(j,i) >   1.0E5 )  ts(j,i) =  1.0E5
84          ENDDO
85       ENDDO
86
87    ELSE
88!
89!--    For a given surface temperature:
90!--    (the Richardson number is still the one from the previous time step)
91       !$OMP PARALLEL DO PRIVATE( a, b, k, z_p )
92       DO  i = nxlg, nxrg
93          DO  j = nysg, nyng
94
95             k   = nzb_s_inner(j,i)
96             z_p = zu(k+1) - zw(k)
97
98             IF ( rif(j,i) >= 0.0 )  THEN
99!
100!--             Stable stratification
101                ts(j,i) = kappa * ( pt(k+1,j,i) - pt(k,j,i) ) / (           &
102                                  LOG( z_p / z0h(j,i) ) +                   &
103                                  5.0 * rif(j,i) * ( z_p - z0h(j,i) ) / z_p &
104                                                                )
105             ELSE
106!
107!--             Unstable stratification
108                a = SQRT( 1.0 - 16.0 * rif(j,i) )
109                b = SQRT( 1.0 - 16.0 * rif(j,i) * z0h(j,i) / z_p )
110
111                ts(j,i) = kappa * ( pt(k+1,j,i) - pt(k,j,i) ) /  (          &
112                          LOG( z_p / z0h(j,i) ) -                           &
113                          2.0 * LOG( ( 1.0 + a ) / ( 1.0 + b ) ) )
114             ENDIF
115
116          ENDDO
117       ENDDO
118    ENDIF
119
120!
121!-- Compute z_p/L (corresponds to the Richardson-flux number)
122    IF ( .NOT. humidity )  THEN
123       !$OMP PARALLEL DO PRIVATE( k, z_p )
124       DO  i = nxlg, nxrg
125          DO  j = nysg, nyng
126             k   = nzb_s_inner(j,i)
127             z_p = zu(k+1) - zw(k)
128             rif(j,i) = z_p * kappa * g * ts(j,i) / &
129                        ( pt(k+1,j,i) * ( us(j,i)**2 + 1E-30 ) )
130!
131!--          Limit the value range of the Richardson numbers.
132!--          This is necessary for very small velocities (u,v --> 0), because
133!--          the absolute value of rif can then become very large, which in
134!--          consequence would result in very large shear stresses and very
135!--          small momentum fluxes (both are generally unrealistic).
136             IF ( rif(j,i) < rif_min )  rif(j,i) = rif_min
137             IF ( rif(j,i) > rif_max )  rif(j,i) = rif_max
138          ENDDO
139       ENDDO
140    ELSE
141       !$OMP PARALLEL DO PRIVATE( k, z_p )
142       DO  i = nxlg, nxrg
143          DO  j = nysg, nyng
144             k   = nzb_s_inner(j,i)
145             z_p = zu(k+1) - zw(k)
146             rif(j,i) = z_p * kappa * g *                            &
147                        ( ts(j,i) + 0.61 * pt(k+1,j,i) * qs(j,i) ) / &
148                        ( vpt(k+1,j,i) * ( us(j,i)**2 + 1E-30 ) )
149!
150!--          Limit the value range of the Richardson numbers.
151!--          This is necessary for very small velocities (u,v --> 0), because
152!--          the absolute value of rif can then become very large, which in
153!--          consequence would result in very large shear stresses and very
154!--          small momentum fluxes (both are generally unrealistic).
155             IF ( rif(j,i) < rif_min )  rif(j,i) = rif_min
156             IF ( rif(j,i) > rif_max )  rif(j,i) = rif_max
157          ENDDO
158       ENDDO       
159    ENDIF
160
161!
162!-- Compute u* at the scalars' grid points
163    !$OMP PARALLEL DO PRIVATE( a, b, k, uv_total, z_p )
164    DO  i = nxl, nxr
165       DO  j = nys, nyn
166
167          k   = nzb_s_inner(j,i)
168          z_p = zu(k+1) - zw(k)
169
170!
171!--       Compute the absolute value of the horizontal velocity
172!--       (relative to the surface)
173          uv_total = SQRT( ( 0.5 * ( u(k+1,j,i) + u(k+1,j,i+1)        &
174                                   - u(k,j,i)   - u(k,j,i+1) ) )**2 + &
175                           ( 0.5 * ( v(k+1,j,i) + v(k+1,j+1,i)        &
176                                   - v(k,j,i)   - v(k,j+1,i) ) )**2 )   
177
178
179          IF ( rif(j,i) >= 0.0 )  THEN
180!
181!--          Stable stratification
182             us(j,i) = kappa * uv_total / (                                &
183                                  LOG( z_p / z0(j,i) ) +                   &
184                                  5.0 * rif(j,i) * ( z_p - z0(j,i) ) / z_p &
185                                          )
186          ELSE
187!
188!--          Unstable stratification
189             a = SQRT( SQRT( 1.0 - 16.0 * rif(j,i) ) )
190             b = SQRT( SQRT( 1.0 - 16.0 * rif(j,i) / z_p * z0(j,i) ) )
191
192             us(j,i) = kappa * uv_total / (                                  &
193                       LOG( z_p / z0(j,i) ) -                                &
194                       LOG( ( 1.0 + a )**2 * ( 1.0 + a**2 ) / (              &
195                            ( 1.0 + b )**2 * ( 1.0 + b**2 )   ) ) +          &
196                            2.0 * ( ATAN( a ) - ATAN( b ) )                  &
197                                           )
198          ENDIF
199       ENDDO
200    ENDDO
201
202!
203!-- Values of us at ghost point locations are needed for the evaluation of usws
204!-- and vsws.
205    CALL exchange_horiz_2d( us )
206!
207!-- Compute u'w' for the total model domain.
208!-- First compute the corresponding component of u* and square it.
209    !$OMP PARALLEL DO PRIVATE( a, b, k, rifm, z_p )
210    DO  i = nxl, nxr
211       DO  j = nys, nyn
212
213          k   = nzb_u_inner(j,i)
214          z_p = zu(k+1) - zw(k)
215
216!
217!--       Compute Richardson-flux number for this point
218          rifm = 0.5 * ( rif(j,i-1) + rif(j,i) )
219          IF ( rifm >= 0.0 )  THEN
220!
221!--          Stable stratification
222             usws(j,i) = kappa * ( u(k+1,j,i) - u(k,j,i) )/ (              &
223                                     LOG( z_p / z0(j,i) ) +               &
224                                     5.0 * rifm * ( z_p - z0(j,i) ) / z_p &
225                                              )
226          ELSE
227!
228!--          Unstable stratification
229             a = SQRT( SQRT( 1.0 - 16.0 * rifm ) )
230             b = SQRT( SQRT( 1.0 - 16.0 * rifm / z_p * z0(j,i) ) )
231
232             usws(j,i) = kappa * ( u(k+1,j,i) - u(k,j,i) ) / (            &
233                         LOG( z_p / z0(j,i) ) -                           &
234                         LOG( (1.0 + a )**2 * ( 1.0 + a**2 ) / (          &
235                              (1.0 + b )**2 * ( 1.0 + b**2 )   ) ) +      &
236                              2.0 * ( ATAN( a ) - ATAN( b ) )             &
237                                                 )
238          ENDIF
239          usws(j,i) = -usws(j,i) * 0.5 * ( us(j,i-1) + us(j,i) )
240       ENDDO
241    ENDDO
242
243!
244!-- Compute v'w' for the total model domain.
245!-- First compute the corresponding component of u* and square it.
246    !$OMP PARALLEL DO PRIVATE( a, b, k, rifm, z_p )
247    DO  i = nxl, nxr
248       DO  j = nys, nyn
249
250          k   = nzb_v_inner(j,i)
251          z_p = zu(k+1) - zw(k)
252
253!
254!--       Compute Richardson-flux number for this point
255          rifm = 0.5 * ( rif(j-1,i) + rif(j,i) )
256          IF ( rifm >= 0.0 )  THEN
257!
258!--          Stable stratification
259             vsws(j,i) = kappa * ( v(k+1,j,i) -  v(k,j,i) ) / (           &
260                                     LOG( z_p / z0(j,i) ) +               &
261                                     5.0 * rifm * ( z_p - z0(j,i) ) / z_p &
262                                              )
263          ELSE
264!
265!--          Unstable stratification
266             a = SQRT( SQRT( 1.0 - 16.0 * rifm ) )
267             b = SQRT( SQRT( 1.0 - 16.0 * rifm / z_p * z0(j,i) ) )
268
269             vsws(j,i) = kappa * ( v(k+1,j,i) - v(k,j,i) ) / (            &
270                         LOG( z_p / z0(j,i) ) -                           &
271                         LOG( (1.0 + a )**2 * ( 1.0 + a**2 ) / (          &
272                              (1.0 + b )**2 * ( 1.0 + b**2 )   ) ) +      &
273                              2.0 * ( ATAN( a ) - ATAN( b ) )             &
274                                                 )
275          ENDIF
276          vsws(j,i) = -vsws(j,i) * 0.5 * ( us(j-1,i) + us(j,i) )
277       ENDDO
278    ENDDO
279
280!
281!-- If required compute q*
282    IF ( humidity  .OR.  passive_scalar )  THEN
283       IF ( constant_waterflux )  THEN
284!
285!--       For a given water flux in the Prandtl layer:
286          !$OMP PARALLEL DO
287          DO  i = nxlg, nxrg
288             DO  j = nysg, nyng
289                qs(j,i) = -qsws(j,i) / ( us(j,i) + 1E-30 )
290             ENDDO
291          ENDDO
292         
293       ELSE         
294          !$OMP PARALLEL DO PRIVATE( a, b, k, z_p )
295          DO  i = nxlg, nxrg
296             DO  j = nysg, nyng
297
298                k   = nzb_s_inner(j,i)
299                z_p = zu(k+1) - zw(k)
300
301!
302!--             Assume saturation for atmosphere coupled to ocean (but not
303!--             in case of precursor runs)
304                IF ( coupling_mode == 'atmosphere_to_ocean' .AND. run_coupled )&
305                THEN
306                   e_q = 6.1 * &
307                        EXP( 0.07 * ( MIN(pt(0,j,i),pt(1,j,i)) - 273.15 ) )
308                   q(k,j,i) = 0.622 * e_q / ( surface_pressure - e_q )
309                ENDIF
310                IF ( rif(j,i) >= 0.0 )  THEN
311!
312!--                Stable stratification
313                   qs(j,i) = kappa * ( q(k+1,j,i) - q(k,j,i) ) / (          &
314                                  LOG( z_p / z0h(j,i) ) +                   &
315                                  5.0 * rif(j,i) * ( z_p - z0h(j,i) ) / z_p &
316                                                                 )
317                ELSE
318!
319!--                Unstable stratification
320                   a = SQRT( 1.0 - 16.0 * rif(j,i) ) 
321                   b = SQRT( 1.0 - 16.0 * rif(j,i) * z0h(j,i) / z_p ) 
322 
323                   qs(j,i) = kappa * ( q(k+1,j,i) - q(k,j,i) ) /   (        &
324                             LOG( z_p / z0h(j,i) ) -                        &
325                              2.0 * LOG( (1.0 + a ) / ( 1.0 + b ) ) )
326                ENDIF
327
328             ENDDO
329          ENDDO
330       ENDIF
331    ENDIF
332
333!
334!-- Exchange the boundaries for the momentum fluxes (only for sake of
335!-- completeness)
336    CALL exchange_horiz_2d( usws )
337    CALL exchange_horiz_2d( vsws )
338    IF ( humidity  .OR.  passive_scalar )  CALL exchange_horiz_2d( qsws )
339
340!
341!-- Compute the vertical kinematic heat flux
342    IF ( .NOT. constant_heatflux )  THEN
343       !$OMP PARALLEL DO
344       DO  i = nxlg, nxrg
345          DO  j = nysg, nyng
346             shf(j,i) = -ts(j,i) * us(j,i)
347          ENDDO
348       ENDDO
349    ENDIF
350
351!
352!-- Compute the vertical water/scalar flux
353    IF ( .NOT. constant_waterflux .AND. ( humidity .OR. passive_scalar ) ) THEN
354       !$OMP PARALLEL DO
355       DO  i = nxlg, nxrg
356          DO  j = nysg, nyng
357             qsws(j,i) = -qs(j,i) * us(j,i)
358          ENDDO
359       ENDDO
360    ENDIF
361
362!
363!-- Bottom boundary condition for the TKE
364    IF ( ibc_e_b == 2 )  THEN
365       !$OMP PARALLEL DO
366       DO  i = nxlg, nxrg
367          DO  j = nysg, nyng
368             e(nzb_s_inner(j,i)+1,j,i) = ( us(j,i) / 0.1 )**2
369!
370!--          As a test: cm = 0.4
371!            e(nzb_s_inner(j,i)+1,j,i) = ( us(j,i) / 0.4 )**2
372             e(nzb_s_inner(j,i),j,i)   = e(nzb_s_inner(j,i)+1,j,i)
373          ENDDO
374       ENDDO
375    ENDIF
376
377
378 END SUBROUTINE prandtl_fluxes
Note: See TracBrowser for help on using the repository browser.