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

! This file is part of Code_Saturne, a general-purpose CFD tool.
!
! Copyright (C) 1998-2013 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 rotcor.f90
!>
!> \brief Computing rotation/curvature correction for eddy-viscosity models.
!>        The subroutine is called for the linear eddy viscosity RANS models,
!>        when the option irccor = 1 is verify.
!>
!> Two type of rotation/curvature correction are computed, depending on
!> the specific eddy-viscosity model:
!>
!> * itycor = 1: - Cazalbou correction (varible ce2 coefficient in the
!>                 destruction term of dissipation equation)
!>               - default correction for \f$ k - \epsilon \f$ type models,
!>                 including elliptic relaxation/blending models
!>                (iturb = 20, 21, 50 or 51)
!>
!> * itycor = 2: - Spalart-Shur correction (production terms are multiplied
!>                 by a rotation function)
!>               - default correction for \f$ k - \omega \f$ SST or
!>                 Spalart-Allmaras (iturb = 60 or 70)
!-------------------------------------------------------------------------------

!-------------------------------------------------------------------------------
! Arguments
!______________________________________________________________________________.
!  mode           name          role                                           !
!______________________________________________________________________________!
!> \param[in]     dt            time step (per cell)
!> \param[in]     rtpa          calculated variables at cell centers
!>                               (at the previous time step)
!> \param[out]    rotfct        rotation function of Spalart-Shur correction
!>                               at cell center
!> \param[out]    ce2rc         modified ce2 coeficient of Cazalbou correction
!>                               at cell center
!_______________________________________________________________________________

subroutine rotcor &
 ( dt     , rtpa   , rotfct , ce2rc  )

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

use paramx
use numvar
use optcal
use entsor
use cstphy
use cstnum
use parall
use period
use pointe, only: coefau, coefbu, straio
use mesh

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

implicit none

! Arguments

double precision dt(ncelet), rtpa(ncelet,*)
double precision rotfct(ncel), ce2rc(ncel)

! Local variables

integer          iel, ivar, ifac, isou
integer          iccocg, inc, nswrgp, imligp, iwarnp
integer          istrai(3,3), ivorab(3,3)
integer          ii, jj, kk

logical          ilved

double precision epsrgp, climgp, extrap
double precision matrot(3,3), sigvor(3,3)
double precision dsijdt, trrota, wiksjk, rstar, echtm1
double precision stilde, wtilde, rotild
double precision xe, xk

double precision, allocatable, dimension(:,:,:) :: gradv
double precision, allocatable, dimension(:,:) :: strain, vortab
double precision, allocatable, dimension(:,:) :: grdsij
double precision, allocatable, dimension(:) :: coeas, coebs
double precision, allocatable, dimension(:) :: brtild, eta1, eta2

integer          ipass
data             ipass /0/
save             ipass

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

!===============================================================================
! 0. Initialization
!===============================================================================

ipass = ipass + 1
if(ipass.eq.1) then
  do isou = 1, 6
    do iel = 1, ncelet
      straio(iel,isou) = 0.d0
    enddo
  enddo
endif

!===============================================================================
! 1. Preliminary calculations
!===============================================================================

!-------------------------------------------------------------------------------
! 1.1 Compute the strain rate and absolute vorticity tensor
!-------------------------------------------------------------------------------

! Allocate temporary arrays
allocate(strain(ncelet,6),vortab(ncelet,3))

allocate(gradv(3, 3, ncelet))

iccocg = 1
inc = 1

nswrgp = nswrgr(iu)
imligp = imligr(iu)
iwarnp = iwarni(iu)
epsrgp = epsrgr(iu)
climgp = climgr(iu)
extrap = extrag(iu)


ilved = .false.

call grdvec &
!==========
( iu     , imrgra , inc    , nswrgp , imligp ,                   &
  iwarnp , epsrgp , climgp ,                                     &
  ilved  ,                                                       &
  rtpa(1,iu) ,  coefau , coefbu,                                 &
  gradv  )

! Compute rotation matrix (dual antisymmetric matrix of the rotation vector)
!   matrot(i,j) = e_imj.Omega_m
! with Omega the rotation vector of the reference frame

if (icorio.eq.1) then

  matrot(1,2) = -omegaz
  matrot(1,3) =  omegay
  matrot(2,3) = -omegax

  do ii = 1, 3
    matrot(ii,ii) = 0.d0
    do jj = ii+1, 3
      matrot(jj,ii) = -matrot(ii,jj)
    enddo
  enddo

else
  do ii = 1, 3
    do jj = 1, 3
      matrot(ii,jj) = 0.d0
    enddo
  enddo
