source: palm/trunk/SOURCE/diffusivities.f90 @ 95

 SUBROUTINE diffusivities( theta )

!------------------------------------------------------------------------------!
! Actual revisions:
! -----------------
! 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.
! 
! Former revisions:
! -----------------
! $Id: diffusivities.f90 94 2007-06-01 15:25:22Z raasch $
!
! 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    ::  dpt_dz, l_stable, phi_m = 1.0

    REAL    ::  theta(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 (dpt_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
             dpt_dz = ( theta(k+1,j,i) - theta(k-1,j,i) ) * dd2zu(k)
             IF ( dpt_dz > 0.0 ) THEN
                IF ( use_pt_reference )  THEN
                   l_stable = 0.76 * sqrt_e(k) / &
                                     SQRT( g / pt_reference * dpt_dz ) + 1E-5
                ELSE
                   l_stable = 0.76 * sqrt_e(k) / &
                                     SQRT( g / theta(k,j,i) * dpt_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)
          DO  sr = 0, statistic_regions
             IF ( rmask(j,i,sr) /= 0.0 )  THEN
                DO  k = nzb_s_outer(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