source: palm/tags/release-3.8/SOURCE/prandtl_fluxes.f90 @ 4343

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