endif

! Compute the strain rate tensor (symmetric)
!          S_ij = 0.5(dU_i/dx_j+dU_j/dx_i)
! and the absolute vorticity tensor (anti-symmetric)
!          W_ij = 0.5(dU_i/dx_j-dU_j/dx_i) + e_imj*Omega_m

! Only the non zero components in the upper triangle are stored

do iel = 1, ncel
  ! S11
  strain(iel,1) = gradv(1, 1, iel)
  ! S22
  strain(iel,2) = gradv(2, 2, iel)
  ! S33
  strain(iel,3) = gradv(3, 3, iel)
  ! S12
  strain(iel,4) = 0.5d0*(gradv(2, 1, iel) + gradv(1, 2, iel))
  ! S13
  strain(iel,5) = 0.5d0*(gradv(3, 1, iel) + gradv(1, 3, iel))
  ! S23
  strain(iel,6) = 0.5d0*(gradv(3, 2, iel) + gradv(2, 3, iel))
  ! W12
  vortab(iel,1) = 0.5d0*(gradv(2, 1, iel) - gradv(1, 2, iel)) + matrot(1,2)
  ! W13
  vortab(iel,2) = 0.5d0*(gradv(3, 1, iel) - gradv(1, 3, iel)) + matrot(1,3)
  ! W23
  vortab(iel,3) = 0.5d0*(gradv(3, 2, iel) - gradv(2, 3, iel)) + matrot(2,3)
enddo

! Free memory (strain and vortab arrays are deallocated later)
deallocate(gradv)

!-------------------------------------------------------------------------------
! 1.2 Computation of :
!
!   brtild = 2.W_ik.S_jk(DS_ij/Dt + (e_imn.S_jn + e_jmn.S_in)*Omega_m)
!     eta1 = S_ij.S_ij
!     eta2 = W_ij.W_ij
!
! ------------------------------------------------------------------------------

! Allocate temporary arrays
allocate(grdsij(ncelet,3))
allocate(coeas(nfabor),coebs(nfabor))
allocate(brtild(ncel),eta1(ncel),eta2(ncel))

! Index connectivity

! istrai(i,j) : position of the (i,j) component of the tensor
!               in the strain and straio arrays
! ivorab(i,j) : position of the (i,j) component of the tensor
!               in the vortab array
! sigvor(i,j) : sign of the (i,j) component of the absolute vorticity tensor
!               = 1  if i > j
!               = -1 if i < j
!               = 0  if i = j

istrai(1,1) = 1
istrai(2,2) = 2
istrai(3,3) = 3
istrai(1,2) = 4
istrai(1,3) = 5
istrai(2,3) = 6
istrai(2,1) = istrai(1,2)
istrai(3,1) = istrai(1,3)
istrai(3,2) = istrai(2,3)

ivorab(1,1) = 1
ivorab(2,2) = 1
ivorab(3,3) = 1
ivorab(1,2) = 1
ivorab(1,3) = 2
ivorab(2,3) = 3
ivorab(2,1) = ivorab(1,2)
ivorab(3,1) = ivorab(1,3)
ivorab(3,2) = ivorab(2,3)

do ii = 1, 3
  do jj = 1, 3
    if (ii.lt.jj) then
      sigvor(ii,jj) = 1.d0
    elseif (ii.eq.jj) then
      sigvor(ii,jj) = 0.d0
    else
      sigvor(ii,jj) = -1.d0
    endif
  enddo
enddo

! Boundary conditions for S_ij -> homogeneous Neumann
do ifac = 1, nfabor
  coeas(ifac) = 0.d0
  coebs(ifac) = 1.d0
enddo

do iel = 1, ncel
  brtild(iel) = 0.d0
  eta1(iel) = 0.d0
  eta2(iel) = 0.d0
enddo

