!-------------------------------------------------------------------------------

! This file is part of Code_Saturne, a general-purpose CFD tool.
!
! Copyright (C) 1998-2021 EDF S.A.
!
! This program is free software; you can redistribute it and/or modify it under
! the terms of the GNU General Public License as published by the Free Software
! Foundation; either version 2 of the License, or (at your option) any later
! version.
!
! This program is distributed in the hope that it will be useful, but WITHOUT
! ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
! FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
! details.
!
! You should have received a copy of the GNU General Public License along with
! this program; if not, write to the Free Software Foundation, Inc., 51 Franklin
! Street, Fifth Floor, Boston, MA 02110-1301, USA.

!-------------------------------------------------------------------------------

!===============================================================================
! Function :
! --------

!> \file clptur.f90
!>
!> \brief Boundary conditions for smooth walls (icodcl = 5).
!>
!> The wall functions may change the value of the diffusive flux.
!>
!> The values at a boundary face \f$ \fib \f$ stored in the face center
!> \f$ \centf \f$ of the variable \f$ P \f$ and its diffusive flux \f$ Q \f$
!> are written as:
!> \f[
!> P_\centf = A_P^g + B_P^g P_\centi
!> \f]
!> and
!> \f[
!> Q_\centf = A_P^f + B_P^f P_\centi
!> \f]
!> where \f$ P_\centi \f$ is the value of the variable \f$ P \f$ at the
!> neighboring cell.
!>
!> Warning:
!>
!> - for a vector field such as the veclocity \f$ \vect{u} \f$ the boundary
!>   conditions may read:
!>   \f[
!>   \vect{u}_\centf = \vect{A}_u^g + \tens{B}_u^g \vect{u}_\centi
!>   \f]
!>   and
!>   \f[
!>   \vect{Q}_\centf = \vect{A}_u^f + \tens{B}_u^f \vect{u}_\centi
!>   \f]
!>   where \f$ \tens{B}_u^g \f$ and \f$ \tens{B}_u^f \f$ are 3x3 tensor matrix
!>   which coupled veclocity components next to a boundary.
!>
!> Please refer to the
!> <a href="../../theory.pdf#wallboundary"><b>wall boundary conditions</b></a>
!> section of the theory guide for more informations, as well as the
!> <a href="../../theory.pdf#clptur"><b>clptur</b></a> section.
!-------------------------------------------------------------------------------

!-------------------------------------------------------------------------------
! Arguments
!______________________________________________________________________________.
!  mode           name          role                                           !
!______________________________________________________________________________!
!> \param[in]     nscal         total number of scalars
!> \param[in]     isvhb         indicator to save exchange coeffient
!> \param[in,out] icodcl        face boundary condition code:
!>                               - 1 Dirichlet
!>                               - 3 Neumann
!>                               - 4 sliding and
!>                                 \f$ \vect{u} \cdot \vect{n} = 0 \f$
!>                               - 5 smooth wall and
!>                                 \f$ \vect{u} \cdot \vect{n} = 0 \f$
!>                               - 6 rough wall and
!>                                 \f$ \vect{u} \cdot \vect{n} = 0 \f$
!>                               - 9 free inlet/outlet
!>                                 (input mass flux blocked to 0)
!> \param[in,out] rcodcl        boundary condition values:
!>                               - rcodcl(1) value of the dirichlet
!>                               - rcodcl(2) value of the exterior exchange
!>                                 coefficient (infinite if no exchange)
!>                               - rcodcl(3) value flux density
!>                                 (negative if gain) in w/m2
!>                                 -# for the velocity \f$ (\mu+\mu_T)
!>                                    \gradv \vect{u} \cdot \vect{n}  \f$
!>                                 -# for the pressure \f$ \Delta t
!>                                    \grad P \cdot \vect{n}  \f$
!>                                 -# for a scalar \f$ cp \left( K +
!>                                     \dfrac{K_T}{\sigma_T} \right)
!>                                     \grad T \cdot \vect{n} \f$
!> \param[in]     velipb        value of the velocity at \f$ \centip \f$
!>                               of boundary cells
!> \param[in]     rijipb        value of \f$ R_{ij} \f$ at \f$ \centip \f$
!>                               of boundary cells
!> \param[out]    visvdr        dynamic viscosity after V. Driest damping in
!>                               boundary cells
!> \param[out]    hbord         exchange coefficient at boundary
!> \param[in]     theipb        value of thermal scalar at \f$ \centip \f$
!>                               of boundary cells
!_______________________________________________________________________________

subroutine clptur &
 ( nscal  , isvhb  , icodcl ,                                     &
   rcodcl ,                                                       &
   velipb , rijipb , visvdr ,                                     &
   hbord  , theipb )

!===============================================================================

!===============================================================================
! Module files
!===============================================================================

use paramx
use numvar
use optcal
use cstphy
use cstnum
use pointe
use entsor
use albase
use parall
use ppppar
use ppthch
use ppincl
use radiat
use cplsat
use mesh
use field
use lagran
use turbomachinery
use cs_c_bindings
use atincl

!===============================================================================

implicit none

! Arguments

integer          nscal, isvhb

integer, pointer, dimension(:,:) :: icodcl

double precision, pointer, dimension(:,:,:) :: rcodcl
double precision, dimension(:,:) :: velipb
double precision, pointer, dimension(:,:) :: rijipb
double precision, pointer, dimension(:) :: visvdr, hbord, theipb

! Local variables

integer          ifac, iel, isou, ii, jj, kk
integer          iscal, clsyme
integer          modntl
integer          iuntur, f_dim
integer          nlogla, nsubla, iuiptn
integer          f_id_rough, f_id, iustar
integer          f_id_uet, f_id_uk

double precision rnx, rny, rnz
double precision tx, ty, tz, txn, txn0, t2x, t2y, t2z
double precision utau, upx, upy, upz, usn
double precision uiptn, uiptmn, uiptmx
double precision uetmax, uetmin, ukmax, ukmin, yplumx, yplumn
double precision tetmax, tetmin, tplumx, tplumn
double precision uk, uet, nusury, yplus, dplus, yk
double precision gredu, temp
double precision cfnns, cfnnk, cfnne
double precision sqrcmu, ek
double precision xnuii, xnuit, xmutlm, mut_lm_dmut
double precision rcprod
double precision hflui, hint, pimp, qimp
double precision eloglo(3,3), alpha(6,6)
double precision rcodcx, rcodcy, rcodcz, rcodcn
double precision visclc, visctc, romc  , distbf, srfbnf
double precision cofimp, ypup
double precision bldr12
double precision xkip
double precision rinfiv(3)
double precision visci(3,3), fikis, viscis, distfi
double precision fcoefa(6), fcoefb(6), fcofaf(6), fcofbf(6), fcofad(6), fcofbd(6)
double precision rxx, rxy, rxz, ryy, ryz, rzz, rnnb
double precision rttb, alpha_rnn
double precision cpp
double precision sigmak, sigmae
double precision liqwt, totwt
double precision rough_d, duplus, uplus
double precision rough_t
double precision dtplus, yplus_t
double precision coef_mom, coef_momm
double precision one_minus_ri
double precision dlmo,dt,theta0,flux

double precision, dimension(:), pointer :: crom
double precision, dimension(:), pointer :: viscl, visct, cpro_cp, yplbr, ustar
double precision, dimension(:), pointer :: bpro_rough_d
double precision, dimension(:), pointer :: bpro_rough_t
double precision, dimension(:), pointer :: f_uet, f_uk
double precision, dimension(:), allocatable :: byplus, bdplus, buk
double precision, dimension(:), allocatable, target :: buet, bcfnns_loc
double precision, dimension(:), pointer :: cvar_k, cvar_ep, bcfnns
double precision, dimension(:), pointer :: cvar_r11, cvar_r22, cvar_r33
double precision, dimension(:), pointer :: cvar_r12, cvar_r13, cvar_r23
double precision, dimension(:,:), pointer :: cvar_rij

double precision, dimension(:), pointer :: cvar_totwt, cvar_t, cpro_liqwt
double precision, dimension(:,:), pointer :: coefau, cofafu, visten
double precision, dimension(:,:,:), pointer :: coefbu, cofbfu
double precision, dimension(:), pointer :: coefa_k, coefb_k, coefaf_k, coefbf_k
double precision, dimension(:), pointer :: coefa_ep, coefaf_ep
double precision, dimension(:), pointer :: coefb_ep, coefbf_ep
double precision, dimension(:), pointer :: coefa_r11, coefaf_r11, coefad_r11
double precision, dimension(:), pointer :: coefb_r11, coefbf_r11, coefbd_r11
double precision, dimension(:), pointer :: coefa_r22, coefaf_r22, coefad_r22
double precision, dimension(:), pointer :: coefb_r22, coefbf_r22, coefbd_r22
double precision, dimension(:), pointer :: coefa_r33, coefaf_r33, coefad_r33
double precision, dimension(:), pointer :: coefb_r33, coefbf_r33, coefbd_r33
double precision, dimension(:), pointer :: coefa_r12, coefaf_r12, coefad_r12
double precision, dimension(:), pointer :: coefb_r12, coefbf_r12, coefbd_r12
double precision, dimension(:), pointer :: coefa_r13, coefaf_r13, coefad_r13
double precision, dimension(:), pointer :: coefb_r13, coefbf_r13, coefbd_r13
double precision, dimension(:), pointer :: coefa_r23, coefaf_r23, coefad_r23
double precision, dimension(:), pointer :: coefb_r23, coefbf_r23, coefbd_r23
double precision, dimension(:), pointer :: coefa_omg, coefaf_omg
double precision, dimension(:), pointer :: coefb_omg, coefbf_omg
double precision, dimension(:), pointer :: coefa_al, coefaf_al
double precision, dimension(:), pointer :: coefb_al, coefbf_al
double precision, dimension(:), pointer :: coefa_phi, coefaf_phi
double precision, dimension(:), pointer :: coefb_phi, coefbf_phi
double precision, dimension(:), pointer :: coefa_fb, coefaf_fb
double precision, dimension(:), pointer :: coefb_fb, coefbf_fb
double precision, dimension(:), pointer :: coefa_nu, coefaf_nu
double precision, dimension(:), pointer :: coefb_nu, coefbf_nu

double precision, dimension(:,:), pointer :: coefa_rij, coefaf_rij, coefad_rij
double precision, dimension(:,:,:), pointer :: coefb_rij, coefbf_rij, coefbd_rij

double precision  pimp_lam, pimp_turb, gammap, fep, dep, falpg, falpv, ypsd, fct_bl

integer          ntlast , iaff
data             ntlast , iaff /-1 , 0/
save             ntlast , iaff

type(var_cal_opt) :: vcopt_u, vcopt_rij, vcopt_ep

!===============================================================================
! Interfaces
!===============================================================================

interface

  subroutine clptur_scalar(iscal  , isvhb   , icodcl  , rcodcl  ,     &
                           byplus , bdplus  , buk     , bcfnns  ,     &
                           hbord  , theipb  ,                         &
                           tetmax , tetmin  , tplumx  , tplumn  )

    implicit none
    integer          iscal, isvhb
    integer, pointer, dimension(:,:) :: icodcl
    double precision, pointer, dimension(:,:,:) :: rcodcl
    double precision, dimension(:) :: byplus, bdplus, buk, bcfnns
    double precision, pointer, dimension(:) :: hbord, theipb
    double precision tetmax, tetmin, tplumx, tplumn

  end subroutine clptur_scalar

  subroutine clptur_vector(iscal, isvhb, icodcl, rcodcl,        &
                           byplus, bdplus, buk)

    implicit none
    integer          iscal, isvhb
    integer, pointer, dimension(:,:) :: icodcl
    double precision, pointer, dimension(:,:,:) :: rcodcl
    double precision, dimension(:) :: byplus, bdplus, buk

  end subroutine clptur_vector

 end interface

!===============================================================================
! 1. Initializations
!===============================================================================

! Initialize variables to avoid compiler warnings

cofimp  = 0.d0
ek = 0.d0
rcprod = 0.d0
uiptn = 0.d0
rnnb = 0.d0

rinfiv(1) = rinfin
rinfiv(2) = rinfin
rinfiv(3) = rinfin

uet = 1.d0
utau = 1.d0

! --- Constants
sqrcmu = sqrt(cmu)

! --- Correction factors for stratification (used in atmospheric models)
cfnns = 1.d0
cfnnk = 1.d0
cfnne = 1.d0

bpro_rough_d => null()
bpro_rough_t => null()

call field_get_id_try("boundary_roughness", f_id_rough)
if (f_id_rough.ge.0) then
  call field_get_val_s(f_id_rough, bpro_rough_d)

  ! same thermal roughness if not specified
  call field_get_val_s(f_id_rough, bpro_rough_t)
endif

call field_get_id_try("boundary_thermal_roughness", f_id_rough)
if (f_id_rough.ge.0) then
  call field_get_val_s(f_id_rough, bpro_rough_t)
endif

f_uet => null()
f_uk => null()

call field_get_id_try("boundary_ustar", f_id_uet)
if (f_id_uet.ge.0) call field_get_val_s(f_id_uet, f_uet)
call field_get_id_try("boundary_uk", f_id_uk)
if (f_id_uk.ge.0) call field_get_val_s(f_id_uk, f_uk)


! pointers to y+ if saved
yplbr => null()
if (iyplbr.ge.0) call field_get_val_s(iyplbr, yplbr)

if (itytur.eq.3 .and. idirsm.eq.1) call field_get_val_v(ivsten, visten)

ustar => null()

! --- Save wall friction velocity

call field_get_id_try('ustar', iustar)
if (iustar.ge.0) then
  call field_get_val_s(iustar, ustar)
else
  allocate(buet(nfabor))
  ustar => buet
endif

! --- Gradient and flux boundary conditions

call field_get_coefa_v(ivarfl(iu), coefau)
call field_get_coefb_v(ivarfl(iu), coefbu)
call field_get_coefaf_v(ivarfl(iu), cofafu)
call field_get_coefbf_v(ivarfl(iu), cofbfu)

if (ik.gt.0) then
  call field_get_coefa_s(ivarfl(ik), coefa_k)
  call field_get_coefb_s(ivarfl(ik), coefb_k)
  call field_get_coefaf_s(ivarfl(ik), coefaf_k)
  call field_get_coefbf_s(ivarfl(ik), coefbf_k)
  call field_get_key_double(ivarfl(ik), ksigmas, sigmak)
else
  coefa_k => null()
  coefb_k => null()
  coefaf_k => null()
  coefbf_k => null()
endif

if (iep.gt.0) then
  call field_get_coefa_s(ivarfl(iep), coefa_ep)
  call field_get_coefb_s(ivarfl(iep), coefb_ep)
  call field_get_coefaf_s(ivarfl(iep), coefaf_ep)
  call field_get_coefbf_s(ivarfl(iep), coefbf_ep)
  call field_get_key_double(ivarfl(iep), ksigmas, sigmae)
else
  coefa_ep => null()
  coefb_ep => null()
  coefaf_ep => null()
  coefbf_ep => null()
endif

