source: palm/tags/release-3.8/SOURCE/diffusivities.f90 @ 716

Last change on this file since 716 was 668, checked in by suehring, 11 years ago

last commit documented

  • Property svn:keywords set to Id
File size: 6.2 KB
Line 
1 SUBROUTINE diffusivities( var, var_reference )
2
3!------------------------------------------------------------------------------!
4! Current revisions:
5! -----------------
6!
7! Former revisions:
8! -----------------
9! $Id: diffusivities.f90 668 2010-12-23 13:22:58Z raasch $
10!
11! 667 2010-12-23 12:06:00Z suehring/gryschka
12! nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng
13!
14! 137 2007-11-28 08:50:10Z letzel
15! Bugfix for summation of sums_l_l for flow_statistics
16! Vertical scalar profiles now based on nzb_s_inner and ngp_2dh_s_inner.
17!
18! 97 2007-06-21 08:23:15Z raasch
19! Adjustment of mixing length calculation for the ocean version.
20! This is also a bugfix, because the height above the topography is now
21! used instead of the height above level k=0.
22! theta renamed var, dpt_dz renamed dvar_dz, +new argument var_reference
23! use_pt_reference renamed use_reference
24!
25! 57 2007-03-09 12:05:41Z raasch
26! Reference temperature pt_reference can be used in buoyancy term
27!
28! RCS Log replace by Id keyword, revision history cleaned up
29!
30! Revision 1.24  2006/04/26 12:16:26  raasch
31! OpenMP optimization (+sums_l_l_t), sqrt_e must be private
32!
33! Revision 1.1  1997/09/19 07:41:10  raasch
34! Initial revision
35!
36!
37! Description:
38! ------------
39! Computation of the turbulent diffusion coefficients for momentum and heat
40! according to Prandtl-Kolmogorov
41!------------------------------------------------------------------------------!
42
43    USE arrays_3d
44    USE control_parameters
45    USE grid_variables
46    USE indices
47    USE pegrid
48    USE statistics
49
50    IMPLICIT NONE
51
52    INTEGER ::  i, j, k, omp_get_thread_num, sr, tn
53
54    REAL    ::  dvar_dz, l_stable, var_reference
55
56    REAL, SAVE ::  phi_m = 1.0
57
58    REAL    ::  var(nzb:nzt+1,nysg:nyng,nxlg:nxrg)
59
60    REAL, DIMENSION(1:nzt) ::  l, ll, sqrt_e
61
62
63!
64!-- Default thread number in case of one thread
65    tn = 0
66
67!
68!-- Initialization for calculation of the mixing length profile
69    sums_l_l = 0.0
70
71!
72!-- Compute the turbulent diffusion coefficient for momentum
73    !$OMP PARALLEL PRIVATE (dvar_dz,i,j,k,l,ll,l_stable,phi_m,sqrt_e,sr,tn)
74!$  tn = omp_get_thread_num()
75
76    !$OMP DO
77    DO  i = nxlg, nxrg
78       DO  j = nysg, nyng
79
80!
81!--       Compute the Phi-function for a possible adaption of the mixing length
82!--       to the Prandtl mixing length
83          IF ( adjust_mixing_length  .AND.  prandtl_layer )  THEN
84             IF ( rif(j,i) >= 0.0 )  THEN
85                phi_m = 1.0 + 5.0 * rif(j,i)
86             ELSE
87                phi_m = 1.0 / SQRT( SQRT( 1.0 - 16.0 * rif(j,i) ) )
88             ENDIF
89          ENDIF
90         
91!
92!--       Introduce an optional minimum tke
93          IF ( e_min > 0.0 )  THEN
94             DO  k = nzb_s_inner(j,i)+1, nzt
95                e(k,j,i) = MAX( e(k,j,i), e_min )
96             ENDDO
97          ENDIF
98
99!
100!--       Calculate square root of e in a seperate loop, because it is used
101!--       twice in the next loop (better vectorization)
102          DO  k = nzb_s_inner(j,i)+1, nzt
103             sqrt_e(k) = SQRT( e(k,j,i) )
104          ENDDO
105
106!
107!--       Determine the mixing length
108          DO  k = nzb_s_inner(j,i)+1, nzt
109             dvar_dz = atmos_ocean_sign * &  ! inverse effect of pt/rho gradient
110                       ( var(k+1,j,i) - var(k-1,j,i) ) * dd2zu(k)
111             IF ( dvar_dz > 0.0 ) THEN
112                IF ( use_reference )  THEN
113                   l_stable = 0.76 * sqrt_e(k) / &
114                                     SQRT( g / var_reference * dvar_dz ) + 1E-5
115                ELSE
116                   l_stable = 0.76 * sqrt_e(k) / &
117                                     SQRT( g / var(k,j,i) * dvar_dz ) + 1E-5
118                ENDIF
119             ELSE
120                l_stable = l_grid(k)
121             ENDIF
122!
123!--          Adjustment of the mixing length
124             IF ( wall_adjustment )  THEN
125                l(k)  = MIN( l_wall(k,j,i), l_grid(k), l_stable )
126                ll(k) = MIN( l_wall(k,j,i), l_grid(k) )
127             ELSE
128                l(k)  = MIN( l_grid(k), l_stable )
129                ll(k) = l_grid(k)
130             ENDIF
131             IF ( adjust_mixing_length  .AND.  prandtl_layer )  THEN
132                l(k)  = MIN( l(k),  kappa * &
133                                    ( zu(k) - zw(nzb_s_inner(j,i)) ) / phi_m )
134                ll(k) = MIN( ll(k), kappa * &
135                                    ( zu(k) - zw(nzb_s_inner(j,i)) ) / phi_m )
136             ENDIF
137
138!
139!--          Compute diffusion coefficients for momentum and heat
140             km(k,j,i) = 0.1 * l(k) * sqrt_e(k)
141             kh(k,j,i) = ( 1.0 + 2.0 * l(k) / ll(k) ) * km(k,j,i)
142
143          ENDDO
144
145!
146!--       Summation for averaged profile (cf. flow_statistics)
147!--       (the IF statement still requires a performance check on NEC machines)
148          DO  sr = 0, statistic_regions
149             IF ( rmask(j,i,sr) /= 0.0 .AND.  &
150                  i >= nxl .AND. i <= nxr .AND. j >= nys .AND. j <= nyn )  THEN
151                DO  k = nzb_s_inner(j,i)+1, nzt
152                   sums_l_l(k,sr,tn) = sums_l_l(k,sr,tn) + l(k)
153                ENDDO
154             ENDIF
155          ENDDO
156
157       ENDDO
158    ENDDO
159
160    sums_l_l(nzt+1,:,tn) = sums_l_l(nzt,:,tn)   ! quasi boundary-condition for
161                                                  ! data output
162
163    !$OMP END PARALLEL
164
165!
166!-- Set vertical boundary values (Neumann conditions both at bottom and top).
167!-- Horizontal boundary conditions at vertical walls are not set because
168!-- so far vertical walls require usage of a Prandtl-layer where the boundary
169!-- values of the diffusivities are not needed
170    !$OMP PARALLEL DO
171    DO  i = nxlg, nxrg
172       DO  j = nysg, nyng
173          km(nzb_s_inner(j,i),j,i) = km(nzb_s_inner(j,i)+1,j,i)
174          km(nzt+1,j,i)            = km(nzt,j,i)
175          kh(nzb_s_inner(j,i),j,i) = kh(nzb_s_inner(j,i)+1,j,i)
176          kh(nzt+1,j,i)            = kh(nzt,j,i)
177       ENDDO
178    ENDDO
179
180!
181!-- Set Neumann boundary conditions at the outflow boundaries in case of
182!-- non-cyclic lateral boundaries
183    IF ( outflow_l )  THEN
184       km(:,:,nxl-1) = km(:,:,nxl)
185       kh(:,:,nxl-1) = kh(:,:,nxl)
186    ENDIF
187    IF ( outflow_r )  THEN
188       km(:,:,nxr+1) = km(:,:,nxr)
189       kh(:,:,nxr+1) = kh(:,:,nxr)
190    ENDIF
191    IF ( outflow_s )  THEN
192       km(:,nys-1,:) = km(:,nys,:)
193       kh(:,nys-1,:) = kh(:,nys,:)
194    ENDIF
195    IF ( outflow_n )  THEN
196       km(:,nyn+1,:) = km(:,nyn,:)
197       kh(:,nyn+1,:) = kh(:,nyn,:)
198    ENDIF
199
200
201 END SUBROUTINE diffusivities
Note: See TracBrowser for help on using the repository browser.