do ii = 1, 3

  do jj = 1, 3

    iccocg = 1
    inc = 1

    if (itytur.eq.2 .or. itytur.eq.5 .or. iturb.eq.60) then
      ivar = ik
    elseif (iturb.eq.70) then
      ivar = inusa
    endif

    nswrgp = nswrgr(ivar)
    imligp = imligr(ivar)
    iwarnp = iwarni(ivar)
    epsrgp = epsrgr(ivar)
    climgp = climgr(ivar)
    extrap = extrag(ivar)

    ivar = 0

    call grdcel &
    !==========
  ( ivar , imrgra , inc    , iccocg , nswrgp , imligp ,            &
    iwarnp , nfecra, epsrgp , climgp , extrap ,                    &
    strain(1,istrai(ii,jj))   , coeas , coebs ,                    &
    grdsij )

    do iel = 1, ncel

      ! material derivative of S_ij
      if (idtvar.lt.0) then
        dsijdt = 0.d0
      else
        dsijdt = ((strain(iel,istrai(ii,jj))        &
                 - straio(iel,istrai(ii,jj)))       &
                /dt(iel))
      endif
      dsijdt = dsijdt + rtpa(iel,iu)*grdsij(iel,1)        &
           + rtpa(iel,iv)*grdsij(iel,2)                   &
           + rtpa(iel,iw)*grdsij(iel,3)

      ! (e_imn.S_jn+e_jmn.S_in)*Omega_m term
      trrota = 0.d0
      do kk = 1, 3
        trrota = trrota                                         &
              + matrot(ii,kk)*strain(iel,istrai(jj,kk))       &
              + matrot(jj,kk)*strain(iel,istrai(ii,kk))
      enddo

      ! W_ik.S_jk term
      wiksjk = 0.d0
      do kk = 1, 3
        wiksjk = wiksjk + sigvor(ii,kk)*vortab(iel,ivorab(ii,kk))   &
              *strain(iel,istrai(jj,kk))
      enddo

      ! brtild, eta1, eta2 (see the definitions above)
      brtild(iel) = brtild(iel)                 &
           + 2.d0*wiksjk*(dsijdt + trrota)
      eta1(iel) = eta1(iel)                   &
           + strain(iel,istrai(ii,jj))**2
      eta2(iel) = eta2(iel)                   &
           + (sigvor(ii,jj)*vortab(iel,ivorab(ii,jj)))**2

    enddo

  enddo

enddo

!===============================================================================
! 2. Effective computation of the rotation correction
!===============================================================================

if (itycor.eq.1) then

!-------------------------------------------------------------------------------
! 2.1 Cazalbou correction
!-------------------------------------------------------------------------------

  do iel = 1, ncel

    ! Computation of STILDE = sqrt(2.S_ij.S_ij) et WTILDE = sqrt(W_ij.W_ij/2)
    stilde = max(sqrt(eta1(iel)*2.d0),1.d-15)
    wtilde = max(sqrt(eta2(iel)/2.d0),1.d-15)

    xk = max(rtpa(iel, ik),1.d-15)
    xe = max(rtpa(iel,iep),1.d-15)
    rotild = xe/wtilde/xk
    brtild(iel) = -brtild(iel)*xk/xe/stilde**3

    ! Variable C_eps_2 coefficient of Cazalbou
    ce2rc(iel) = ccaze2                                 &
         + (ccaze2 - 1.d0)/(1 + ccaza*rotild**1.5d0)             &
         + ccaze2*ccazsc*stilde*xk/xe                         &
         *(tanh(ccazb*brtild(iel) + ccazc) - ccazd)

    ce2rc(iel) = max(ce2rc(iel),0.d0)

  enddo

elseif (itycor.eq.2) then

!-------------------------------------------------------------------------------
! 2.2 Spalart-Shur correction
!-------------------------------------------------------------------------------

  do iel = 1, ncel

    ! Computation of STILDE = 2.S_ij.S_ij and WTILDE = 2.W_ij.W_ij
    stilde = max(eta1(iel)*2.d0,1.d-15)
    wtilde = max(eta2(iel)*2.d0,1.d-15)

    echtm1 = sqrt(0.5d0*(stilde + wtilde))

    ! Lower bound in case of k-w SST (see Smirnov & Menter, ASME, 2009)
    if (iturb.eq.60)  echtm1 = max(echtm1,sqrt(cmu)*rtpa(iel,iomg))

    brtild(iel) = brtild(iel)/(echtm1**4)

    rstar = sqrt(stilde)/sqrt(wtilde)

    ! Rotation function of Spalart & Shur
    rotfct(iel) = (1.d0 + cssr1)*2.d0*rstar/(1.d0 + rstar)     &
         *(1.d0 - cssr3*atan(cssr2*brtild(iel))) - cssr1

    rotfct(iel) = max(rotfct(iel),0.d0)

  enddo

endif

!===============================================================================
! 3. Finalizations
!===============================================================================

! Save de strain rate tensor for the next time step
if (idtvar.ge.0) then
  do isou = 1, 6
    do iel = 1, ncelet
      straio(iel,isou) = strain(iel,isou)
    enddo
  enddo
endif

! Free memory
deallocate(strain,vortab)
deallocate(grdsij)
deallocate(coeas,coebs)
deallocate(brtild,eta1,eta2)

!--------
! Formats
!--------

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

return

end subroutine