if (itytur.eq.3) then! Also have boundary conditions for the momentum equation

  if (irijco.eq.1) then
    call field_get_coefa_v(ivarfl(irij), coefa_rij)
    call field_get_coefb_v(ivarfl(irij), coefb_rij)
    call field_get_coefaf_v(ivarfl(irij), coefaf_rij)
    call field_get_coefbf_v(ivarfl(irij), coefbf_rij)
    call field_get_coefad_v(ivarfl(irij), coefad_rij)
    call field_get_coefbd_v(ivarfl(irij), coefbd_rij)

    coefb_r11 => null()
    coefaf_r11 => null()
    coefbf_r11 => null()
    coefad_r11 => null()
    coefbd_r11 => null()

    coefa_r22 => null()
    coefb_r22 => null()
    coefaf_r22 => null()
    coefbf_r22 => null()
    coefad_r22 => null()
    coefbd_r22 => null()

    coefa_r33 => null()
    coefb_r33 => null()
    coefaf_r33 => null()
    coefbf_r33 => null()
    coefad_r33 => null()
    coefbd_r33 => null()

    coefa_r12 => null()
    coefb_r12 => null()
    coefaf_r12 => null()
    coefbf_r12 => null()
    coefad_r12 => null()
    coefbd_r12 => null()

    coefa_r13 => null()
    coefb_r13 => null()
    coefaf_r13 => null()
    coefbf_r13 => null()
    coefad_r13 => null()
    coefbd_r13 => null()

    coefa_r23 => null()
    coefb_r23 => null()
    coefaf_r23 => null()
    coefbf_r23 => null()
    coefad_r23 => null()
    coefbd_r23 => null()


  else

    call field_get_coefa_s(ivarfl(ir11), coefa_r11)
    call field_get_coefb_s(ivarfl(ir11), coefb_r11)
    call field_get_coefaf_s(ivarfl(ir11), coefaf_r11)
    call field_get_coefbf_s(ivarfl(ir11), coefbf_r11)
    call field_get_coefad_s(ivarfl(ir11), coefad_r11)
    call field_get_coefbd_s(ivarfl(ir11), coefbd_r11)

    call field_get_coefa_s(ivarfl(ir22), coefa_r22)
    call field_get_coefb_s(ivarfl(ir22), coefb_r22)
    call field_get_coefaf_s(ivarfl(ir22), coefaf_r22)
    call field_get_coefbf_s(ivarfl(ir22), coefbf_r22)
    call field_get_coefad_s(ivarfl(ir22), coefad_r22)
    call field_get_coefbd_s(ivarfl(ir22), coefbd_r22)

    call field_get_coefa_s(ivarfl(ir33), coefa_r33)
    call field_get_coefb_s(ivarfl(ir33), coefb_r33)
    call field_get_coefaf_s(ivarfl(ir33), coefaf_r33)
    call field_get_coefbf_s(ivarfl(ir33), coefbf_r33)
    call field_get_coefad_s(ivarfl(ir33), coefad_r33)
    call field_get_coefbd_s(ivarfl(ir33), coefbd_r33)

    call field_get_coefa_s(ivarfl(ir12), coefa_r12)
    call field_get_coefb_s(ivarfl(ir12), coefb_r12)
    call field_get_coefaf_s(ivarfl(ir12), coefaf_r12)
    call field_get_coefbf_s(ivarfl(ir12), coefbf_r12)
    call field_get_coefad_s(ivarfl(ir12), coefad_r12)
    call field_get_coefbd_s(ivarfl(ir12), coefbd_r12)

    call field_get_coefa_s(ivarfl(ir13), coefa_r13)
    call field_get_coefb_s(ivarfl(ir13), coefb_r13)
    call field_get_coefaf_s(ivarfl(ir13), coefaf_r13)
    call field_get_coefbf_s(ivarfl(ir13), coefbf_r13)
    call field_get_coefad_s(ivarfl(ir13), coefad_r13)
    call field_get_coefbd_s(ivarfl(ir13), coefbd_r13)

    call field_get_coefa_s(ivarfl(ir23), coefa_r23)
    call field_get_coefb_s(ivarfl(ir23), coefb_r23)
    call field_get_coefaf_s(ivarfl(ir23), coefaf_r23)
    call field_get_coefbf_s(ivarfl(ir23), coefbf_r23)
    call field_get_coefad_s(ivarfl(ir23), coefad_r23)
    call field_get_coefbd_s(ivarfl(ir23), coefbd_r23)

    coefa_rij => null()
    coefb_rij => null()
    coefaf_rij => null()
    coefbf_rij => null()
    coefad_rij => null()
    coefbd_rij => null()
  endif
endif

if (ial.gt.0) then
  call field_get_coefa_s(ivarfl(ial), coefa_al)
  call field_get_coefb_s(ivarfl(ial), coefb_al)
  call field_get_coefaf_s(ivarfl(ial), coefaf_al)
  call field_get_coefbf_s(ivarfl(ial), coefbf_al)
else
  coefa_al => null()
  coefb_al => null()
  coefaf_al => null()
  coefbf_al => null()
endif

if (iomg.gt.0) then
  call field_get_coefa_s(ivarfl(iomg), coefa_omg)
  call field_get_coefb_s(ivarfl(iomg), coefb_omg)
  call field_get_coefaf_s(ivarfl(iomg), coefaf_omg)
  call field_get_coefbf_s(ivarfl(iomg), coefbf_omg)
else
  coefa_omg => null()
  coefb_omg => null()
  coefaf_omg => null()
  coefbf_omg => null()
endif

if (iphi.gt.0) then
  call field_get_coefa_s(ivarfl(iphi), coefa_phi)
  call field_get_coefb_s(ivarfl(iphi), coefb_phi)
  call field_get_coefaf_s(ivarfl(iphi), coefaf_phi)
  call field_get_coefbf_s(ivarfl(iphi), coefbf_phi)
else
  coefa_phi => null()
  coefb_phi => null()
  coefaf_phi => null()
  coefbf_phi => null()
endif

if (ifb.gt.0) then
  call field_get_coefa_s(ivarfl(ifb), coefa_fb)
  call field_get_coefb_s(ivarfl(ifb), coefb_fb)
  call field_get_coefaf_s(ivarfl(ifb), coefaf_fb)
  call field_get_coefbf_s(ivarfl(ifb), coefbf_fb)
else
  coefa_fb => null()
  coefb_fb => null()
  coefaf_fb => null()
  coefbf_fb => null()
endif

if (inusa.gt.0) then
  call field_get_coefa_s(ivarfl(inusa), coefa_nu)
  call field_get_coefaf_s(ivarfl(inusa), coefaf_nu)
  call field_get_coefb_s(ivarfl(inusa), coefb_nu)
  call field_get_coefbf_s(ivarfl(inusa), coefbf_nu)
else
  coefa_nu => null()
  coefb_nu => null()
  coefaf_nu => null()
  coefbf_nu => null()
endif

! --- Physical quantities
call field_get_val_s(icrom, crom)
call field_get_val_s(iviscl, viscl)
call field_get_val_s(ivisct, visct)
if (icp.ge.0) then
  call field_get_val_s(icp, cpro_cp)
endif

if (itytur.eq.2 .or. itytur.eq.5 .or. iturb.eq.60) then
  call field_get_val_s(ivarfl(ik), cvar_k)
endif
if ((iturb.eq.30).or.(iturb.eq.31)) then
  call field_get_val_s(ivarfl(iep), cvar_ep)
endif

if (itytur.eq.3) then
  call field_get_key_struct_var_cal_opt(ivarfl(irij), vcopt_rij)
  call field_get_key_struct_var_cal_opt(ivarfl(iep), vcopt_ep)
  if (irijco.eq.1) then
    call field_get_val_v(ivarfl(irij), cvar_rij)
  else
    call field_get_val_s(ivarfl(ir11), cvar_r11)
    call field_get_val_s(ivarfl(ir22), cvar_r22)
    call field_get_val_s(ivarfl(ir33), cvar_r33)
    call field_get_val_s(ivarfl(ir12), cvar_r12)
    call field_get_val_s(ivarfl(ir13), cvar_r13)
    call field_get_val_s(ivarfl(ir23), cvar_r23)
  endif
endif

! min. and max. of wall tangential velocity
uiptmx = -grand
uiptmn =  grand

! min. and max. of wall friction velocity
uetmax = -grand
uetmin =  grand
ukmax  = -grand
ukmin  =  grand

! min. and max. of y+
yplumx = -grand
yplumn =  grand

! min. and max. of wall friction of the thermal scalar
tetmax = -grand
tetmin =  grand

! min. and max. of T+
tplumx = -grand
tplumn =  grand

! Counters (turbulent, laminar, reversal, scale correction)
nlogla = 0
nsubla = 0
iuiptn = 0

! Alpha constant for a realisable BC for R12 with the SSG model
alpha_rnn = 0.47d0

! With v2f type model, (phi-fbar et BL-v2/k) u=0 is set directly, so
! uiptmx and uiptmn are necessarily 0
if (itytur.eq.5) then
  uiptmx = 0.d0
  uiptmn = 0.d0
endif

! Pointers to specific fields
allocate(byplus(nfabor))
allocate(bdplus(nfabor))
allocate(buk(nfabor))

! Correction for atmospheric wall functions
call field_get_id_try("non_neutral_scalar_correction", f_id)
if (f_id.ge.0) then
  call field_get_val_s(f_id, bcfnns)
else
  allocate(bcfnns_loc(nfabor))
  bcfnns => bcfnns_loc
endif

cvar_t => null()
cvar_totwt => null()
cpro_liqwt => null()

if (ippmod(iatmos).ge.1) then
  theta0 = t0 * (ps / p0)**(rair/cp0)
  call field_get_val_s(ivarfl(isca(iscalt)), cvar_t)
  if (ippmod(iatmos).eq.2) then
    call field_get_val_s(ivarfl(isca(iymw)), cvar_totwt)
    call field_get_val_s(iliqwt, cpro_liqwt)
  endif
endif



