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

Last change on this file since 684 was 668, checked in by suehring, 14 years ago

last commit documented

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