\title{ $\Omega$ Vortex Identification Method} \author{} \maketitle
$\Omega$ method is based on the tensor field $\nabla V$ which is defined by
\begin{equation}\label{eq:dv} \nabla V= \begin{pmatrix} \frac{\partial u}{\partial x}&\frac{\partial u}{\partial y}&\frac{\partial u}{\partial z}\\ \frac{\partial v}{\partial x}&\frac{\partial v}{\partial y}&\frac{\partial v}{\partial z}\\ \frac{\partial w}{\partial x}&\frac{\partial w}{\partial y}&\frac{\partial w}{\partial z} \end{pmatrix} \end{equation}$\nabla V$ can be rewritten as $\nabla V=A+B$, where $A$ and $B$ are symmetric and antisymmetric part of $\nabla V$, respectively, defined by
\begin{equation}\label{eq:a} A=\frac{\nabla V+\nabla V^T}{2} \end{equation}\begin{equation}\label{eq:b} B=\frac{\nabla V-\nabla V^T}{2} \end{equation}$A$ represents deformation and $B$ represents vorticity. The new parameter $\Omega$ is defined as
\begin{equation}\label{eq:omg} \Omega=\frac{\|B\|_F^2}{\|A\|_F^2+\|B\|_F^2}, \end{equation}provided $\nabla V \ne 0$, where $\|\cdot\|_F$ is the Frobenius norm. In the case of $\nabla V=0$, $\Omega$ is defined as a constant 0.5. A vortex is identified as the region where $\Omega >0.5$, which means vorticity overtakes deformation.
In practical application, a small value $\epsilon=0.001\times Q_{max}$ is added to the denominator of $\Omega$ to avoid dividing by zero,
\begin{equation}\label{eq:omg2} \Omega=\frac{\|B\|_F^2}{\|A\|_F^2+\|B\|_F^2+\epsilon}, \end{equation}and the iso-surface of $\Omega=0.52$ can indicate the vortex structure very well.
This is the Fortran subroutine to calculate $\Omega$ in structured grids. Click here to download source file.
!======================================================================
! FileName: Omega_subroutine.f90
! Project: Omega
! Author: Yong Yang, Department of Mathematics,
! University of Texas at Arlington, Arlington, Texas, USA
!======================================================================
!
Subroutine CalOmega(Omega,U,V,W,X,Y,Z,imax,jmax,kmax)
! This subroutine is used to calculate Omega.
! Input-
! U,V,W: Velocity arrays. The dimensions are imax*jmax*kmax
! X,Y,Z: Coordinates arrays.The dimensions are imax*jmax*kmax
! imax,jmax,kmax: The dimensions of the grid.
! Output-
! Omega: Omega array.The dimensions are imax*jmax*kmax
implicit none
integer ,intent(in) :: imax,jmax,kmax
real ,dimension(imax,jmax,kmax), intent(in) :: U,V,W,X,Y,Z
real ,dimension(imax,jmax,kmax), intent(out) :: Omega
real ,dimension(3,3) :: JM,JMG
!JM: Jacobi Matrix
!@xi/@x @xi/@y @xi/@z
!@eta/@x @eta/@y @eta/@z
!@zeta/@x @zeta/@y @zeta/@z
!
!JMG: Matrix as following,
!@x/@xi @x/@eta @x/@zeta
!@y/@xi @y/@eta @y/@zeta
!@z/@xi @z/@eta @z/@zeta
real ,dimension(3,3) :: VGG
!@u/@xi @u/@eta @u/@zeta
!@v/@xi @v/@eta @v/@zeta
!@w/@xi @w/@eta @w/@zeta
real ,dimension(3,3) :: VG
!@u/@x @u/@y @u/@z
!@v/@x @v/@y @v/@z
!@w/@x @w/@y @w/@z
real ,dimension(3,3) :: A,B
!A is symmetric part of velocity tensor
!B is anti-symmetric part of velocity tensor
real ,dimension(imax,jmax,kmax):: traceA,traceB
! The trace of matrix A and matrix B
integer :: i,j,k
real :: detJMrev ! The reciprocal of Jacobi matrix determinant
real :: Eps
do i=1,imax
do j=1,jmax
do k=1,kmax
call Diff4th(VGG(1,1),U(:,:,:),imax,jmax,kmax,i,j,k,1,0,0,real(imax-1))
call Diff4th(VGG(1,2),U(:,:,:),imax,jmax,kmax,i,j,k,0,1,0,real(jmax-1))
call Diff4th(VGG(1,3),U(:,:,:),imax,jmax,kmax,i,j,k,0,0,1,real(kmax-1))
call Diff4th(VGG(2,1),V(:,:,:),imax,jmax,kmax,i,j,k,1,0,0,real(imax-1))
call Diff4th(VGG(2,2),V(:,:,:),imax,jmax,kmax,i,j,k,0,1,0,real(jmax-1))
call Diff4th(VGG(2,3),V(:,:,:),imax,jmax,kmax,i,j,k,0,0,1,real(kmax-1))
call Diff4th(VGG(3,1),W(:,:,:),imax,jmax,kmax,i,j,k,1,0,0,real(imax-1))
call Diff4th(VGG(3,2),W(:,:,:),imax,jmax,kmax,i,j,k,0,1,0,real(jmax-1))
call Diff4th(VGG(3,3),W(:,:,:),imax,jmax,kmax,i,j,k,0,0,1,real(kmax-1))
call Diff4th(JMG(1,1),X(:,:,:),imax,jmax,kmax,i,j,k,1,0,0,real(imax-1))
call Diff4th(JMG(1,2),X(:,:,:),imax,jmax,kmax,i,j,k,0,1,0,real(jmax-1))
call Diff4th(JMG(1,3),X(:,:,:),imax,jmax,kmax,i,j,k,0,0,1,real(kmax-1))
call Diff4th(JMG(2,1),Y(:,:,:),imax,jmax,kmax,i,j,k,1,0,0,real(imax-1))
call Diff4th(JMG(2,2),Y(:,:,:),imax,jmax,kmax,i,j,k,0,1,0,real(jmax-1))
call Diff4th(JMG(2,3),Y(:,:,:),imax,jmax,kmax,i,j,k,0,0,1,real(kmax-1))
call Diff4th(JMG(3,1),Z(:,:,:),imax,jmax,kmax,i,j,k,1,0,0,real(imax-1))
call Diff4th(JMG(3,2),Z(:,:,:),imax,jmax,kmax,i,j,k,0,1,0,real(jmax-1))
call Diff4th(JMG(3,3),Z(:,:,:),imax,jmax,kmax,i,j,k,0,0,1,real(kmax-1))
call det33(JMG,detJMrev)
JM(1,1)=JMG(2,2)*JMG(3,3)-JMG(2,3)*JMG(3,2)
JM(1,2)=JMG(1,3)*JMG(3,2)-JMG(1,2)*JMG(3,3)
JM(1,3)=JMG(1,2)*JMG(2,3)-JMG(1,3)*JMG(2,2)
JM(2,1)=JMG(2,3)*JMG(3,1)-JMG(2,1)*JMG(3,3)
JM(2,2)=JMG(1,1)*JMG(3,3)-JMG(1,3)*JMG(3,1)
JM(2,3)=JMG(1,3)*JMG(2,1)-JMG(1,1)*JMG(2,3)
JM(3,1)=JMG(2,1)*JMG(3,2)-JMG(2,2)*JMG(3,1)
JM(3,2)=JMG(1,2)*JMG(3,1)-JMG(1,1)*JMG(3,2)
JM(3,3)=JMG(1,1)*JMG(2,2)-JMG(1,2)*JMG(2,1)
JM=JM/detJMrev
VG=matmul(VGG,JM)
A=0.5*(VG+transpose(VG))
B=0.5*(VG-transpose(VG))
traceA(i,j,k)=sum(A**2)
traceB(i,j,k)=sum(B**2)
end do
end do
end do
Eps=0.0005*maxval(traceB-traceA)
do i=1,imax
do j=1,jmax
do k=1,kmax
Omega(i,j,k)=traceB(i,j,k)/(traceA(i,j,k)+traceB(i,j,k)+Eps)
end do
end do
end do
end subroutine CalOmega
subroutine det33(a,det)
! This subroutine is used to calculate the determinant of a 3*3 matrix.
! Input-
! a: 3*3 matrix
! Output-
! det: The determinant of the matrix a.
implicit none
real ,dimension(3,3), intent(in) :: a
real ,intent(out) :: det
det = a(1,1)*(a(2,2)*a(3,3) - a(3,2)*a(2,3)) &
+ a(1,2)*(a(3,1)*a(2,3) - a(2,1)*a(3,3)) &
+ a(1,3)*(a(2,1)*a(3,2) - a(3,1)*a(2,2))
end subroutine det33
subroutine Diff4th(du,u,imax,jmax,kmax,i,j,k,iinc,jinc,kinc,revd)
! This subroutine is used to calculate the derivative by 4th order central
! difference method. For the boundary, 3rd order backward or forward four
! points difference is used.
implicit none
integer ,intent(in) :: imax,jmax,kmax,i,j,k,iinc,jinc,kinc
real ,intent(in) :: revd
real ,dimension(imax,jmax,kmax), intent(in) :: u
real ,intent(out) :: du
real :: f3rdSt,f3rdEd,f3rdStplus1,f3rdEdminus1,f4th
real :: a,b,c,d,revdx
integer :: ijkStInfo,ijkEdInfo
integer :: ist,jst,kst,ied,jed,ked
integer :: i1,i2,i3,j1,j2,j3,k1,k2,k3
integer :: i_1,i_2,i_3,j_1,j_2,j_3,k_1,k_2,k_3
f3rdSt(a, b, c, d, revdx)=(-11.*a+18.*b-9.*c+2.*d)*revdx/6.
f3rdEd(a, b, c, d, revdx)=(11.*a-18.*b+9.*c-2.*d)*revdx/6.
f3rdStplus1(a, b, c, d, revdx)=(-2.*a-3.*b+6.*c-d)*revdx/6.
f3rdEdminus1(a, b, c, d, revdx)=(2.*a+3.*b-6.*c+d)*revdx/6.
f4th(a, b, c, d, revdx)=(-a+8.*b-8.*c+d)*revdx/12.
ist=1
jst=1
kst=1
ied=imax
jed=jmax
ked=kmax
ijkStInfo = 0
ijkEdInfo = 0
if ((iinc.eq.1.and.i.eq.ist).or. &
(jinc.eq.1.and.j.eq.jst).or. &
(kinc.eq.1.and.k.eq.kst)) then
ijkStInfo=1
else if ((iinc.eq.1.and.i.eq.ist+1).or. &
(jinc.eq.1.and.j.eq.jst+1).or. &
(kinc.eq.1.and.k.eq.kst+1)) then
ijkStInfo=2
else if ((iinc.eq.1.and.i.eq.ied).or. &
(jinc.eq.1.and.j.eq.jed).or. &
(kinc.eq.1.and.k.eq.ked)) then
ijkEdInfo=1
else if ((iinc.eq.1.and.i.eq.ied-1).or. &
(jinc.eq.1.and.j.eq.jed-1).or. &
(kinc.eq.1.and.k.eq.ked-1)) then
ijkEdInfo=2
endif
i1=i+iinc
i2=i1+iinc
i3=i2+iinc
j1=j+jinc
j2=j1+jinc
j3=j2+jinc
k1=k+kinc
k2=k1+kinc
k3=k2+kinc
i_1=i-iinc
i_2=i_1-iinc
i_3=i_2-iinc
j_1=j-jinc
j_2=j_1-jinc
j_3=j_2-jinc
k_1=k-kinc
k_2=k_1-kinc
k_3=k_2-kinc
if (ijkStInfo.eq.1) then
du=f3rdSt(u(i,j,k),u(i1,j1,k1),u(i2,j2,k2),u(i3,j3,k3),revd)
elseif (ijkStInfo.eq.2) then
du=f3rdStplus1(u(i_1,j_1,k_1),u(i,j,k),u(i1,j1,k1),u(i2,j2,k2),revd)
else if (ijkEdInfo.eq.1) then
du=f3rdEd(u(i,j,k),u(i_1,j_1,k_1),u(i_2,j_2,k_2),u(i_3,j_3,k_3),revd)
else if (ijkEdInfo.eq.2) then
du=f3rdEdminus1(u(i1,j1,k1),u(i,j,k),u(i_1,j_1,k_1),u(i_2,j_2,k_2),revd)
else
du=f4th(u(i2,j2,k2),u(i1,j1,k1),u(i_1,j_1,k_1),u(i_2,j_2,k_2),revd)
endif
end subroutine Diff4th
This is a macro of Tecplot to calculate $\Omega$. Click here to download source file.
#!MC 1400
# Created by Tecplot 360 build 14.0.2.35002
$!ALTERDATA
EQUATION = '{Omega} = 0'
$!ALTERDATA
EQUATION = '{a} = 0'
$!ALTERDATA
EQUATION = '{b} = 0'
$!VarSet |NUMVARSINIT| = |NUMVARS|
$!VarSet |NUMVARSINIT| += 1
$!PROMPTFORTEXTSTRING |U|
INSTRUCTIONS = "Enter the variable number for U"
$!PROMPTFORTEXTSTRING |V|
INSTRUCTIONS = "Enter the variable number for V"
$!PROMPTFORTEXTSTRING |W|
INSTRUCTIONS = "Enter the variable number for W"
$!GLOBALTHREEDVECTOR UVAR = |U|
$!GLOBALTHREEDVECTOR VVAR = |V|
$!GLOBALTHREEDVECTOR WVAR = |W|
$!ALTERDATA
EQUATION = '{dudx} = ddx(u)'
$!ALTERDATA
EQUATION = '{dvdx} = ddx(v)'
$!ALTERDATA
EQUATION = '{dwdx} = ddx(w)'
$!ALTERDATA
EQUATION = '{dudy} = ddy(u)'
$!ALTERDATA
EQUATION = '{dvdy} = ddy(v)'
$!ALTERDATA
EQUATION = '{dwdy} = ddy(w)'
$!ALTERDATA
EQUATION = '{dudz} = ddz(u)'
$!ALTERDATA
EQUATION = '{dvdz} = ddz(v)'
$!ALTERDATA
EQUATION = '{dwdz} = ddz(w)'
$!ALTERDATA
EQUATION = '{a} = 0.5*({dudx}**2 + {dvdy}**2 + {dwdz}**2) + 0.25*(({dudy}+{dvdx})**2 + ({dudz}+{dwdx})**2 + ({dvdz}+{dwdy})**2)'
$!ALTERDATA
EQUATION = '{b} = 0.25*(({dudy}-{dvdx})**2 + ({dudz}-{dwdx})**2 + ({dvdz}-{dwdy})**2)'
$!ALTERDATA
EQUATION = '{Omega} = {b}/({a}+{b}+1e-3)'
$!VarSet |NUMVARSFIN| = |NUMVARS|
$!DELETEVARS [|NUMVARSINIT|-|NUMVARS|]
Please cite the following article when you use $\Omega$ method:
Liu, C., Wang, Y., Yang, Y., & Duan, Z. (2016). New Omega Vortex Identification Method. SCIENCE CHINA Physics, Mechanics & Astronomy, 2016, 59(8):687411
You can download this article from the website of SCIENCE CHINA.