! --- Loop on boundary faces
do ifac = 1, nfabor

  ! Test on the presence of a smooth wall condition (start)
  if (icodcl(ifac,iu).eq.5) then

    iel = ifabor(ifac)

    ! Physical properties
    visclc = viscl(iel)
    visctc = visct(iel)
    romc   = crom(iel)

    ! Geometric quantities
    distbf = distb(ifac)
    srfbnf = surfbn(ifac)

    !===========================================================================
    ! 1. Local framework
    !===========================================================================

    ! Unit normal

    rnx = surfbo(1,ifac)/srfbnf
    rny = surfbo(2,ifac)/srfbnf
    rnz = surfbo(3,ifac)/srfbnf

    ! Handle displacement velocity

    rcodcx = rcodcl(ifac,iu,1)
    rcodcy = rcodcl(ifac,iv,1)
    rcodcz = rcodcl(ifac,iw,1)

    ! If we are not using ALE, force the displacement velocity for the face
    !  to be tangential (and update rcodcl for possible use)
    ! In frozen rotor (iturbo = 1), the velocity is neither tangential to the
    !  wall (absolute velocity solved in a relative frame of reference)
    if (iale.eq.0.and.iturbo.eq.0) then
      rcodcn = rcodcx*rnx+rcodcy*rny+rcodcz*rnz
      rcodcx = rcodcx -rcodcn*rnx
      rcodcy = rcodcy -rcodcn*rny
      rcodcz = rcodcz -rcodcn*rnz
      rcodcl(ifac,iu,1) = rcodcx
      rcodcl(ifac,iv,1) = rcodcy
      rcodcl(ifac,iw,1) = rcodcz
    endif

    ! Relative tangential velocity

    upx = velipb(ifac,1) - rcodcx
    upy = velipb(ifac,2) - rcodcy
    upz = velipb(ifac,3) - rcodcz

    usn = upx*rnx+upy*rny+upz*rnz
    tx  = upx -usn*rnx
    ty  = upy -usn*rny
    tz  = upz -usn*rnz
    txn = sqrt(tx**2 +ty**2 +tz**2)
    utau= txn

    ! Unit tangent

    if (txn.ge.epzero) then

      txn0 = 1.d0

      tx  = tx/txn
      ty  = ty/txn
      tz  = tz/txn

    else

      ! If the velocity is zero,
      !  Tx, Ty, Tz is not used (we cancel the velocity), so we assign any
      !  value (zero for example)

      txn0 = 0.d0

      tx  = 0.d0
      ty  = 0.d0
      tz  = 0.d0

    endif

    ! Complete if necessary for Rij-Epsilon

    if (itytur.eq.3) then

      ! --> T2 = RN X T (where X is the cross product)

      t2x = rny*tz - rnz*ty
      t2y = rnz*tx - rnx*tz
      t2z = rnx*ty - rny*tx

      ! --> Orthogonal matrix for change of reference frame ELOGLOij
      !     (from local to global reference frame)

      !                      |TX  -RNX  T2X|
      !             ELOGLO = |TY  -RNY  T2Y|
      !                      |TZ  -RNZ  T2Z|

      !    Its transpose ELOGLOt is its inverse

      eloglo(1,1) =  tx
      eloglo(1,2) = -rnx
      eloglo(1,3) =  t2x
      eloglo(2,1) =  ty
      eloglo(2,2) = -rny
      eloglo(2,3) =  t2y
      eloglo(3,1) =  tz
      eloglo(3,2) = -rnz
      eloglo(3,3) =  t2z

      ! Compute Reynolds stress transformation matrix

      clsyme = 0
      call turbulence_bc_rij_transform(clsyme, eloglo, alpha)

    endif

    !===========================================================================
    ! 2. Friction velocities
    !===========================================================================

    ! ---> Compute Uet depending if we are in the log zone or not
    !      in 1 or 2 velocity scales
    !      and uk based on ek


    if (abs(utau).le.epzero) utau = epzero

    nusury = visclc/(distbf*romc)
    xnuii = visclc/romc
    xnuit = visctc/romc

    if (itytur.eq.2 .or. itytur.eq.5 .or. iturb.eq.60) then
      ek = cvar_k(iel)
      ! TODO: we could add 2*nu_T dv/dy to rnnb
      rnnb = 2.d0 / 3.d0 * ek
    else if (itytur.eq.3) then
      if (irijco.eq.1) then
        ek = 0.5d0*(cvar_rij(1,iel)+cvar_rij(2,iel)+cvar_rij(3,iel))
        rxx = cvar_rij(1,iel)
        rxy = cvar_rij(4,iel)
        rxz = cvar_rij(6,iel)
        ryy = cvar_rij(2,iel)
        ryz = cvar_rij(5,iel)
        rzz = cvar_rij(3,iel)
      else
        ek = 0.5d0*(cvar_r11(iel)+cvar_r22(iel)+cvar_r33(iel))
        rxx = cvar_r11(iel)
        rxy = cvar_r12(iel)
        rxz = cvar_r13(iel)
        ryy = cvar_r22(iel)
        ryz = cvar_r23(iel)
        rzz = cvar_r33(iel)
      endif
      rnnb =   rnx * (rxx * rnx + rxy * rny + rxz * rnz) &
             + rny * (rxy * rnx + ryy * rny + ryz * rnz) &
             + rnz * (rxz * rnx + ryz * rny + rzz * rnz)

      rttb =   tx * (rxx * tx + rxy * ty + rxz * tz) &
             + ty * (rxy * tx + ryy * ty + ryz * tz) &
             + tz * (rxz * tx + ryz * ty + rzz * tz)
    endif

    if (f_id_rough.ge.0) then
      rough_d = bpro_rough_d(ifac)
    else
      rough_d = 0.d0
    endif

    call wallfunctions &
  ( iwallf, ifac  ,                                        &
    xnuii , xnuit , utau  , distbf, rough_d, rnnb, ek,     &
    iuntur, nsubla, nlogla,                                &
    uet   , uk    , yplus , ypup  , cofimp, dplus )

    ! Louis or Monin Obukhov wall function for atmospheric flows
    if (ippmod(iatmos).ge.1.and.(iwalfs.eq.2.or.iwalfs.eq.3)) then
      ! Louis
      if (iwalfs.eq.2) then

        ! Compute reduced gravity for non horizontal walls :
        gredu = gx*rnx + gy*rny + gz*rnz

        temp = cvar_t(iel)
        totwt = 0.d0
        liqwt = 0.d0

        if (ippmod(iatmos).eq.2) then
          totwt = cvar_totwt(iel)
          liqwt = cpro_liqwt(iel)
        endif

        yk = distbf * uk / xnuii
        ! 1/U+ for neutral
        duplus = ypup / yk

        rough_t = bpro_rough_t(ifac)
        ! 1/T+
        ! "y+_t" tends to "y/rough_t" for rough regime and to "y+k"
        ! times a shift for smooth regime
        !
        ! Rough regime reads:
        !   T+ = 1/kappa ln(y/rough_t) = 1/kappa ln(y/zeta) + 8.5
        !                              = 1/kappa ln[y/zeta * exp(8.5 kappa)]
        !
        ! Note zeta_t = rough_t * exp(8.5 kappa)
        !
        ! Smooth regime reads:
        !   T+ = 1/kappa ln(y uk/nu) + 5.2 = 1/kappa ln[y uk*exp(5.2 kappa) / nu]
        !
        ! Mixed regime reads:
        !   T+ = 1/kappa ln[y uk*exp(5.2 kappa)/(nu + alpha uk zeta)]
        !      = 1/kappa ln[y uk*exp(5.2 kappa)/(nu + alpha uk rough_t * exp(8.5 kappa))]
        !      = 1/kappa ln[y uk*exp(5.2 kappa)/(nu + alpha uk rough_t * exp(8.5 kappa))]
        ! with
        !   alpha * exp(8.5 kappa) / exp(5.2 kappa) = 1
        ! ie
        !   alpha = exp(-(8.5-5.2) kappa) = 0.25
        ! so
        !   T+ = 1/kappa ln[y uk*exp(5.2 kappa)/(nu + uk rough_t * exp(5.2 kappa))]
        !      = 1/kappa ln[y+k / (exp(-5.2 kappa) + uk rough_t/nu)]
        !

        ! shifted y+
        yplus_t = yk / (exp(-xkappa * 5.2d0) + uk *rough_t / xnuii)! FIXME use log constant
        ! 1/T+ for neutral
        dtplus =  xkappa / log(yplus_t)

        call atmcls &
        !==========
      ( ifac   ,                                                       &
        utau   , rough_d, duplus , dtplus ,                            &
        yplus_t,                                                       &
        uet    ,                                                       &
        gredu  ,                                                       &
        cfnns  , cfnnk  , cfnne  ,                                     &
        dlmo   ,                                                       &
        temp   , totwt  , liqwt  ,                                     &
        icodcl , rcodcl )

      ! Monin Obukhov wall function
      else if (iwalfs.eq.3) then

        ! Compute local LMO
        if (ippmod(iatmos).ge.1) then
          gredu = gx*rnx + gy*rny + gz*rnz

          if (icodcl(ifac,isca(iscalt)).eq.6 &
            .or.icodcl(ifac,isca(iscalt)).eq.5) then

            dt = theipb(ifac)-rcodcl(ifac,isca(iscalt),1)
            call mo_compute_from_thermal_diff(distbf,rough_d,utau,dt, &
                                              theta0, gredu,          &
                                              dlmo, uet)

          elseif (icodcl(ifac,isca(iscalt)).eq.3) then
            if (icp.ge.0) then
              cpp = cpro_cp(iel)
            else
              cpp = cp0
            endif

            flux = rcodcl(ifac, isca(iscalt),3)/romc/cpp
            call mo_compute_from_thermal_flux(distbf,rough_d,utau,flux, &
                                              theta0, gredu,            &
                                              dlmo, uet)

          endif

        else

          ! No temperature delta: neutral
          call mo_compute_from_thermal_diff(distbf,rough_d,utau,0.d0,0.d0,0.d0, &
                                            dlmo,uet)

        endif

        ! Take stability into account for the turbulent velocity scale
        coef_mom = cs_mo_phim(distbf+rough_d,dlmo)
        one_minus_ri = 1.d0-(distbf+rough_d) * dlmo/coef_mom

        if (one_minus_ri.gt.0) then
          ! Warning: overwritting uk, yplus should be recomputed
          uk = uk / one_minus_ri**0.25d0
          yplus = distbf * uk / xnuii

          ! Epsilon should be modified as well to get P+G = P(1-Ri) = epsilon
          ! P = -R_tn dU/dn = uk^2 uet Phi_m / (kappa z)
          cfnne = one_minus_ri * coef_mom
          ! Nothing done for the moment for really high stability
        else
          cfnne = 1.d0
        endif
        ! Boundary condition on the velocity to have approximately the good
        ! turbulence production
        coef_mom = cs_mo_phim(distbf+rough_d,dlmo)
        coef_momm = cs_mo_phim(2.d0*distbf+rough_d,dlmo)
        rcprod = 2.d0*distbf*sqrt(xkappa*uk*romc*coef_mom/visctc/(distbf+rough_d)) &
          - coef_momm/(2.d0+rough_d/distbf)

        iuntur = 1

        uplus = utau / uet
        ! Coupled solving of the velocity components
        ! The boundary term for velocity gradient is implicit
        ! modified for non neutral boundary layer (in uplus)
        cofimp  = min(max(1.d0 - 1.d0/(xkappa*uplus)*rcprod,0.d0),1.d0)
        yk = distbf * uk / xnuii
      endif ! End Monin Obukhov
      ! Dimensionless velocity, recomputed and therefore may take stability
      ! into account
      uplus = utau / uet
      ! y+/U+ for non neutral is recomputed
      ypup = yk / max(uplus, epzero)

    endif
    ! Store u_star and uk if needed
    if(f_id_uet.ge.0) then
      f_uet(ifac) = uet
      f_uk(ifac) = uk
    endif

    uetmax = max(uet,uetmax)
    uetmin = min(uet,uetmin)
    ukmax  = max(uk,ukmax)
    ukmin  = min(uk,ukmin)
    yplumx = max(yplus,yplumx)
    yplumn = min(yplus,yplumn)

    if (iustar.ge.0) then
      ustar(ifac) = uet !TODO remove, this information is in cofaf cofbf
    endif

    ! save turbulent subgrid viscosity after van Driest damping in LES
    ! care is taken to not dampen it twice at boundary cells having more
    ! one boundary face
    if (itytur.eq.4.and.idries.eq.1) then
      if (visvdr(iel).lt.-900.d0) then
        visct(iel) = visct(iel)*(1.d0-exp(-(yplus)/cdries))**2
        visvdr(iel) = visct(iel)
        visctc      = visct(iel)
      endif
    endif

    ! Save yplus if post-processed or condensation modelling
    if (iyplbr.ge.0) then
      yplbr(ifac) = yplus
    endif

    !===========================================================================
    ! 3. Velocity boundary conditions
    !===========================================================================

    ! Deprecated power law (Werner & Wengle)
    if (iwallf.eq.1) then
      uiptn  = utau + uet*apow*bpow*yplus**bpow*(2.d0**(bpow-1.d0)-2.d0)

    ! Dependant on the turbulence Model
    else

      ! uiptn respecte la production de k
      !  de facon conditionnelle --> Coef RCPROD

      ! --> k-epsilon and k-omega
      !--------------------------
      if (itytur.eq.2.or.iturb.eq.60) then

        xmutlm = xkappa*visclc*(yplus + dplus)!FIXME should be efvisc...
        if (cell_is_active(iel).eq.1) then
          mut_lm_dmut = xmutlm/visctc
        else
          mut_lm_dmut = 0.d0
        endif

        ! If yplus=0, uiptn is set to 0 to avoid division by 0.
        ! By the way, in this case: iuntur=0
        if (yplus.gt.epzero) then !TODO use iuntur.eq.1
          rcprod = min(xkappa , max(1.0d0,sqrt(mut_lm_dmut))/(yplus+dplus))!FIXME not valid for rough

          uiptn  = utau - distbf*uet*uk*romc/xkappa/visclc*(       &
               2.0d0*rcprod - 1.0d0/(2.0d0*yplus+dplus))
        else
          uiptn = 0.d0
        endif

      ! --> No turbulence, mixing length or Rij-espilon
      !------------------------------------------------
      elseif (iturb.eq.0.or.iturb.eq.10.or.itytur.eq.3) then

        ! Dans le cadre de la ponderation elliptique, on ne doit pas
        ! tenir compte des lois de paroi. On fait donc un test sur le modele
        ! de turbulence :
        ! si on est en LRR ou SSG on laisse les lois de paroi, si on est en
        ! EBRSM, on impose l adherence.
        if (iturb.eq.32.or.iturb.eq.0) then
          uiptn = 0.d0
        else

          ! If yplus=0, uiptn is set to 0 to avoid division by 0.
          ! By the way, in this case: iuntur=0
          if (yplus.gt.epzero) then !FIXME use iuntur
            uiptn = utau - distbf*romc*uet*uk/xkappa/visclc                    &
              *(2.0d0/(yplus+dplus) - 1.0d0/(2.0d0*yplus+dplus))
          else
            uiptn = 0.d0
          endif

        endif

      ! --> LES and Spalart Allmaras
      !-----------------------------
      elseif (itytur.eq.4.or.iturb.eq.70) then

        uiptn  = utau - uet/xkappa*1.5d0

        ! If (mu+mut) becomes zero (dynamic models), an arbitrary value is set
        ! (zero flux) but without any problems because the flux
        ! is really zero at this face.
        if (visctc+visclc.le.0) then
          hflui = 0.d0
        endif

      ! --> v2f
      !--------
      elseif (itytur.eq.5) then

        ! Avec ces conditions, pas besoin de calculer uiptmx, uiptmn
        ! et iuiptn qui sont nuls (valeur d'initialisation)
        uiptn  = 0.d0

      endif
    endif

    ! Min and Max and counter of reversal layer
    uiptmn = min(uiptn*iuntur,uiptmn)
    uiptmx = max(uiptn*iuntur,uiptmx)
    if (uiptn*iuntur.lt.-epzero) iuiptn = iuiptn + 1

    ! To be coherent with a wall function, clip it to 0
    cofimp = max(cofimp, 0.d0)

    ! On implicite le terme (rho*uet*uk)
    hflui = visclc / distbf * ypup

    if (itytur.eq.3) then
      hint =  visclc          /distbf
    else
      hint = (visclc + visctc)/distbf
    endif

    ! Gradient boundary conditions
    !-----------------------------
    rcodcn = rcodcx*rnx+rcodcy*rny+rcodcz*rnz

    coefau(1,ifac) = (1.d0-cofimp)*(rcodcx - rcodcn*rnx) + rcodcn*rnx
    coefau(2,ifac) = (1.d0-cofimp)*(rcodcy - rcodcn*rny) + rcodcn*rny
    coefau(3,ifac) = (1.d0-cofimp)*(rcodcz - rcodcn*rnz) + rcodcn*rnz

    ! Projection in order to have the velocity parallel to the wall
    ! B = cofimp * ( IDENTITY - n x n )

    coefbu(1,1,ifac) = cofimp*(1.d0-rnx**2)
    coefbu(2,2,ifac) = cofimp*(1.d0-rny**2)
    coefbu(3,3,ifac) = cofimp*(1.d0-rnz**2)
    coefbu(1,2,ifac) = -cofimp*rnx*rny
    coefbu(1,3,ifac) = -cofimp*rnx*rnz
    coefbu(2,1,ifac) = -cofimp*rny*rnx
    coefbu(2,3,ifac) = -cofimp*rny*rnz
    coefbu(3,1,ifac) = -cofimp*rnz*rnx
    coefbu(3,2,ifac) = -cofimp*rnz*rny

    ! Flux boundary conditions
    !-------------------------

    cofafu(1,ifac)   = -hflui*(rcodcx - rcodcn*rnx) - hint*rcodcn*rnx
    cofafu(2,ifac)   = -hflui*(rcodcy - rcodcn*rny) - hint*rcodcn*rny
    cofafu(3,ifac)   = -hflui*(rcodcz - rcodcn*rnz) - hint*rcodcn*rnz

    ! Projection in order to have the shear stress parallel to the wall
    !  B = hflui*( IDENTITY - n x n )

    cofbfu(1,1,ifac) = hflui*(1.d0-rnx**2) + hint*rnx**2
    cofbfu(2,2,ifac) = hflui*(1.d0-rny**2) + hint*rny**2
    cofbfu(3,3,ifac) = hflui*(1.d0-rnz**2) + hint*rnz**2

    cofbfu(1,2,ifac) = (hint - hflui)*rnx*rny
    cofbfu(1,3,ifac) = (hint - hflui)*rnx*rnz
    cofbfu(2,1,ifac) = (hint - hflui)*rny*rnx
    cofbfu(2,3,ifac) = (hint - hflui)*rny*rnz
    cofbfu(3,1,ifac) = (hint - hflui)*rnz*rnx
    cofbfu(3,2,ifac) = (hint - hflui)*rnz*rny

    ! In case of transient turbomachinery computations, save the coefficents
    ! associated to turbulent wall velocity BC, in order to update the wall
    ! velocity after the geometry update(between prediction and correction step)
    if (iturbo.eq.2) then
      if (irotce(iel).ne.0) then
        coftur(ifac) = cofimp
        hfltur(ifac) = hflui
      endif
    endif

    !===========================================================================
    ! 4. Boundary conditions on k and epsilon
    !===========================================================================

    if (itytur.eq.2) then

      ! ==================================
      ! Launder Sharma boundary conditions
      ! ==================================
      if(iturb.eq.22) then

        ! Dirichlet Boundary Condition on k
        !----------------------------------
        if (iwallf.eq.0) then
          ! No wall functions forced by user
          pimp = 0.d0
        else
          ! Use of wall functions
          if (iuntur.eq.1) then
            pimp = uk**2/sqrcmu
          else
            pimp = 0.d0
          endif
        endif
        pimp = pimp * cfnnk
        hint = (visclc+visctc/sigmak)/distbf

        call set_dirichlet_scalar &
             !====================
           ( coefa_k(ifac), coefaf_k(ifac),             &
             coefb_k(ifac), coefbf_k(ifac),             &
             pimp         , hint          , rinfin )


        ! Dirichlet Boundary Condition on epsilon tilda
        !---------------------------------------------
        pimp_lam = 0.d0

        if (iwallf.eq.0) then
          ! No wall functions forced by user
          pimp = pimp_lam
        else
          ! Use of wall functions
          if (yplus .gt. epzero) then
            pimp_turb = 5.d0*uk**4*romc/  &
                        (xkappa*visclc*yplus)

            ! Blending function, from JF Wald PhD (2016)
            fct_bl    = exp(-0.674d-3*yplus**3.d0)
            pimp      = pimp_lam*fct_bl + pimp_turb*(1.d0-fct_bl)
            fep = exp(-((yplus+dplus)/4.d0)**1.5d0)
            dep = 1.d0- exp(-((yplus+dplus)/9.d0)**2.1d0)
            pimp      = fep*pimp_lam + (1.d0-fep)*dep*pimp_turb
          else
            pimp = pimp_lam
          endif
        endif

        hint = (visclc+visctc/sigmae)/distbf
        pimp = pimp * cfnne
        call set_dirichlet_scalar &
               !====================
           ( coefa_ep(ifac), coefaf_ep(ifac),             &
             coefb_ep(ifac), coefbf_ep(ifac),             &
             pimp         , hint          , rinfin )


      ! ===================================
      ! Quadratic Baglietto k-epsilon model
      ! ===================================
      else if(iturb.eq.23) then

        ! Dirichlet Boundary Condition on k
        !----------------------------------
        if (iwallf.eq.0) then
          ! No wall functions forces by user
          pimp = 0.d0
        else
          ! Use of wall functions
          if (iuntur.eq.1) then
            pimp = uk**2/sqrcmu
          else
            pimp = 0.d0
          endif
        endif

        hint = (visclc+visctc/sigmak)/distbf
        pimp = pimp * cfnnk
        call set_dirichlet_scalar &
             !====================
           ( coefa_k(ifac), coefaf_k(ifac),             &
             coefb_k(ifac), coefbf_k(ifac),             &
             pimp         , hint          , rinfin )

        ! Dirichlet Boundary Condition on epsilon
        !---------------------------------------
        if(iwallf.ne.0) then

          pimp_lam = 2.0d0*visclc/romc*cvar_k(iel)/distbf**2

          if (yplus.gt.epzero) then
            pimp_turb = 5.d0*uk**4*romc/        &
                        (xkappa*visclc*yplus)

            ! Blending between wall and homogeneous layer
            fep       = exp(-((yplus+dplus)/4.d0)**1.5d0)
            dep       = 1.d0- exp(-((yplus+dplus)/9.d0)**2.1d0)
            pimp      = fep*pimp_lam + (1.d0-fep)*dep*pimp_turb
          else
            pimp = pimp_lam
          end if

        else

          pimp = 2.0d0*visclc/romc*cvar_k(iel)/distbf**2
        end if
        pimp = pimp * cfnne
        call set_dirichlet_scalar &
             !====================
           ( coefa_ep(ifac), coefaf_ep(ifac),             &
             coefb_ep(ifac), coefbf_ep(ifac),             &
             pimp          , hint           , rinfin )

      ! ==============================================
      ! k-epsilon and k-epsilon LP boundary conditions
      ! ==============================================
      else

        ! Dirichlet Boundary Condition on k
        !----------------------------------

        if (iuntur.eq.1) then
          pimp = uk**2/sqrcmu
        else
          pimp = 0.d0
        endif
        hint = (visclc+visctc/sigmak)/distbf
        pimp = pimp * cfnnk
        call set_dirichlet_scalar &
             !====================
           ( coefa_k(ifac), coefaf_k(ifac),             &
             coefb_k(ifac), coefbf_k(ifac),             &
             pimp         , hint          , rinfin )


        ! Neumann Boundary Condition on epsilon
        !--------------------------------------

        hint = (visclc+visctc/sigmae)/distbf

        ! If yplus=0, uiptn is set to 0 to avoid division by 0.
        ! By the way, in this case: iuntur=0
        if (yplus.gt.epzero.and.iuntur.eq.1) then !FIXME use only iuntur
          xnuii = visclc/romc
          pimp = distbf*4.d0*uk**5/           &
              (xkappa*xnuii**2*(yplus+2.d0*dplus)**2)

          qimp = -pimp*hint !TODO transform it, it is only to be fully equivalent
        else
          qimp = 0.d0
        endif
        pimp = pimp * cfnne
        call set_neumann_scalar &
             !==================
           ( coefa_ep(ifac), coefaf_ep(ifac),             &
             coefb_ep(ifac), coefbf_ep(ifac),             &
             qimp          , hint )

      end if

    !===========================================================================
    ! 5. Boundary conditions on Rij-epsilon
    !===========================================================================

    elseif (itytur.eq.3) then

      ! Exchange coefficient

      ! Symmetric tensor diffusivity (Daly Harlow -- GGDH)
      if (iand(vcopt_rij%idften, ANISOTROPIC_RIGHT_DIFFUSION).ne.0) then

        visci(1,1) = visclc + visten(1,iel)
        visci(2,2) = visclc + visten(2,iel)
        visci(3,3) = visclc + visten(3,iel)
        visci(1,2) =          visten(4,iel)
        visci(2,1) =          visten(4,iel)
        visci(2,3) =          visten(5,iel)
        visci(3,2) =          visten(5,iel)
        visci(1,3) =          visten(6,iel)
        visci(3,1) =          visten(6,iel)

        ! ||Ki.S||^2
        viscis = ( visci(1,1)*surfbo(1,ifac)       &
                 + visci(1,2)*surfbo(2,ifac)       &
                 + visci(1,3)*surfbo(3,ifac))**2   &
               + ( visci(2,1)*surfbo(1,ifac)       &
                 + visci(2,2)*surfbo(2,ifac)       &
                 + visci(2,3)*surfbo(3,ifac))**2   &
               + ( visci(3,1)*surfbo(1,ifac)       &
                 + visci(3,2)*surfbo(2,ifac)       &
                 + visci(3,3)*surfbo(3,ifac))**2

        ! IF.Ki.S
        fikis = ( (cdgfbo(1,ifac)-xyzcen(1,iel))*visci(1,1)   &
                + (cdgfbo(2,ifac)-xyzcen(2,iel))*visci(2,1)   &
                + (cdgfbo(3,ifac)-xyzcen(3,iel))*visci(3,1)   &
                )*surfbo(1,ifac)                              &
              + ( (cdgfbo(1,ifac)-xyzcen(1,iel))*visci(1,2)   &
                + (cdgfbo(2,ifac)-xyzcen(2,iel))*visci(2,2)   &
                + (cdgfbo(3,ifac)-xyzcen(3,iel))*visci(3,2)   &
                )*surfbo(2,ifac)                              &
              + ( (cdgfbo(1,ifac)-xyzcen(1,iel))*visci(1,3)   &
                + (cdgfbo(2,ifac)-xyzcen(2,iel))*visci(2,3)   &
                + (cdgfbo(3,ifac)-xyzcen(3,iel))*visci(3,3)   &
                )*surfbo(3,ifac)

        distfi = distb(ifac)

        ! Take I" so that I"F= eps*||FI||*Ki.n when J" is in cell rji
        ! NB: eps =1.d-1 must be consistent with vitens.f90
        fikis = max(fikis, 1.d-1*sqrt(viscis)*distfi)

        hint = viscis/surfbn(ifac)/fikis

      ! Scalar diffusivity
      else
        hint = (visclc+visctc*csrij/cmu)/distbf
      endif

      ! ---> Tensor Rij (Partially or totally implicited)

      do isou = 1, 6
        fcoefa(isou) = 0.0d0
        fcoefb(isou) = 0.0d0
        fcofad(isou) = 0.0d0
        fcofbd(isou) = 0.0d0
      enddo

      ! blending factor so that the component R(n,tau) have only
      ! -mu_T/(mu+mu_T)*uet*uk
      bldr12 = visctc/(visclc + visctc)

      do isou = 1, 6

        if (isou.eq.1) then
          jj = 1
          kk = 1
        else if (isou.eq.2) then
          jj = 2
          kk = 2
        else if (isou.eq.3) then
          jj = 3
          kk = 3
        else if (isou.eq.4) then
          jj = 1
          kk = 2
        else if (isou.eq.5) then
          jj = 2
          kk = 3
        else if (isou.eq.6) then
          jj = 1
          kk = 3
        endif

        ! LRR and the Standard SGG or EB-RSM + wall functions
        if (((iturb.eq.30).or.(iturb.eq.31).and.iuntur.eq.1).or. &
             (iturb.eq.32.and.iwallf.ne.0.and.yplus.gt.epzero)) then

          if (irijco.eq.1) then
            coefa_rij(isou, ifac) = - (  eloglo(jj,1)*eloglo(kk,2)         &
                                       + eloglo(jj,2)*eloglo(kk,1))        &
                                      * alpha_rnn * sqrt(rnnb * rttb)*cfnnk
            coefaf_rij(isou, ifac)      = -hint * coefa_rij(isou, ifac)
            coefad_rij(isou, ifac)      = 0.d0
            do ii = 1, 6
              coefb_rij(isou,ii, ifac)  = alpha(ii, isou)
              if (ii.eq.isou) then
                coefbf_rij(isou,ii, ifac) = hint * (1.d0 - coefb_rij(isou,ii, ifac))
              else
                coefbf_rij(isou,ii, ifac) = - hint * coefb_rij(isou,ii, ifac)
              endif
              coefbd_rij(isou,ii, ifac) = coefb_rij(isou,ii, ifac)
            enddo

          else if ((iclptr.eq.1)) then

            do ii = 1, 6
              if (ii.ne.isou) then
                fcoefa(isou) = fcoefa(isou) + alpha(isou,ii) * rijipb(ifac,ii)
              endif
            enddo
            fcoefb(isou) = alpha(isou,isou)
          else
            do ii = 1, 6
              fcoefa(isou) = fcoefa(isou) + alpha(isou,ii) * rijipb(ifac,ii)
            enddo
            fcoefb(isou) = 0.d0
          endif

          ! Boundary conditions for the momentum equation
          fcofad(isou) = fcoefa(isou)
          fcofbd(isou) = fcoefb(isou)

          fcoefa(isou) = fcoefa(isou)                                   &
                         - (  eloglo(jj,1)*eloglo(kk,2)                 &
                            + eloglo(jj,2)*eloglo(kk,1))*bldr12*uet*uk*cfnnk

        ! In the viscous sublayer or for EBRSM: zero Reynolds' stresses
        else
          if (irijco.eq.1) then
            coefa_rij(isou, ifac) = 0.d0
            coefaf_rij(isou, ifac) = 0.d0
            coefad_rij(isou, ifac) = 0.d0
            do ii = 1, 6
              coefb_rij(isou,ii, ifac)  = 0.d0
              if (ii.eq.isou) then
                coefbf_rij(isou,ii, ifac) = hint
              else
                coefbf_rij(isou,ii, ifac) = 0.d0
              endif
              coefbd_rij(isou,ii, ifac) = 0.d0
            enddo

          else

            fcoefa(isou) = 0.d0
            fcofad(isou) = 0.d0
            fcoefb(isou) = 0.d0
            fcofbd(isou) = 0.d0
          endif

        endif

        ! Translate into Diffusive flux BCs
        fcofaf(isou) = -hint*fcoefa(isou)
        fcofbf(isou) = hint*(1.d0-fcoefb(isou))
      enddo

      if (irijco.ne.1) then
        do isou = 1, 6
          if (isou.eq.1) then
            coefa_r11(ifac) = fcoefa(isou)
            coefb_r11(ifac) = fcoefb(isou)
            coefaf_r11(ifac) = fcofaf(isou)
            coefbf_r11(ifac) = fcofbf(isou)
            coefad_r11(ifac) = fcofad(isou)
            coefbd_r11(ifac) = fcofbd(isou)
          else if (isou.eq.2) then
            coefa_r22(ifac) = fcoefa(isou)
            coefb_r22(ifac) = fcoefb(isou)
            coefaf_r22(ifac) = fcofaf(isou)
            coefbf_r22(ifac) = fcofbf(isou)
            coefad_r22(ifac) = fcofad(isou)
            coefbd_r22(ifac) = fcofbd(isou)
          else if (isou.eq.3) then
            coefa_r33(ifac) = fcoefa(isou)
            coefb_r33(ifac) = fcoefb(isou)
            coefaf_r33(ifac) = fcofaf(isou)
            coefbf_r33(ifac) = fcofbf(isou)
            coefad_r33(ifac) = fcofad(isou)
            coefbd_r33(ifac) = fcofbd(isou)
          else if (isou.eq.4) then
            coefa_r12(ifac) = fcoefa(isou)
            coefb_r12(ifac) = fcoefb(isou)
            coefaf_r12(ifac) = fcofaf(isou)
            coefbf_r12(ifac) = fcofbf(isou)
            coefad_r12(ifac) = fcofad(isou)
            coefbd_r12(ifac) = fcofbd(isou)
          else if (isou.eq.5) then
            coefa_r23(ifac) = fcoefa(isou)
            coefb_r23(ifac) = fcoefb(isou)
            coefaf_r23(ifac) = fcofaf(isou)
            coefbf_r23(ifac) = fcofbf(isou)
            coefad_r23(ifac) = fcofad(isou)
            coefbd_r23(ifac) = fcofbd(isou)
          else if (isou.eq.6) then
            coefa_r13(ifac) = fcoefa(isou)
            coefb_r13(ifac) = fcoefb(isou)
            coefaf_r13(ifac) = fcofaf(isou)
            coefbf_r13(ifac) = fcofbf(isou)
            coefad_r13(ifac) = fcofad(isou)
            coefbd_r13(ifac) = fcofbd(isou)
          endif
        enddo
      endif

      ! ---> Epsilon
      !      NB: no reconstruction, possibility of partial implicitation

      ! Symmetric tensor diffusivity (Daly Harlow -- GGDH)
      if (iand(vcopt_ep%idften, ANISOTROPIC_DIFFUSION).ne.0) then

        visci(1,1) = visclc + visten(1,iel)/sigmae
        visci(2,2) = visclc + visten(2,iel)/sigmae
        visci(3,3) = visclc + visten(3,iel)/sigmae
        visci(1,2) =          visten(4,iel)/sigmae
        visci(2,1) =          visten(4,iel)/sigmae
        visci(2,3) =          visten(5,iel)/sigmae
        visci(3,2) =          visten(5,iel)/sigmae
        visci(1,3) =          visten(6,iel)/sigmae
        visci(3,1) =          visten(6,iel)/sigmae

        ! ||Ki.S||^2
        viscis = ( visci(1,1)*surfbo(1,ifac)       &
                 + visci(1,2)*surfbo(2,ifac)       &
                 + visci(1,3)*surfbo(3,ifac))**2   &
               + ( visci(2,1)*surfbo(1,ifac)       &
                 + visci(2,2)*surfbo(2,ifac)       &
                 + visci(2,3)*surfbo(3,ifac))**2   &
               + ( visci(3,1)*surfbo(1,ifac)       &
                 + visci(3,2)*surfbo(2,ifac)       &
                 + visci(3,3)*surfbo(3,ifac))**2

        ! IF.Ki.S
        fikis = ( (cdgfbo(1,ifac)-xyzcen(1,iel))*visci(1,1)   &
                + (cdgfbo(2,ifac)-xyzcen(2,iel))*visci(2,1)   &
                + (cdgfbo(3,ifac)-xyzcen(3,iel))*visci(3,1)   &
                )*surfbo(1,ifac)                              &
              + ( (cdgfbo(1,ifac)-xyzcen(1,iel))*visci(1,2)   &
                + (cdgfbo(2,ifac)-xyzcen(2,iel))*visci(2,2)   &
                + (cdgfbo(3,ifac)-xyzcen(3,iel))*visci(3,2)   &
                )*surfbo(2,ifac)                              &
              + ( (cdgfbo(1,ifac)-xyzcen(1,iel))*visci(1,3)   &
                + (cdgfbo(2,ifac)-xyzcen(2,iel))*visci(2,3)   &
                + (cdgfbo(3,ifac)-xyzcen(3,iel))*visci(3,3)   &
                )*surfbo(3,ifac)

        distfi = distb(ifac)

        ! Take I" so that I"F= eps*||FI||*Ki.n when J" is in cell rji
        ! NB: eps =1.d-1 must be consistent with vitens.f90
        fikis = max(fikis, 1.d-1*sqrt(viscis)*distfi)

        hint = viscis/surfbn(ifac)/fikis

      ! Scalar diffusivity
      else
        hint = (visclc+visctc/sigmae)/distbf
      endif

      if ((iturb.eq.30).or.(iturb.eq.31)) then

        ! Si yplus=0, on met coefa a 0 directement pour eviter une division
        ! par 0.
        if (yplus.gt.epzero.and.iuntur.eq.1) then
          xnuii = visclc/romc
          pimp = distbf*4.d0*uk**5/           &
                (xkappa*xnuii**2*(yplus+2.d0*dplus)**2)
        else
          pimp = 0.d0
        endif

        ! Neumann Boundary Condition
        !---------------------------

        if (iclptr.eq.1) then !TODO not available for k-eps

          qimp = -pimp*hint !TODO transform it, it is only to be fully equivalent
          pimp = pimp * cfnne
           call set_neumann_scalar &
           !==================
         ( coefa_ep(ifac), coefaf_ep(ifac),             &
           coefb_ep(ifac), coefbf_ep(ifac),             &
           qimp          , hint )

        ! Dirichlet Boundary Condition
        !-----------------------------

        else

          pimp = pimp + cvar_ep(iel)
          pimp = pimp * cfnne
          call set_dirichlet_scalar &
               !====================
             ( coefa_ep(ifac), coefaf_ep(ifac),             &
               coefb_ep(ifac), coefbf_ep(ifac),             &
               pimp          , hint           , rinfin )

        endif

      elseif (iturb.eq.32) then

        if(iwallf.ne.0) then
          ! Use k at I'
          xkip = 0.5d0*(rijipb(ifac,1)+rijipb(ifac,2)+rijipb(ifac,3))

          pimp_lam = 2.d0*visclc*xkip/(distbf**2*romc)

          if (yplus.gt.epzero) then
            pimp_turb = 5.d0*uk**4*romc/        &
                        (xkappa*visclc*(yplus+2.d0*dplus))

            ! Blending between wall and homogeneous layer
            ! from JF Wald PhD (2016)
            fep       = exp(-((yplus+dplus)/4.d0)**1.5d0)
            dep       = 1.d0- exp(-((yplus+dplus)/9.d0)**2.1d0)
            pimp      = fep*pimp_lam + (1.d0-fep)*dep*pimp_turb
          else
            pimp = pimp_lam
          end if

        else
          ! Use k at I'
          xkip = 0.5d0*(rijipb(ifac,1)+rijipb(ifac,2)+rijipb(ifac,3))
          pimp = 2.d0*visclc*xkip/(distbf**2*romc)
        end if
        pimp = pimp * cfnne
        call set_dirichlet_scalar &
             !====================
           ( coefa_ep(ifac), coefaf_ep(ifac),             &
             coefb_ep(ifac), coefbf_ep(ifac),             &
             pimp          , hint           , rinfin )

        ! ---> Alpha

        ! Dirichlet Boundary Condition
        !-----------------------------
        if(iwallf.ne.0) then

          if(yplus.gt.epzero) then
            ypsd  = (yplus+dplus)/2.d0
            falpg = 16.d0 /(16.d0+4.d-2*ypsd)**2 * exp(- ypsd / (16.d0 + 4.d-2*ypsd) )
            falpv = 1.d0 - exp(- (yplus+dplus) / (16.d0 + 4.d-2*(yplus+dplus)) )
            pimp  = falpv - (yplus+dplus)*falpg
          else
            pimp = 0.d0
          end if
        else
          pimp = 0.d0
        end if

        hint = 1.d0/distbf
        pimp = pimp * cfnne
        call set_dirichlet_scalar &
             !====================
           ( coefa_al(ifac), coefaf_al(ifac),             &
             coefb_al(ifac), coefbf_al(ifac),             &
             pimp          , hint           , rinfin )

      endif

    !===========================================================================
    ! 6a.Boundary conditions on k, epsilon, f_bar and phi in the phi_Fbar model
    !===========================================================================

    elseif (iturb.eq.50) then

      ! Dirichlet Boundary Condition on k
      !----------------------------------

      pimp = 0.d0
      hint = (visclc+visctc/sigmak)/distbf

      call set_dirichlet_scalar &
           !====================
         ( coefa_k(ifac), coefaf_k(ifac),             &
           coefb_k(ifac), coefbf_k(ifac),             &
           pimp         , hint          , rinfin )

      ! Dirichlet Boundary Condition on epsilon
      !----------------------------------------

      pimp = 2.0d0*visclc/romc*cvar_k(iel)/distbf**2
      hint = (visclc+visctc/sigmae)/distbf

      call set_dirichlet_scalar &
           !====================
         ( coefa_ep(ifac), coefaf_ep(ifac),             &
           coefb_ep(ifac), coefbf_ep(ifac),             &
           pimp          , hint          , rinfin )

      ! Dirichlet Boundary Condition on Phi
      !------------------------------------

      pimp = 0.d0
      hint = (visclc+visctc/sigmak)/distbf

      call set_dirichlet_scalar &
           !====================
         ( coefa_phi(ifac), coefaf_phi(ifac),             &
           coefb_phi(ifac), coefbf_phi(ifac),             &
           pimp           , hint          , rinfin )

      ! Dirichlet Boundary Condition on Fb
      !-----------------------------------

      pimp = 0.d0
      hint = 1.d0/distbf

      call set_dirichlet_scalar &
           !====================
         ( coefa_fb(ifac), coefaf_fb(ifac),             &
           coefb_fb(ifac), coefbf_fb(ifac),             &
           pimp          , hint           , rinfin )

    !===========================================================================
    ! 6b.Boundary conditions on k, epsilon, phi and alpha in the Bl-v2/k model
    !===========================================================================

    elseif (iturb.eq.51) then

      ! Dirichlet Boundary Condition on k
      !----------------------------------

      pimp = 0.d0
      hint = (visclc+visctc/sigmak)/distbf

      call set_dirichlet_scalar &
           !====================
         ( coefa_k(ifac), coefaf_k(ifac),             &
           coefb_k(ifac), coefbf_k(ifac),             &
           pimp         , hint          , rinfin )

      ! Dirichlet Boundary Condition on epsilon
      !----------------------------------------

      pimp = visclc/romc*cvar_k(iel)/distbf**2
      hint = (visclc+visctc/sigmae)/distbf

      call set_dirichlet_scalar &
           !====================
         ( coefa_ep(ifac), coefaf_ep(ifac),             &
           coefb_ep(ifac), coefbf_ep(ifac),             &
           pimp          , hint           , rinfin )

      ! Dirichlet Boundary Condition on Phi
      !------------------------------------

      pimp = 0.d0
      hint = (visclc+visctc/sigmak)/distbf

      call set_dirichlet_scalar &
           !====================
         ( coefa_phi(ifac), coefaf_phi(ifac),             &
           coefb_phi(ifac), coefbf_phi(ifac),             &
           pimp           , hint            , rinfin )

      ! Dirichlet Boundary Condition on alpha
      !--------------------------------------

      pimp = 0.d0
      hint = 1.d0/distbf

      call set_dirichlet_scalar &
           !====================
         ( coefa_al(ifac), coefaf_al(ifac),             &
           coefb_al(ifac), coefbf_al(ifac),             &
           pimp          , hint           , rinfin )


    !===========================================================================
    ! 7. Boundary conditions on k and omega
    !===========================================================================

    elseif (iturb.eq.60) then

      ! Dirichlet Boundary Condition on k
      !----------------------------------

      ! Si on est hors de la sous-couche visqueuse (reellement ou via les
      ! scalable wall functions)
      if (iuntur.eq.1) then
        pimp = uk**2/sqrcmu

      ! Si on est en sous-couche visqueuse
      else
        pimp = 0.d0
      endif

      !FIXME it is wrong because sigma is computed within the model
      ! see turbkw.f90
      hint = (visclc+visctc/ckwsk2)/distbf

      call set_dirichlet_scalar &
           !====================
         ( coefa_k(ifac), coefaf_k(ifac),             &
           coefb_k(ifac), coefbf_k(ifac),             &
           pimp         , hint          , rinfin )

      ! Dirichlet Boundary Condition on omega
      !--------------------------------------

      !FIXME it is wrong because sigma is computed within the model
      ! see turbkw.f90 (So the flux is not the one we impose!)
      hint = (visclc+visctc/ckwsw2)/distbf

      if (ikwcln.eq.1) then
        ! In viscous sub layer
        pimp_lam  = 60.d0*visclc/(romc*ckwbt1*distbf**2)

        ! If we are outside the viscous sub-layer (either naturally, or
        ! artificialy using scalable wall functions)

        if (yplus.gt.epzero) then
          pimp_turb = 5.d0*uk**2*romc/           &
                     (sqrcmu*xkappa*visclc*(yplus+2.d0*dplus))

          ! Use gamma function of Kader to weight
          !between high and low Reynolds meshes

          gammap = -0.01d0*(yplus+2.d0*dplus)**4.d0/(1.d0+5.d0*(yplus+2.d0*dplus))

          pimp = pimp_lam*exp(gammap) + exp(1.d0/gammap)*pimp_turb
        else
          pimp = pimp_lam
        endif

        call set_dirichlet_scalar &
             !====================
           ( coefa_omg(ifac), coefaf_omg(ifac),             &
             coefb_omg(ifac), coefbf_omg(ifac),             &
             pimp         , hint          , rinfin )


      ! If ikwcln is equal to 0, switch to deprecated Neumann
      ! condition on omega.
      else
        ! In viscous sub layer
        pimp_lam  = 120.d0*8.d0*visclc/(romc*ckwbt1*distbf**2)

        ! If we are outside the viscous sub-layer (either naturally, or
        ! artificialy using scalable wall functions)

        if (yplus.gt.epzero) then
          pimp_turb = distbf*4.d0*uk**3*romc**2/           &
                     (sqrcmu*xkappa*visclc**2*(yplus+2.d0*dplus)**2)

          ! Use gamma function of Kader to weight
          !between high and low Reynolds meshes

          gammap    = -0.01d0*(yplus+2.d0*dplus)**4.d0 &
            / (1.d0+5.d0*(yplus+2.d0*dplus))

          pimp      = pimp_lam*exp(gammap) + exp(1.d0/gammap)*pimp_turb
        else
          pimp      = pimp_lam
        endif

        qimp      = -pimp*hint !TODO transform it, it is only to be fully equivalent

        call set_neumann_scalar &
             !==================
           ( coefa_omg(ifac), coefaf_omg(ifac),             &
             coefb_omg(ifac), coefbf_omg(ifac),             &
             qimp           , hint )
      end if

    !===========================================================================
    ! 7.1 Boundary conditions on the Spalart Allmaras turbulence model
    !===========================================================================

    elseif (iturb.eq.70) then

      ! Dirichlet Boundary Condition on nusa
      !-------------------------------------

      pimp = 0.d0

      hint = visclc / distbf / csasig ! Note: nusa is zero at the wall

      call set_dirichlet_scalar &
           !====================
         ( coefa_nu(ifac), coefaf_nu(ifac),             &
           coefb_nu(ifac), coefbf_nu(ifac),             &
           pimp          , hint           , rinfin )

    endif

    byplus(ifac) = yplus
    bdplus(ifac) = dplus
    buk(ifac) = uk
    ustar(ifac) = uet
    bcfnns(ifac) = 1.d0 ! FIXME note taken into account yet in hturbp cfnns

  endif
  ! Test on the presence of a smooth wall (End)

enddo
! --- End of loop over faces


!===========================================================================
! 8. Boundary conditions on the other scalars
!    (Specific treatment for the variances of the scalars next to walls:
!     see condli)
!===========================================================================

do iscal = 1, nscal

  if (iscavr(iscal).le.0) then

    f_id = ivarfl(isca(iscal))

    call field_get_dim(f_id, f_dim)

    if (f_dim.eq.1) then

      call clptur_scalar(iscal  , isvhb , icodcl  , rcodcl  ,       &
                         byplus , bdplus, buk     , bcfnns  ,       &
                         hbord  , theipb          ,                 &
                         tetmax , tetmin, tplumx  , tplumn  )

    ! Vector field
    else

      call clptur_vector(iscal, isvhb, icodcl, rcodcl,              &
                         byplus, bdplus, buk)

    endif

  endif

enddo

if (irangp.ge.0) then
  call parmin (uiptmn)
  call parmax (uiptmx)
  call parmin (uetmin)
  call parmax (uetmax)
  call parmin (ukmin)
  call parmax (ukmax)
  call parmin (yplumn)
  call parmax (yplumx)
  call parcpt (nlogla)
  call parcpt (nsubla)
  call parcpt (iuiptn)
  if (iscalt.gt.0) then
    call parmin (tetmin)
    call parmax (tetmax)
    call parmin (tplumn)
    call parmax (tplumx)
  endif
endif

if (allocated(buet)) deallocate(buet)
if (allocated(bcfnns_loc)) deallocate(bcfnns_loc)

!===============================================================================
! 9. Writings
!===============================================================================

!     Remarque : afin de ne pas surcharger les logs dans le cas ou
!       quelques yplus ne sont pas corrects, on ne produit le message
!       qu'aux deux premiers pas de temps ou le message apparait et
!       aux deux derniers pas de temps du calcul, ou si IWARNI est >= 2
!       On indique aussi le numero du dernier pas de temps auquel on
!       a rencontre des yplus hors bornes admissibles

call field_get_key_struct_var_cal_opt(ivarfl(iu), vcopt_u)

if (vcopt_u%iwarni.ge.0) then
  if (ntlist.gt.0) then
    modntl = mod(ntcabs,ntlist)
  elseif (ntlist.eq.-1.and.ntcabs.eq.ntmabs) then
    modntl = 0
  else
    modntl = 1
  endif

  if ( (iturb.eq.0.and.nlogla.ne.0)                      .or.     &
       (itytur.eq.5.and.nlogla.ne.0)                     .or.     &
       ((itytur.eq.2.or.itytur.eq.3) .and. nsubla.gt.0)      )    &
       ntlast = ntcabs

  if ( (ntlast.eq.ntcabs.and.iaff.lt.2         ) .or.             &
       (ntlast.ge.0     .and.ntcabs.ge.ntmabs-1) .or.             &
       (ntlast.eq.ntcabs.and.vcopt_u%iwarni.ge.2) ) then
    iaff = iaff + 1

    if (iscalt.gt.0) then
      write(nfecra,2011) &
           uiptmn,uiptmx,uetmin,uetmax,ukmin,ukmax,yplumn,yplumx,      &
           tetmin, tetmax, tplumn, tplumx, iuiptn,nsubla,nsubla+nlogla
    else
      write(nfecra,2010) &
           uiptmn,uiptmx,uetmin,uetmax,ukmin,ukmax,yplumn,yplumx,   &
           iuiptn,nsubla,nsubla+nlogla
    endif

    if (iturb.eq. 0) write(nfecra,2020)  ntlast,ypluli
    if (itytur.eq.5) write(nfecra,2030)  ntlast,ypluli
    ! No warnings in EBRSM
    if ((itytur.eq.2.and.iturb.ne.22).or.iturb.eq.30.or.iturb.eq.31)   &
      write(nfecra,2040)  ntlast,ypluli
    if (vcopt_u%iwarni.lt.2.and.(iturb.ne.32.and.iturb.ne.22)) then
      write(nfecra,2050)
    elseif (iturb.ne.32.and.iturb.ne.22) then
      write(nfecra,2060)
    endif

  else if (modntl.eq.0 .or. vcopt_u%iwarni.ge.2) then

    if (iscalt.gt.0) then
      write(nfecra,2011) &
           uiptmn,uiptmx,uetmin,uetmax,ukmin,ukmax,yplumn,yplumx,      &
           tetmin, tetmax, tplumn, tplumx, iuiptn,nsubla,nsubla+nlogla
    else
      write(nfecra,2010) &
           uiptmn,uiptmx,uetmin,uetmax,ukmin,ukmax,yplumn,yplumx,   &
           iuiptn,nsubla,nsubla+nlogla
    endif
  endif

endif

!===============================================================================
! 10. Formats
!===============================================================================

 2010 format(/,                                                   &
 3X,'** BOUNDARY CONDITIONS FOR SMOOTH WALLS',/,                  &
 '   ---------------------------------------',/,                  &
 '------------------------------------------------------------',/,&
 '                                         Minimum     Maximum',/,&
 '------------------------------------------------------------',/,&
 '   Rel velocity at the wall uiptn : ',2E12.5                 ,/,&
 '   Friction velocity        uet   : ',2E12.5                 ,/,&
 '   Friction velocity        uk    : ',2E12.5                 ,/,&
 '   Dimensionless distance   yplus : ',2E12.5                 ,/,&
 '   ------------------------------------------------------'   ,/,&
 '   Nb of reversal of the velocity at the wall   : ',I10      ,/,&
 '   Nb of faces within the viscous sub-layer     : ',I10      ,/,&
 '   Total number of wall faces                   : ',I10      ,/,&
 '------------------------------------------------------------',  &
 /,/)

 2011 format(/,                                                   &
 3X,'** BOUNDARY CONDITIONS FOR SMOOTH WALLS',/,                  &
 '   ---------------------------------------',/,                  &
 '------------------------------------------------------------',/,&
 '                                         Minimum     Maximum',/,&
 '------------------------------------------------------------',/,&
 '   Rel velocity at the wall uiptn : ',2E12.5                 ,/,&
 '   Friction velocity        uet   : ',2E12.5                 ,/,&
 '   Friction velocity        uk    : ',2E12.5                 ,/,&
 '   Dimensionless distance   yplus : ',2E12.5                 ,/,&
 '   Friction thermal sca.    tstar : ',2E12.5                 ,/,&
 '   Dim-less thermal sca.    tplus : ',2E12.5                 ,/,&
 '   ------------------------------------------------------'   ,/,&
 '   Nb of reversal of the velocity at the wall   : ',I10      ,/,&
 '   Nb of faces within the viscous sub-layer     : ',I10      ,/,&
 '   Total number of wall faces                   : ',I10      ,/,&
 '------------------------------------------------------------',  &
 /,/)

 2020 format(                                                     &
'@                                                            ',/,&
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@',/,&
'@                                                            ',/,&
'@ @@ WARNING: MESH NOT ENOUGH REFINED AT THE WALL            ',/,&
'@    ========                                                ',/,&
'@    The mesh does not seem to be enough refined at the wall ',/,&
'@      to be able to run a laminar simulation.               ',/,&
'@                                                            ',/,&
'@    The last time step at which too large values for the    ',/,&
'@      dimensionless distance to the wall (yplus) have been  ',/,&
'@      observed is the time step ',I10                        ,/,&
'@                                                            ',/,&
'@    The minimum value for yplus must be lower than the      ',/,&
'@      limit value YPLULI = ',E14.5                           ,/,&
'@                                                            ',/,&
'@    Have a look at the distribution of yplus at the wall    ',/,&
'@      (with EnSight or ParaView for example) to conclude on ',/,&
'@      the way the results quality might be affected.        ')

 2030 format(                                                     &
'@                                                            ',/,&
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@',/,&
'@                                                            ',/,&
'@ @@ WARNING: MESH NOT ENOUGH REFINED AT THE WALL            ',/,&
'@    ========                                                ',/,&
'@    The mesh does not seem to be enough refined at the wall ',/,&
'@      to be able to run a v2f simulation                    ',/,&
'@      (phi-fbar or BL-v2/k)                                 ',/,&
'@                                                            ',/,&
'@    The last time step at which too large values for the    ',/,&
'@      dimensionless distance to the wall (yplus) have been  ',/,&
'@      observed is the time step ',I10                        ,/,&
'@                                                            ',/,&
'@    The minimum value for yplus must be lower than the      ',/,&
'@      limit value YPLULI = ',E14.5                           ,/,&
'@                                                            ',/,&
'@    Have a look at the distribution of yplus at the wall    ',/,&
'@      (with EnSight or ParaView for example) to conclude on ',/,&
'@      the way the results quality might be affected.        ')

 2040 format(                                                     &
'@                                                            ',/,&
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@',/,&
'@                                                            ',/,&
'@ @@ WARNING: MESH TOO REFINED AT THE WALL                   ',/,&
'@    ========                                                ',/,&
'@    The mesh seems to be too refined at the wall to use     ',/,&
'@      a high-Reynolds turbulence model.                     ',/,&
'@                                                            ',/,&
'@    The last time step at which too small values for the    ',/,&
'@      dimensionless distance to the wall (yplus) have been  ',/,&
'@      observed is the time step ',I10                        ,/,&
'@                                                            ',/,&
'@    The minimum value for yplus must be greater than the    ',/,&
'@      limit value YPLULI = ',E14.5                           ,/,&
'@                                                            ',/,&
'@    Have a look at the distribution of yplus at the wall    ',/,&
'@      (with EnSight or ParaView for example) to conclude on ',/,&
'@      the way the results quality might be affected.        ')
 2050 format(                                                     &
'@                                                            ',/,&
'@    This warning is only printed at the first two           ',/,&
'@      occurences of the problem and at the last time step   ',/,&
'@      of the calculation. The vanishing of the message does ',/,&
'@      not necessarily mean the vanishing of the problem.    ',/,&
'@                                                            ',/,&
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@',/,&
'@                                                            ',/)
 2060 format(                                                           &
'@                                                            ',/,&
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@',/,&
'@                                                            ',/)

!----
! End
!----

return
end subroutine

!===============================================================================
! Local functions
!===============================================================================

!-------------------------------------------------------------------------------
! Arguments
!______________________________________________________________________________.
!  mode           name          role                                           !
!______________________________________________________________________________!
!> \param[in]     iscal         scalar id
!> \param[in]     isvhb         indicator to save exchange coeffient
!> \param[in,out] icodcl        face boundary condition code:
!>                               - 1 Dirichlet
!>                               - 3 Neumann
!>                               - 4 sliding and
!>                                 \f$ \vect{u} \cdot \vect{n} = 0 \f$
!>                               - 5 smooth wall and
!>                                 \f$ \vect{u} \cdot \vect{n} = 0 \f$
!>                               - 6 rough wall and
!>                                 \f$ \vect{u} \cdot \vect{n} = 0 \f$
!>                               - 9 free inlet/outlet
!>                                 (input mass flux blocked to 0)
!> \param[in,out] rcodcl        boundary condition values:
!>                               - rcodcl(1) value of the dirichlet
!>                               - rcodcl(2) value of the exterior exchange
!>                                 coefficient (infinite if no exchange)
!>                               - rcodcl(3) value flux density
!>                                 (negative if gain) in w/m2
!>                                 -# for the velocity \f$ (\mu+\mu_T)
!>                                    \gradv \vect{u} \cdot \vect{n}  \f$
!>                                 -# for the pressure \f$ \Delta t
!>                                    \grad P \cdot \vect{n}  \f$
!>                                 -# for a scalar \f$ cp \left( K +
!>                                     \dfrac{K_T}{\sigma_T} \right)
!>                                     \grad T \cdot \vect{n} \f$
!> \param[in]     byplus        dimensionless distance to the wall
!> \param[in]     bdplus        dimensionless shift to the wall
!>                               for scalable wall functions
!> \param[in]     buk           dimensionless velocity
!> \param[in,out] hbord         exchange coefficient at boundary
!> \param[in]     theipb        value of thermal scalar at \f$ \centip \f$
!>                               of boundary cells
!> \param[out]    tetmax        maximum local ustar value
!> \param[out]    tetmin        minimum local ustar value
!> \param[out]    tplumx        maximum local tplus value
!> \param[out]    tplumn        minimum local tplus value
!_______________________________________________________________________________

