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

Last change on this file since 966 was 760, checked in by raasch, 13 years ago

last commit documented

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