SUBROUTINE diffusivities( var, var_reference ) !------------------------------------------------------------------------------! ! Current revisions: ! ----------------- ! ! ! Former revisions: ! ----------------- ! $Id: diffusivities.f90 510 2010-03-12 00:37:31Z maronga $ ! ! 137 2007-11-28 08:50:10Z letzel ! Bugfix for summation of sums_l_l for flow_statistics ! Vertical scalar profiles now based on nzb_s_inner and ngp_2dh_s_inner. ! ! 97 2007-06-21 08:23:15Z raasch ! Adjustment of mixing length calculation for the ocean version. ! This is also a bugfix, because the height above the topography is now ! used instead of the height above level k=0. ! theta renamed var, dpt_dz renamed dvar_dz, +new argument var_reference ! use_pt_reference renamed use_reference ! ! 57 2007-03-09 12:05:41Z raasch ! Reference temperature pt_reference can be used in buoyancy term ! ! RCS Log replace by Id keyword, revision history cleaned up ! ! Revision 1.24 2006/04/26 12:16:26 raasch ! OpenMP optimization (+sums_l_l_t), sqrt_e must be private ! ! Revision 1.1 1997/09/19 07:41:10 raasch ! Initial revision ! ! ! Description: ! ------------ ! Computation of the turbulent diffusion coefficients for momentum and heat ! according to Prandtl-Kolmogorov !------------------------------------------------------------------------------! USE arrays_3d USE control_parameters USE grid_variables USE indices USE pegrid USE statistics IMPLICIT NONE INTEGER :: i, j, k, omp_get_thread_num, sr, tn REAL :: dvar_dz, l_stable, var_reference REAL, SAVE :: phi_m = 1.0 REAL :: var(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) REAL, DIMENSION(1:nzt) :: l, ll, sqrt_e ! !-- Default thread number in case of one thread tn = 0 ! !-- Initialization for calculation of the mixing length profile sums_l_l = 0.0 ! !-- Compute the turbulent diffusion coefficient for momentum !$OMP PARALLEL PRIVATE (dvar_dz,i,j,k,l,ll,l_stable,phi_m,sqrt_e,sr,tn) !$ tn = omp_get_thread_num() !$OMP DO DO i = nxl-1, nxr+1 DO j = nys-1, nyn+1 ! !-- Compute the Phi-function for a possible adaption of the mixing length !-- to the Prandtl mixing length IF ( adjust_mixing_length .AND. prandtl_layer ) THEN IF ( rif(j,i) >= 0.0 ) THEN phi_m = 1.0 + 5.0 * rif(j,i) ELSE phi_m = 1.0 / SQRT( SQRT( 1.0 - 16.0 * rif(j,i) ) ) ENDIF ENDIF ! !-- Introduce an optional minimum tke IF ( e_min > 0.0 ) THEN DO k = nzb_s_inner(j,i)+1, nzt e(k,j,i) = MAX( e(k,j,i), e_min ) ENDDO ENDIF ! !-- Calculate square root of e in a seperate loop, because it is used !-- twice in the next loop (better vectorization) DO k = nzb_s_inner(j,i)+1, nzt sqrt_e(k) = SQRT( e(k,j,i) ) ENDDO ! !-- Determine the mixing length DO k = nzb_s_inner(j,i)+1, nzt dvar_dz = atmos_ocean_sign * & ! inverse effect of pt/rho gradient ( var(k+1,j,i) - var(k-1,j,i) ) * dd2zu(k) IF ( dvar_dz > 0.0 ) THEN IF ( use_reference ) THEN l_stable = 0.76 * sqrt_e(k) / & SQRT( g / var_reference * dvar_dz ) + 1E-5 ELSE l_stable = 0.76 * sqrt_e(k) / & SQRT( g / var(k,j,i) * dvar_dz ) + 1E-5 ENDIF ELSE l_stable = l_grid(k) ENDIF ! !-- Adjustment of the mixing length IF ( wall_adjustment ) THEN l(k) = MIN( l_wall(k,j,i), l_grid(k), l_stable ) ll(k) = MIN( l_wall(k,j,i), l_grid(k) ) ELSE l(k) = MIN( l_grid(k), l_stable ) ll(k) = l_grid(k) ENDIF IF ( adjust_mixing_length .AND. prandtl_layer ) THEN l(k) = MIN( l(k), kappa * & ( zu(k) - zw(nzb_s_inner(j,i)) ) / phi_m ) ll(k) = MIN( ll(k), kappa * & ( zu(k) - zw(nzb_s_inner(j,i)) ) / phi_m ) ENDIF ! !-- Compute diffusion coefficients for momentum and heat km(k,j,i) = 0.1 * l(k) * sqrt_e(k) kh(k,j,i) = ( 1.0 + 2.0 * l(k) / ll(k) ) * km(k,j,i) ENDDO ! !-- Summation for averaged profile (cf. flow_statistics) !-- (the IF statement still requires a performance check on NEC machines) DO sr = 0, statistic_regions IF ( rmask(j,i,sr) /= 0.0 .AND. & i >= nxl .AND. i <= nxr .AND. j >= nys .AND. j <= nyn ) THEN DO k = nzb_s_inner(j,i)+1, nzt sums_l_l(k,sr,tn) = sums_l_l(k,sr,tn) + l(k) ENDDO ENDIF ENDDO ENDDO ENDDO sums_l_l(nzt+1,:,tn) = sums_l_l(nzt,:,tn) ! quasi boundary-condition for ! data output !$OMP END PARALLEL ! !-- Set vertical boundary values (Neumann conditions both at bottom and top). !-- Horizontal boundary conditions at vertical walls are not set because !-- so far vertical walls require usage of a Prandtl-layer where the boundary !-- values of the diffusivities are not needed !$OMP PARALLEL DO DO i = nxl-1, nxr+1 DO j = nys-1, nyn+1 km(nzb_s_inner(j,i),j,i) = km(nzb_s_inner(j,i)+1,j,i) km(nzt+1,j,i) = km(nzt,j,i) kh(nzb_s_inner(j,i),j,i) = kh(nzb_s_inner(j,i)+1,j,i) kh(nzt+1,j,i) = kh(nzt,j,i) ENDDO ENDDO ! !-- Set Neumann boundary conditions at the outflow boundaries in case of !-- non-cyclic lateral boundaries IF ( outflow_l ) THEN km(:,:,nxl-1) = km(:,:,nxl) kh(:,:,nxl-1) = kh(:,:,nxl) ENDIF IF ( outflow_r ) THEN km(:,:,nxr+1) = km(:,:,nxr) kh(:,:,nxr+1) = kh(:,:,nxr) ENDIF IF ( outflow_s ) THEN km(:,nys-1,:) = km(:,nys,:) kh(:,nys-1,:) = kh(:,nys,:) ENDIF IF ( outflow_n ) THEN km(:,nyn+1,:) = km(:,nyn,:) kh(:,nyn+1,:) = kh(:,nyn,:) ENDIF END SUBROUTINE diffusivities