subroutine clptur_scalar &
 ( iscal  , isvhb  , icodcl , rcodcl  ,                           &
   byplus , bdplus , buk    , bcfnns  ,                           &
   hbord  , theipb ,                                              &
   tetmax , tetmin , tplumx , tplumn )

!===============================================================================
! Module files
!===============================================================================

use paramx
use numvar
use optcal
use cstphy
use cstnum
use pointe
use entsor
use albase
use parall
use ppppar
use ppthch
use ppincl
use radiat
use cplsat
use mesh
use field
use lagran
use turbomachinery
use cs_c_bindings

!===============================================================================

implicit none

! Arguments

integer          iscal, isvhb
integer, pointer, dimension(:,:) :: icodcl

double precision, pointer, dimension(:,:,:) :: rcodcl
double precision, dimension(:) :: byplus, bdplus, buk, bcfnns
double precision, pointer, dimension(:) :: hbord, theipb
double precision tetmax, tetmin, tplumx, tplumn

! Local variables

integer          ivar, f_id, b_f_id, isvhbl
integer          f_id_ut, f_id_al
integer          ifac, iel, isou, jsou
integer          iscacp, ifcvsl, itplus, itstar
integer          f_id_rough
integer          kturt, turb_flux_model, turb_flux_model_type

double precision cpp, rkl, prdtl, visclc, romc, tplus, cofimp, cpscv
double precision distfi, distbf, fikis, hint_al, heq, hflui, hext
double precision yplus, dplus, phit, pimp, pimp_al, rcprod, temp, tet, uk
double precision viscis, visctc, xmutlm, ypth, xnuii
double precision rinfiv(3), pimpv(3)
double precision visci(3,3), hintt(6)
double precision turb_schmidt, exchange_coef, visls_0
double precision mut_lm_dmut
double precision rough_t

character(len=80) :: fname

double precision, dimension(:), pointer :: val_s, bval_s, crom, viscls
double precision, dimension(:), pointer :: viscl, visct, cpro_cp, cpro_cv

double precision, dimension(:), pointer :: bpro_rough_t
double precision, dimension(:), pointer :: bfconv, bhconv
double precision, dimension(:), pointer :: tplusp, tstarp, dist_theipb
double precision, dimension(:), pointer :: coefap, coefbp, cofafp, cofbfp, hextp
double precision, dimension(:), pointer :: a_al, b_al, af_al, bf_al
double precision, dimension(:,:), pointer :: coefaut, cofafut, cofarut, visten
double precision, dimension(:,:,:), pointer :: coefbut, cofbfut, cofbrut

double precision, allocatable, dimension(:) :: hbnd, hint, yptp

integer, save :: kbfid = -1

type(var_cal_opt) :: vcopt

logical(c_bool), dimension(:), pointer ::  cpl_faces

!===============================================================================

ivar = isca(iscal)
f_id = ivarfl(ivar)

call field_get_val_s(ivarfl(ivar), val_s)

call field_get_val_s(iviscl, viscl)
call field_get_val_s(ivisct, visct)

call field_get_key_int (f_id, kivisl, ifcvsl)

if (ifcvsl .ge. 0) then
  call field_get_val_s(ifcvsl, viscls)
endif

call field_get_key_struct_var_cal_opt(ivarfl(ivar), vcopt)

! If we have no diffusion, no boundary face should have a wall BC type
! (this is ensured in typecl)

if (vcopt%idiff .eq. 0) then
  tetmax = 0.d0
  tetmin = 0.d0
  tplumx = 0.d0
  tplumn = 0.d0
  return
endif

! Get the turbulent flux model for the scalar
call field_get_key_id('turbulent_flux_model', kturt)
call field_get_key_int(ivarfl(isca(iscal)), kturt, turb_flux_model)
turb_flux_model_type = turb_flux_model / 10

if (    iand(vcopt%idften, ANISOTROPIC_DIFFUSION).ne.0             &
    .or.turb_flux_model_type.eq.3) then
  if (iturb.ne.32.or.turb_flux_model_type.eq.3) then
    call field_get_val_v(ivsten, visten)
  else ! EBRSM and (GGDH or AFM)
    call field_get_val_v(ivstes, visten)
  endif
endif

call field_get_coefa_s(f_id, coefap)
call field_get_coefb_s(f_id, coefbp)
call field_get_coefaf_s(f_id, cofafp)
call field_get_coefbf_s(f_id, cofbfp)

call field_get_val_s(icrom, crom)
if (icp.ge.0) then
  call field_get_val_s(icp, cpro_cp)
endif

if (ippmod(icompf) .ge. 0) then
  if (icv.ge.0) then
    call field_get_val_s(icv, cpro_cv)
  endif
endif

isvhbl = 0
if (iscal.eq.isvhb) then
  isvhbl = isvhb
endif

if (iscal.eq.iscalt) then
  ! min. and max. of wall friction of the thermal scalar
  tetmax = -grand
  tetmin =  grand
  ! min. and max. of T+
  tplumx = -grand
  tplumn =  grand
endif

rinfiv(1) = rinfin
rinfiv(2) = rinfin
rinfiv(3) = rinfin

ypth = 0.d0

if (turb_flux_model_type.eq.3) then

  ! Turbulent diffusive flux of the scalar T
  ! (blending factor so that the component v'T' have only
  !  mu_T/(mu+mu_T)* Phi_T)

  ! Name of the scalar ivar
  call field_get_name(ivarfl(ivar), fname)

  ! Index of the corresponding turbulent flux
  call field_get_id(trim(fname)//'_turbulent_flux', f_id_ut)

  call field_get_coefa_v(f_id_ut,coefaut)
  call field_get_coefb_v(f_id_ut,coefbut)
  call field_get_coefaf_v(f_id_ut,cofafut)
  call field_get_coefbf_v(f_id_ut,cofbfut)
  call field_get_coefad_v(f_id_ut,cofarut)
  call field_get_coefbd_v(f_id_ut,cofbrut)

endif

! EB-GGDH/AFM/DFM alpha boundary conditions
if (turb_flux_model.eq.11 .or. turb_flux_model.eq.21 .or. turb_flux_model.eq.31) then

  ! Name of the scalar ivar
  call field_get_name(ivarfl(ivar), fname)

  ! Index of the corresponding turbulent flux
  call field_get_id(trim(fname)//'_alpha', f_id_al)

  call field_get_coefa_s (f_id_al, a_al)
  call field_get_coefb_s (f_id_al, b_al)
  call field_get_coefaf_s(f_id_al, af_al)
  call field_get_coefbf_s(f_id_al, bf_al)
endif

! pointers to T+ and T* if saved

itplus = -1
itstar = -1

tplusp => null()
tstarp => null()

if (iscal.eq.iscalt) then
  call field_get_id_try('tplus', itplus)
  if (itplus.ge.0) then
    call field_get_val_s (itplus, tplusp)
  endif
  call field_get_id_try('tstar', itstar)
  if (itstar.ge.0) then
    call field_get_val_s (itstar, tstarp)
  endif
  if (vcopt%icoupl.gt.0) then
    allocate(dist_theipb(nfabor))
    call cs_ic_field_dist_data_by_face_id(f_id, 1, theipb, dist_theipb)
  endif
endif

bpro_rough_t => null()

call field_get_id_try("boundary_roughness", f_id_rough)
if (f_id_rough.ge.0) then
  ! same thermal roughness if not specified
  call field_get_val_s(f_id_rough, bpro_rough_t)
endif

call field_get_id_try("boundary_thermal_roughness", f_id_rough)
if (f_id_rough.ge.0) then
  call field_get_val_s(f_id_rough, bpro_rough_t)
endif

if (vcopt%icoupl.gt.0) then
  call field_get_coupled_faces(f_id, cpl_faces)
endif

allocate(hbnd(nfabor),hint(nfabor),yptp(nfabor))

! Pointers to specific fields

if (iirayo.ge.1 .and. iscal.eq.iscalt) then
  call field_get_val_s_by_name("rad_convective_flux", bfconv)
  call field_get_val_s_by_name("rad_exchange_coefficient", bhconv)
endif

! FIXME not really the BC value
if (kbfid.lt.0) call field_get_key_id("boundary_value_id", kbfid)

call field_get_key_int(f_id, kbfid, b_f_id)

! If thermal variable has no boundary but temperature does, use it
if (b_f_id .lt. 0 .and. iscal.eq.iscalt .and. itherm.eq.2) then
  b_f_id = itempb
endif

if (b_f_id .ge. 0) then
  call field_get_val_s(b_f_id, bval_s)
else
  bval_s => null()
endif

! Does the scalar behave as a temperature ?
call field_get_key_int(f_id, kscacp, iscacp)

! Retrieve turbulent Schmidt value for current scalar
call field_get_key_double(f_id, ksigmas, turb_schmidt)

! Reference diffusivity
call field_get_key_double(f_id, kvisl0, visls_0)

! --- Loop on boundary faces
do ifac = 1, nfabor

  yplus = byplus(ifac)
  dplus = bdplus(ifac)
  uk = buk(ifac)

  ! Test on the presence of a smooth wall condition (start)
  if (icodcl(ifac,iu).eq.5) then

    iel = ifabor(ifac)

    ! Physical quantities

    visclc = viscl(iel)
    visctc = visct(iel)
    romc   = crom(iel)

    xnuii = visclc / romc

    ! Geometric quantities
    distbf = distb(ifac)

    cpp = 1.d0
    if (iscacp.eq.1) then
      if (icp.ge.0) then
        cpp = cpro_cp(iel)
      else
        cpp = cp0
      endif
    endif

    if (ifcvsl.lt.0) then
      rkl = visls_0
      prdtl = cpp*visclc/rkl
    else
      rkl = viscls(iel)
      prdtl = cpp*visclc/rkl
    endif

    ! --> Compressible module:
    ! On suppose que le nombre de Pr doit etre
    ! defini de la meme facon que l'on resolve
    ! en enthalpie ou en energie, soit Mu*Cp/Lambda.
    ! Si l'on resout en energie, on a calcule ci-dessus
    ! Mu*Cv/Lambda.

    if (iscal.eq.iscalt .and. itherm.eq.3) then
      if (icp.ge.0) then
        prdtl = prdtl*cpro_cp(iel)
      else
        prdtl = prdtl*cp0
      endif
      if (icv.ge.0) then
        prdtl = prdtl/cpro_cv(iel)
      else
        prdtl = prdtl/cv0
      endif
    endif

    ! Scalar diffusivity
    if (iand(vcopt%idften, ISOTROPIC_DIFFUSION).ne.0) then
      ! En compressible, pour l'energie LAMBDA/CV+CP/CV*(MUT/TURB_SCHMIDT)
      if (iscal.eq.iscalt .and. itherm.eq.3) then
        if (icp.ge.0) then
          cpscv = cpro_cp(iel)
        else
          cpscv = cp0
        endif
        if (icv.ge.0) then
          cpscv = cpscv/cpro_cv(iel)
        else
          cpscv = cpscv/cv0
        endif
        hint(ifac) = (rkl+vcopt%idifft*cpscv*visctc/turb_schmidt)/distbf
      else
        hint(ifac) = (rkl+vcopt%idifft*cpp*visctc/turb_schmidt)/distbf
      endif

    ! Symmetric tensor diffusivity (GGDH or AFM)
    else if (iand(vcopt%idften, ANISOTROPIC_DIFFUSION).ne.0) then
      ! En compressible, pour l'energie LAMBDA/CV+CP/CV*(MUT/SIGMAS)
      if (iscal.eq.iscalt .and. itherm.eq.3) then
        if (icp.ge.0) then
          cpscv = cpro_cp(iel)
        else
          cpscv = cp0
        endif
        if (icv.ge.0) then
          cpscv = cpscv/cpro_cv(iel)
        else
          cpscv = cpscv/cv0
        endif
        temp = vcopt%idifft*cpscv*ctheta(iscal)/csrij
      else
        temp = vcopt%idifft*cpp*ctheta(iscal)/csrij
      endif
      visci(1,1) = temp*visten(1,iel) + rkl
      visci(2,2) = temp*visten(2,iel) + rkl
      visci(3,3) = temp*visten(3,iel) + rkl
      visci(1,2) = temp*visten(4,iel)
      visci(2,1) = temp*visten(4,iel)
      visci(2,3) = temp*visten(5,iel)
      visci(3,2) = temp*visten(5,iel)
      visci(1,3) = temp*visten(6,iel)
      visci(3,1) = temp*visten(6,iel)

      ! ||Ki.S||^2
      viscis =   ( visci(1,1)*surfbo(1,ifac)       &
                 + visci(1,2)*surfbo(2,ifac)       &
                 + visci(1,3)*surfbo(3,ifac))**2   &
               + ( visci(2,1)*surfbo(1,ifac)       &
                 + visci(2,2)*surfbo(2,ifac)       &
                 + visci(2,3)*surfbo(3,ifac))**2   &
               + ( visci(3,1)*surfbo(1,ifac)       &
                 + visci(3,2)*surfbo(2,ifac)       &
                 + visci(3,3)*surfbo(3,ifac))**2

      ! IF.Ki.S
      fikis = ( (cdgfbo(1,ifac)-xyzcen(1,iel))*visci(1,1)   &
              + (cdgfbo(2,ifac)-xyzcen(2,iel))*visci(2,1)   &
              + (cdgfbo(3,ifac)-xyzcen(3,iel))*visci(3,1)   &
              )*surfbo(1,ifac)                              &
            + ( (cdgfbo(1,ifac)-xyzcen(1,iel))*visci(1,2)   &
              + (cdgfbo(2,ifac)-xyzcen(2,iel))*visci(2,2)   &
              + (cdgfbo(3,ifac)-xyzcen(3,iel))*visci(3,2)   &
              )*surfbo(2,ifac)                              &
            + ( (cdgfbo(1,ifac)-xyzcen(1,iel))*visci(1,3)   &
              + (cdgfbo(2,ifac)-xyzcen(2,iel))*visci(2,3)   &
              + (cdgfbo(3,ifac)-xyzcen(3,iel))*visci(3,3)   &
              )*surfbo(3,ifac)

      distfi = distb(ifac)

      ! Take I" so that I"F= eps*||FI||*Ki.n when I" is not in cell i
      ! NB: eps =1.d-1 must be consistent with vitens.f90
      fikis = max(fikis, 1.d-1*sqrt(viscis)*distfi)

      hint(ifac) = viscis/surfbn(ifac)/fikis
    endif
    if (f_id_rough.ge.0) then
      rough_t = bpro_rough_t(ifac)
    else
      rough_t = 0.d0
    endif

    ! wall function and Dirichlet or Neumann on the scalar
    if ( iturb.ne.0 .and. &
        (icodcl(ifac,ivar).eq.5 .or.icodcl(ifac,ivar).eq.6.or. &
         icodcl(ifac,ivar).eq.15 .or. &
         icodcl(ifac,ivar).eq.3)) then
      ! Note: to make things clearer yplus is always
      ! "y uk /nu" even for rough modelling. And the roughness correction is
      ! multiplied afterwards where needed.
      call hturbp(iwalfs,xnuii,prdtl,turb_schmidt,rough_t,uk,yplus,dplus,hflui,ypth)

      ! Correction for non-neutral condition in atmospheric flows
      hflui = hflui * bcfnns(ifac)

      ! Compute yk/T+ *PrT, take stability into account
      yptp(ifac) = hflui/prdtl
      ! Compute
      ! lambda/y * Pr_l *yk/T+ = lambda / nu * Pr_l * uk / T+ = rho cp uk / T+
      ! so "Pr_l * yk/T+" is the correction factor compared to a laminar profile
      hflui = rkl/distbf *hflui

      ! User exchange coefficient
      if (icodcl(ifac,ivar).eq.15) then
        hflui = rcodcl(ifac,ivar,2)
        yptp(ifac) = hflui/prdtl * distbf/rkl
      endif

    else

      ! y+/T+ *PrT
      yptp(ifac) = 1.d0/prdtl
      hflui = hint(ifac)

    endif

    hbnd(ifac) = hflui

  endif ! smooth wall condition

enddo

! internal coupling
if (vcopt%icoupl.gt.0) then
  ! Update exchange coef. in coupling entity of current scalar
  call cs_ic_field_set_exchcoeff(f_id, hbnd)
  ! Get external exchange coef.
  call field_get_hext(f_id, hextp)
endif

! --- Loop on boundary faces
do ifac = 1, nfabor

  yplus = byplus(ifac)
  dplus = bdplus(ifac)
  uk = buk(ifac)

  ! Test on the presence of a smooth wall condition (start)
  if (icodcl(ifac,iu).eq.5) then

    iel = ifabor(ifac)

    ! Physical quantities

    visclc = viscl(iel)
    visctc = visct(iel)
    romc   = crom(iel)

    xnuii = visclc / romc

    ! Geometric quantities
    distbf = distb(ifac)

    cpp = 1.d0
    if (iscacp.eq.1) then
      if (icp.ge.0) then
        cpp = cpro_cp(iel)
      else
        cpp = cp0
      endif
    endif

    if (ifcvsl.lt.0) then
      rkl = visls_0
    else
      rkl = viscls(iel)
    endif

    hext = rcodcl(ifac,ivar,2)
    pimp = rcodcl(ifac,ivar,1)

    if (vcopt%icoupl.gt.0) then
      if (cpl_faces(ifac)) then
        hext = hextp(ifac)/surfbn(ifac)
      endif
    endif

    hflui = hbnd(ifac)

    if (abs(hext).gt.rinfin*0.5d0.or.icodcl(ifac,ivar).eq.15) then
      heq = hflui
    else
      heq = hflui*hext/(hflui+hext)
    endif

    ! ---> Dirichlet Boundary condition with a wall function correction
    !      with or without an additional exchange coefficient hext

    if (icodcl(ifac,ivar).eq.5.or.icodcl(ifac,ivar).eq.6 &
      .or.icodcl(ifac,ivar).eq.15) then
      ! DFM: the gradient BCs are so that the production term
      !      of u'T' is correcty computed
      if (turb_flux_model_type.ge.1) then
        ! In the log layer
        if (yplus.ge.ypth.and.iturb.ne.0) then
          xmutlm = xkappa*visclc*yplus
          if (cell_is_active(iel).eq.1) then
            mut_lm_dmut = xmutlm/max(visctc,1.e-12*visclc)
          else
            mut_lm_dmut = 0.d0
          endif

          rcprod = min(xkappa , max(1.0d0,sqrt(mut_lm_dmut))/(yplus+dplus))

          cofimp = 1.d0 - yptp(ifac)*turb_schmidt/xkappa*                   &
                          (2.0d0*rcprod - 1.0d0/(2.0d0*yplus+dplus))

          ! In the viscous sub-layer
        else
          cofimp = 0.d0
        endif
      else
        cofimp = 1.d0 - heq/hint(ifac)
      endif

      ! To be coherent with a wall function, clip it to 0
      cofimp = max(cofimp, 0.d0)

      ! Gradient BCs
      coefap(ifac) = (1.d0 - cofimp)*pimp
      coefbp(ifac) = cofimp

      ! Flux BCs
      cofafp(ifac) = -heq*pimp
      cofbfp(ifac) =  heq

      ! Storage of the thermal exchange coefficient
      ! (conversion in case of energy or enthalpy)
      ! the exchange coefficient is in W/(m2 K)
      ! Useful for thermal coupling or radiative transfer
      if (iirayo.ge.1 .and. iscal.eq.iscalt.or.isvhbl.gt.0) then
        ! Enthalpy
        if (itherm.eq.2) then
          ! If Cp is variable
          if (icp.ge.0) then
            exchange_coef = hflui*cpro_cp(iel)
          else
            exchange_coef = hflui*cp0
          endif

        ! Total energy (compressible module)
        elseif (itherm.eq.3) then
          ! If Cv is variable
          if (icv.ge.0) then
            exchange_coef = hflui*cpro_cv(iel)
          else
            exchange_coef = hflui*cv0
          endif

        ! Temperature
        elseif (iscacp.eq.1) then
          exchange_coef = hflui
        endif
      endif

      ! ---> Thermal coupling, store h = lambda/d
      if (isvhbl.gt.0) hbord(ifac) = exchange_coef

      ! ---> Radiative transfer
      if (iirayo.ge.1 .and. iscal.eq.iscalt) then
        bhconv(ifac) = exchange_coef

        ! The outgoing flux is stored (Q = h(Ti'-Tp): negative if
        !  gain for the fluid) in W/m2
        bfconv(ifac) = cofafp(ifac) + cofbfp(ifac)*theipb(ifac)
      endif

      ! For the coupled faces with h_user (ie icodcl(ifac,ivar)=15)
      ! reset to zero af/bf coeff.
      ! By default icodcl(ifac,ivar)=0) for coupled faces
      if (vcopt%icoupl.gt.0) then
        if (cpl_faces(ifac)) then
          ! Flux BCs
          cofafp(ifac) = 0.d0
          cofbfp(ifac) =  0.d0
        endif
      endif

    endif ! End if icodcl.eq.5 or 6 or 15

    !--> Turbulent heat flux
    if (turb_flux_model_type.eq.3) then

      ! Turbulent diffusive flux of the scalar T
      ! (blending factor so that the component v'T' have only
      !  mu_T/(mu+mu_T)* Phi_T)
      if (icodcl(ifac,ivar).eq.5.or.icodcl(ifac,ivar).eq.6 &
        .or.icodcl(ifac,ivar).eq.15) then
        phit = cofafp(ifac)+cofbfp(ifac)*val_s(iel)
      elseif (icodcl(ifac,ivar).eq.3) then
        phit = rcodcl(ifac,ivar,3)
      elseif (icodcl(ifac,ivar).eq.1) then
        phit = heq *(val_s(iel) - pimp)
      else
        phit = 0.d0
      endif

      hintt(1) =   0.5d0*(visclc+rkl)/distbf                        &
                 + visten(1,iel)*ctheta(iscal)/distbf/csrij
      hintt(2) =   0.5d0*(visclc+rkl)/distbf                        &
                 + visten(2,iel)*ctheta(iscal)/distbf/csrij
      hintt(3) =   0.5d0*(visclc+rkl)/distbf                        &
                 + visten(3,iel)*ctheta(iscal)/distbf/csrij
      hintt(4) = visten(4,iel)*ctheta(iscal)/distbf/csrij
      hintt(5) = visten(5,iel)*ctheta(iscal)/distbf/csrij
      hintt(6) = visten(6,iel)*ctheta(iscal)/distbf/csrij

      ! Dirichlet Boundary Condition
      !-----------------------------

      ! Add rho*uk*Tet to T'v' in High Reynolds
      if (yplus.ge.ypth) then
        do isou = 1, 3
          pimpv(isou) = surfbo(isou,ifac)*phit/(surfbn(ifac)*cpp*romc)
        enddo
      else
        do isou = 1, 3
          pimpv(isou) = 0.d0
        enddo
      endif

      call set_dirichlet_vector_aniso &
           !========================
         ( coefaut(:,ifac)  , cofafut(:,ifac)  ,           &
           coefbut(:,:,ifac), cofbfut(:,:,ifac),           &
           pimpv            , hintt            , rinfiv )

      ! Boundary conditions used in the temperature equation
      do isou = 1, 3
        cofarut(isou,ifac) = 0.d0
        do jsou = 1, 3
          cofbrut(isou,jsou,ifac) = 0.d0
        enddo
      enddo

    endif

    ! EB-GGDH/AFM/DFM alpha boundary conditions
    if (turb_flux_model.eq.11 .or. &
        turb_flux_model.eq.21 .or. &
        turb_flux_model.eq.31) then

      ! Dirichlet Boundary Condition
      !-----------------------------
      pimp_al = 0.d0
      hint_al = 1.d0/distbf

      call set_dirichlet_scalar &
           !====================
         ( a_al(ifac), af_al(ifac),             &
           b_al(ifac), bf_al(ifac),             &
           pimp_al   , hint_al    , rinfin )

    endif

    ! Save the values of T^star and T^+ for post-processing

    if (b_f_id.ge.0 .or. iscal.eq.iscalt) then

      ! Wall function
      if (icodcl(ifac,ivar).eq.5.or.icodcl(ifac,ivar).eq.6 &
        .or.icodcl(ifac,ivar).eq.15) then
        if (iscal.eq.iscalt) then
          phit = cofafp(ifac)+cofbfp(ifac)*theipb(ifac)
        else
          phit = cofafp(ifac)+cofbfp(ifac)*bval_s(ifac)
        endif
      ! Imposed flux with wall function for post-processing
      elseif (icodcl(ifac,ivar).eq.3) then
        phit = rcodcl(ifac,ivar,3) ! = 0 if current face is coupled
      elseif (icodcl(ifac,ivar).eq.1) then
        if (iscal.eq.iscalt) then
          phit = heq *(theipb(ifac) - pimp)
        else
          phit = heq *(bval_s(ifac) - pimp)
        endif
      else
        phit = 0.d0
      endif

      ! if face is coupled
      if (vcopt%icoupl.gt.0) then
        if (cpl_faces(ifac)) then
          phit = heq*(theipb(ifac)-dist_theipb(ifac))
        endif
      endif

      if (f_id_rough.ge.0) then
        rough_t = bpro_rough_t(ifac)
      else
        rough_t = 0.d0
      endif

      tet = phit/(romc*cpp*max(uk, epzero))
      ! T+ = (T_I - T_w) / Tet
      tplus = max(yplus, epzero)/yptp(ifac)

      if (b_f_id.ge.0) bval_s(ifac) = bval_s(ifac) - tplus*tet

      if (itplus.ge.0) tplusp(ifac) = tplus
      if (itstar.ge.0) tstarp(ifac) = tet

      if (iscal.eq.iscalt) then
        tetmax = max(tet, tetmax)
        tetmin = min(tet, tetmin)
        tplumx = max(tplus,tplumx)
        tplumn = min(tplus,tplumn)
      endif

    endif

  endif ! smooth wall condition

enddo

deallocate(hbnd, hint, yptp)

if (iscal.eq.iscalt.and.vcopt%icoupl.gt.0) then
  deallocate(dist_theipb)
endif

!----
! End
!----

return
end subroutine

!===============================================================================
! Local functions
!===============================================================================

!-------------------------------------------------------------------------------
! Arguments
!______________________________________________________________________________.
!  mode           name          role                                           !
!______________________________________________________________________________!
!> \param[in]     iscal         scalar id
!> \param[in]     isvhb         indicator to save exchange coeffient
!> \param[in,out] icodcl        face boundary condition code:
!>                               - 1 Dirichlet
!>                               - 3 Neumann
!>                               - 4 sliding and
!>                                 \f$ \vect{u} \cdot \vect{n} = 0 \f$
!>                               - 5 smooth wall and
!>                                 \f$ \vect{u} \cdot \vect{n} = 0 \f$
!>                               - 6 rough wall and
!>                                 \f$ \vect{u} \cdot \vect{n} = 0 \f$
!>                               - 9 free inlet/outlet
!>                                 (input mass flux blocked to 0)
!> \param[in,out] rcodcl        boundary condition values:
!>                               - rcodcl(1) value of the dirichlet
!>                               - rcodcl(2) value of the exterior exchange
!>                                 coefficient (infinite if no exchange)
!>                               - rcodcl(3) value flux density
!>                                 (negative if gain) in w/m2
!>                                 -# for the velocity \f$ (\mu+\mu_T)
!>                                    \gradv \vect{u} \cdot \vect{n}  \f$
!>                                 -# for the pressure \f$ \Delta t
!>                                    \grad P \cdot \vect{n}  \f$
!>                                 -# for a scalar \f$ cp \left( K +
!>                                     \dfrac{K_T}{\sigma_T} \right)
!>                                     \grad T \cdot \vect{n} \f$
!> \param[in]     byplus        dimensionless distance to the wall
!> \param[in]     bdplus        dimensionless shift to the wall
!>                               for scalable wall functions
!> \param[in]     buk           dimensionless velocity
!> \param[in,out] hbord         exchange coefficient at boundary
!_______________________________________________________________________________

subroutine clptur_vector &
 ( iscal  , isvhb  , icodcl ,                                     &
   rcodcl ,                                                       &
   byplus , bdplus , buk )

!===============================================================================
! Module files
!===============================================================================

use paramx
use numvar
use optcal
use cstphy
use cstnum
use pointe
use entsor
use albase
use parall
use ppppar
use ppthch
use ppincl
use radiat
use cplsat
use mesh
use field
use field_operator
use lagran
use turbomachinery
use cs_c_bindings
use atincl

!===============================================================================

implicit none

! Arguments

integer          iscal, isvhb
integer, pointer, dimension(:,:) :: icodcl

double precision, pointer, dimension(:,:,:) :: rcodcl
double precision, dimension(:) :: byplus, bdplus, buk

! Local variables

integer          ivar, f_id, isvhbl
integer          ifac, iel
integer          iscacp, ifcvsl
integer          f_id_rough
integer          kturt, turb_flux_model, turb_flux_model_type

double precision cpp, rkl, prdtl, visclc, romc, cofimp
double precision distbf, heq, yptp, hflui, hext
double precision yplus, dplus, rcprod, uk
double precision visctc, xmutlm, ypth, xnuii, srfbnf
double precision rcodcx, rcodcy, rcodcz, rcodcn, rnx, rny, rnz
double precision turb_schmidt, visls_0
double precision rough_t

double precision, dimension(:), pointer :: bpro_rough_t
double precision, dimension(:), pointer :: crom, viscls
double precision, dimension(:,:), pointer :: val_p_v
double precision, dimension(:), pointer :: viscl, visct, cpro_cp, hextp

double precision, dimension(:,:), pointer :: coefav, cofafv
double precision, dimension(:,:,:), pointer :: coefbv, cofbfv

double precision, allocatable, dimension(:) :: hbnd, hint

type(var_cal_opt) :: vcopt

logical(c_bool), dimension(:), pointer ::  cpl_faces

!===============================================================================

ivar = isca(iscal)
f_id = ivarfl(ivar)

call field_get_val_prev_v(f_id, val_p_v)

call field_get_val_s(iviscl, viscl)
call field_get_val_s(ivisct, visct)

call field_get_key_int (f_id, kivisl, ifcvsl)

if (ifcvsl .ge. 0) then
  call field_get_val_s(ifcvsl, viscls)
endif

call field_get_key_struct_var_cal_opt(ivarfl(ivar), vcopt)

call field_get_coefa_v(f_id, coefav)
call field_get_coefb_v(f_id, coefbv)
call field_get_coefaf_v(f_id, cofafv)
call field_get_coefbf_v(f_id, cofbfv)

call field_get_val_s(icrom, crom)
if (icp.ge.0) then
  call field_get_val_s(icp, cpro_cp)
endif

! Does the vector behave as a temperature ?
call field_get_key_int(f_id, kscacp, iscacp)

! retrieve turbulent Schmidt value for current vector
call field_get_key_double(f_id, ksigmas, turb_schmidt)

! Reference diffusivity
call field_get_key_double(f_id, kvisl0, visls_0)

! Get the turbulent flux model
call field_get_key_id('turbulent_flux_model', kturt)
call field_get_key_int(ivarfl(isca(iscal)), kturt, turb_flux_model)
turb_flux_model_type = turb_flux_model / 10

isvhbl = 0
if (iscal.eq.isvhb) then
  isvhbl = isvhb
endif

ypth = 0.d0

bpro_rough_t => null()

call field_get_id_try("boundary_roughness", f_id_rough)
if (f_id_rough.ge.0) then
  ! same thermal roughness if not specified
  call field_get_val_s(f_id_rough, bpro_rough_t)
endif

call field_get_id_try("boundary_thermal_roughness", f_id_rough)
if (f_id_rough.ge.0) then
  call field_get_val_s(f_id_rough, bpro_rough_t)
endif

if (vcopt%icoupl.gt.0) then
  call field_get_coupled_faces(f_id, cpl_faces)
endif

allocate(hbnd(nfabor),hint(nfabor))

! --- Loop on boundary faces
do ifac = 1, nfabor

  yplus = byplus(ifac)
  dplus = bdplus(ifac)
  uk = buk(ifac)

  ! Geometric quantities
  distbf = distb(ifac)

  ! Test on the presence of a smooth wall condition (start)
  if (icodcl(ifac,iu).eq.5) then

    iel = ifabor(ifac)

    ! Physical quantities

    visclc = viscl(iel)
    visctc = visct(iel)
    romc   = crom(iel)

    xnuii = visclc / romc

    cpp = 1.d0
    if (iscacp.eq.1) then
      if (icp.ge.0) then
        cpp = cpro_cp(iel)
      else
        cpp = cp0
      endif
    endif

    if (ifcvsl.lt.0) then
      rkl = visls_0
      prdtl = cpp*visclc/rkl
    else
      rkl = viscls(iel)
      prdtl = cpp*visclc/rkl
    endif

    ! Scalar diffusivity
    if (iand(vcopt%idften, ISOTROPIC_DIFFUSION).ne.0) then
      hint(ifac) = (rkl+vcopt%idifft*cpp*visctc/turb_schmidt)/distbf
    else
      ! TODO if (vcopt%idften.eq.6)
      call csexit(1)
    endif

    ! wall function and Dirichlet or Neumann on the scalar
    if (iturb.ne.0.and.(icodcl(ifac,ivar).eq.5.or.icodcl(ifac,ivar).eq.3)) then

      if (f_id_rough.ge.0) then
        rough_t = bpro_rough_t(ifac)
      else
        rough_t = 0.d0
      endif

      !FIXME use Re* = rough_t * uk / nu ? * PrT ?
      call hturbp(iwalfs,xnuii,prdtl,turb_schmidt,rough_t,uk,yplus,dplus,hflui,ypth)
      ! Compute (y+-d+)/T+ *PrT
      yptp = hflui/prdtl
      ! Compute lambda/y * (y+-d+)/T+
      hflui = rkl/distbf *hflui

      ! User exchange coefficient
    else if (icodcl(ifac,ivar).eq.15) then
      hflui = rcodcl(ifac,ivar,2)

    else

      ! y+/T+ *PrT
      yptp = 1.d0/prdtl
      hflui = hint(ifac)

    endif

    hbnd(ifac) = hflui

  endif ! smooth wall condition

enddo

! internal coupling
if (vcopt%icoupl.gt.0) then
  ! Update exchange coef. in coupling entity of current scalar
  call cs_ic_field_set_exchcoeff(f_id, hbnd)
  ! Get external exchange coef.
  call field_get_hext(f_id, hextp)
endif

! --- Loop on boundary faces
do ifac = 1, nfabor

  yplus = byplus(ifac)
  dplus = bdplus(ifac)

  ! Test on the presence of a smooth wall condition (start)
  if (icodcl(ifac,iu).eq.5) then

    iel = ifabor(ifac)

    srfbnf = surfbn(ifac)

    ! Local framework

    ! Unit normal

    rnx = surfbo(1,ifac)/srfbnf
    rny = surfbo(2,ifac)/srfbnf
    rnz = surfbo(3,ifac)/srfbnf

    ! Handle Dirichlet vector values

    rcodcx = rcodcl(ifac,ivar  ,1)
    rcodcy = rcodcl(ifac,ivar+1,1)
    rcodcz = rcodcl(ifac,ivar+2,1)

    !  Keep tangential part

    rcodcn = rcodcx*rnx+rcodcy*rny+rcodcz*rnz
    rcodcx = rcodcx -rcodcn*rnx
    rcodcy = rcodcy -rcodcn*rny
    rcodcz = rcodcz -rcodcn*rnz

    ! Physical quantities

    visclc = viscl(iel)
    visctc = visct(iel)

    hext = rcodcl(ifac,ivar,2)

    if (vcopt%icoupl.gt.0) then
      if (cpl_faces(ifac)) then
        hext = hextp(ifac)/surfbn(ifac)
      endif
    endif

    hflui = hbnd(ifac)

    if (abs(hext).gt.rinfin*0.5d0.or.icodcl(ifac,ivar).eq.15) then
      heq = hflui
    else
      heq = hflui*hext/(hflui+hext)
    endif

    ! ---> Dirichlet Boundary condition with a wall function correction
    !      with or without an additional exchange coefficient hext

    if (icodcl(ifac,ivar).eq.5.or.icodcl(ifac,ivar).eq.15) then
      ! DFM: the gradient BCs are so that the production term
      !      of u'T' is correcty computed
      if (turb_flux_model_type.ge.1) then
        ! In the log layer
        if (yplus.ge.ypth.and.iturb.ne.0) then
          xmutlm = xkappa*visclc*(yplus+dplus)
          rcprod = min(xkappa , max(1.0d0,sqrt(xmutlm/visctc))/(yplus+dplus))

          cofimp = 1.d0 - yptp*turb_schmidt/xkappa*                        &
                  (2.0d0*rcprod - 1.0d0/(2.0d0*yplus+dplus))

          ! In the viscous sub-layer
        else
          cofimp = 0.d0
        endif
      else
        cofimp = 1.d0 - heq/hint(ifac)
      endif

      ! To be coherent with a wall function, clip it to 0
      cofimp = max(cofimp, 0.d0)

      ! Coupled solving of the velocity components

      ! Gradient boundary conditions
      !-----------------------------
      rcodcn = rcodcx*rnx+rcodcy*rny+rcodcz*rnz

      coefav(1,ifac) = (1.d0-cofimp)*(rcodcx - rcodcn*rnx) + rcodcn*rnx
      coefav(2,ifac) = (1.d0-cofimp)*(rcodcy - rcodcn*rny) + rcodcn*rny
      coefav(3,ifac) = (1.d0-cofimp)*(rcodcz - rcodcn*rnz) + rcodcn*rnz

      ! Projection in order to have the vector parallel to the wall
      ! B = cofimp * ( IDENTITY - n x n )

      coefbv(1,1,ifac) = cofimp*(1.d0-rnx**2)
      coefbv(2,2,ifac) = cofimp*(1.d0-rny**2)
      coefbv(3,3,ifac) = cofimp*(1.d0-rnz**2)
      coefbv(1,2,ifac) = -cofimp*rnx*rny
      coefbv(1,3,ifac) = -cofimp*rnx*rnz
      coefbv(2,1,ifac) = -cofimp*rny*rnx
      coefbv(2,3,ifac) = -cofimp*rny*rnz
      coefbv(3,1,ifac) = -cofimp*rnz*rnx
      coefbv(3,2,ifac) = -cofimp*rnz*rny

      ! Flux boundary conditions
      !-------------------------

      cofafv(1,ifac)   = -heq*(rcodcx - rcodcn*rnx) - hint(ifac)*rcodcn*rnx
      cofafv(2,ifac)   = -heq*(rcodcy - rcodcn*rny) - hint(ifac)*rcodcn*rny
      cofafv(3,ifac)   = -heq*(rcodcz - rcodcn*rnz) - hint(ifac)*rcodcn*rnz

      ! Projection
      !  B = heq*( IDENTITY - n x n )

      cofbfv(1,1,ifac) = heq*(1.d0-rnx**2) + hint(ifac)*rnx**2
      cofbfv(2,2,ifac) = heq*(1.d0-rny**2) + hint(ifac)*rny**2
      cofbfv(3,3,ifac) = heq*(1.d0-rnz**2) + hint(ifac)*rnz**2

      cofbfv(1,2,ifac) = (hint(ifac) - heq)*rnx*rny
      cofbfv(1,3,ifac) = (hint(ifac) - heq)*rnx*rnz
      cofbfv(2,1,ifac) = (hint(ifac) - heq)*rny*rnx
      cofbfv(2,3,ifac) = (hint(ifac) - heq)*rny*rnz
      cofbfv(3,1,ifac) = (hint(ifac) - heq)*rnz*rnx
      cofbfv(3,2,ifac) = (hint(ifac) - heq)*rnz*rny

    endif ! End if icodcl.eq.5

    ! TODO : postprocessing at the boundary

  endif ! smooth wall condition

enddo

deallocate(hbnd,hint)

!----
! End
!----

return
end subroutine
