CFD Online Logo CFD Online URL
www.cfd-online.com
[Sponsors]
Home > Wiki > Geometry.f90 - Calculation of geometric properties

Geometry.f90 - Calculation of geometric properties

From CFD-Wiki

(Difference between revisions)
Jump to: navigation, search
(New page: <pre> !Sample program for solving Lid-driven cavity flow test using SIMPLE-algorithm ! Calculation of Xc and Yc with possibility for further development modul !Copyright (C) 2010 Michail...)
 
Line 4: Line 4:
! Calculation of Xc and Yc with possibility for further development modul
! Calculation of Xc and Yc with possibility for further development modul
!Copyright (C) 2010  Michail Kiričkov
!Copyright (C) 2010  Michail Kiričkov
 +
!Copyright (C) 2016  Michail Kiričkov, Kaunas University for Technology
!This program is free software; you can redistribute it and/or
!This program is free software; you can redistribute it and/or
Line 19: Line 20:
!Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
!Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
 +
!**********************************************************************
!**********************************************************************
!**********************************************************************
Subroutine Geom
Subroutine Geom
-
 
include 'icomm_1.f90'
include 'icomm_1.f90'
-
 
! calculation Xc,Yc
! calculation Xc,Yc
-
 
! ------------------------------------------------------------------------
! ------------------------------------------------------------------------
-
 
do  2 I=2,NXmax
do  2 I=2,NXmax
         do  2 J=2,NYmax
         do  2 J=2,NYmax
-
 
         Xc(I,J)=(  X(i-1,j-1) + X(i-1,j  ) + &
         Xc(I,J)=(  X(i-1,j-1) + X(i-1,j  ) + &
                   X(i  ,j  ) + X(i  ,j-1)      ) * 0.25  
                   X(i  ,j  ) + X(i  ,j-1)      ) * 0.25  
-
 
+
        Yc(I,J)=(  Y(i-1,j-1) + Y(i-1,j  ) + &
-
    Yc(I,J)=(  Y(i-1,j-1) + Y(i-1,j  ) + &
+
                  Y(i  ,j  ) + Y(i  ,j-1)    ) * 0.25  
-
              Y(i  ,j  ) + Y(i  ,j-1)    ) * 0.25  
+
-
 
+
2 continue
2 continue
-
 
! ------------------------------------------------------------------------
! ------------------------------------------------------------------------
do 4 I=2,NXmax
do 4 I=2,NXmax
-
 
Xc(i,1      ) = ( X(i  ,1    ) + X(i-1,1    ) ) * 0.5
Xc(i,1      ) = ( X(i  ,1    ) + X(i-1,1    ) ) * 0.5
Xc(i,NYmax+1) = ( X(i  ,NYmax) + X(i-1,NYmax) ) * 0.5
Xc(i,NYmax+1) = ( X(i  ,NYmax) + X(i-1,NYmax) ) * 0.5
-
 
-
 
Yc(i,1      ) = ( Y(i  ,1    ) + Y(i-1,1    ) ) * 0.5
Yc(i,1      ) = ( Y(i  ,1    ) + Y(i-1,1    ) ) * 0.5
Yc(i,NYmax+1) = ( Y(i  ,NYmax) + Y(i-1,NYmax) ) * 0.5
Yc(i,NYmax+1) = ( Y(i  ,NYmax) + Y(i-1,NYmax) ) * 0.5
-
 
4 continue  
4 continue  
-
+
! ------------------------------------------------------------------------
-
! ------------------------------------------------------------------------
+
-
 
+
Xc(1      ,      1) = X(    1,    1)
Xc(1      ,      1) = X(    1,    1)
Xc(NXmax+1,      1) = X(NXmax,    1)
Xc(NXmax+1,      1) = X(NXmax,    1)
Xc(      1,NYmax+1) = X(    1,NYmax)
Xc(      1,NYmax+1) = X(    1,NYmax)
Xc(NXmax+1,NYmax+1) = X(NXmax,NYmax)
Xc(NXmax+1,NYmax+1) = X(NXmax,NYmax)
-
 
Yc(1      ,      1) = Y(    1,    1)
Yc(1      ,      1) = Y(    1,    1)
Yc(NXmax+1,      1) = Y(NXmax,    1)
Yc(NXmax+1,      1) = Y(NXmax,    1)
Yc(      1,NYmax+1) = Y(    1,NYmax)
Yc(      1,NYmax+1) = Y(    1,NYmax)
Yc(NXmax+1,NYmax+1) = Y(NXmax,NYmax)
Yc(NXmax+1,NYmax+1) = Y(NXmax,NYmax)
-
 
!--------------------------------------------------------------------------
!--------------------------------------------------------------------------
-
! ------------------------------------------------------------------------
 
do 5 J=2,NYmax
do 5 J=2,NYmax
-
 
Yc(1      ,j ) = ( Y(1    ,j) + Y(1    ,j-1) ) * 0.5
Yc(1      ,j ) = ( Y(1    ,j) + Y(1    ,j-1) ) * 0.5
Yc(NXmax+1,j ) = ( Y(NXmax ,j) + Y(NXmax,j-1) ) * 0.5
Yc(NXmax+1,j ) = ( Y(NXmax ,j) + Y(NXmax,j-1) ) * 0.5
Xc(1      ,j ) = ( X(1    ,j) + X(1    ,j-1) ) * 0.5
Xc(1      ,j ) = ( X(1    ,j) + X(1    ,j-1) ) * 0.5
Xc(NXmax+1,j ) = ( X(NXmax ,j) + X(NXmax,j-1) ) * 0.5
Xc(NXmax+1,j ) = ( X(NXmax ,j) + X(NXmax,j-1) ) * 0.5
-
 
5 continue  
5 continue  
-
!--------------------------------------------------------------------------
 
! ------------------------------------------------------------------------
! ------------------------------------------------------------------------
! Xi (vertical)  
! Xi (vertical)  
-
 
Do 101 I=1,NXmax   
Do 101 I=1,NXmax   
Do 101 J=1,NYmax-1
Do 101 J=1,NYmax-1
-
 
X_xi(I,J) = X(i  ,j+1) - X(i  ,j  )
X_xi(I,J) = X(i  ,j+1) - X(i  ,j  )
Y_xi(I,J) = Y(i  ,j+1) - Y(i  ,j  )  
Y_xi(I,J) = Y(i  ,j+1) - Y(i  ,j  )  
 +
101 continue
-
101 continue
+
    ! Eta (horisontal)  
-
 
+
-
! Eta (horisontal)  
+
-
 
+
Do 102 I=1,NXmax-1
Do 102 I=1,NXmax-1
Do 102 J=1,NYmax   
Do 102 J=1,NYmax   
-
 
X_et(I,J) = X(i+1,j  ) - X(i  ,j  )
X_et(I,J) = X(i+1,j  ) - X(i  ,j  )
Y_et(I,J) = Y(i+1,j  ) - Y(i  ,j  )
Y_et(I,J) = Y(i+1,j  ) - Y(i  ,j  )
-
 
102 continue
102 continue
-
 
!--------------------------------------------------------------------------
!--------------------------------------------------------------------------
-
! ------------------------------------------------------------------------
 
-
 
! Xi (vertical)  
! Xi (vertical)  
-
 
Do 201 I=1,NXmaxC  
Do 201 I=1,NXmaxC  
Do 201 J=1,NYmax
Do 201 J=1,NYmax
-
 
Del_X_xi(i  ,j  ) =  Xc(i  ,j+1) - Xc(i  ,j  )
Del_X_xi(i  ,j  ) =  Xc(i  ,j+1) - Xc(i  ,j  )
Del_Y_xi(i  ,j  ) =  Yc(i  ,j+1) - Yc(i  ,j  )  
Del_Y_xi(i  ,j  ) =  Yc(i  ,j+1) - Yc(i  ,j  )  
-
 
201 continue
201 continue
-
 
-
 
! Eta (horisontal)  
! Eta (horisontal)  
-
 
Do 202 I=1,NXmax  
Do 202 I=1,NXmax  
Do 202 J=1,NYmaxC
Do 202 J=1,NYmaxC
-
 
Del_X_et(i  ,j  ) =  Xc(i+1,j  ) - Xc(i  ,j  )  
Del_X_et(i  ,j  ) =  Xc(i+1,j  ) - Xc(i  ,j  )  
Del_Y_et(i  ,j  ) =  Yc(i+1,j  ) - Yc(i  ,j  )  
Del_Y_et(i  ,j  ) =  Yc(i+1,j  ) - Yc(i  ,j  )  
-
 
202 continue
202 continue
-
 
!--------------------------------------------------------------------------
!--------------------------------------------------------------------------
-
 
Do 303 I=2,NXmaxC-1   
Do 303 I=2,NXmaxC-1   
Do 303 J=2,NYmaxC-1
Do 303 J=2,NYmaxC-1
-
 
+
        Dx_c(i,j) = X(i,j) - X(i-1,j)
-
    Dx_c(i,j) = X(i,j) - X(i-1,j)
+
      Dy_c(i,j) = Y(i,j) - Y(i,j-1)
      Dy_c(i,j) = Y(i,j) - Y(i,j-1)
-
 
-
 
303 continue
303 continue
-
 
Return
Return
End
End
</pre>
</pre>

Latest revision as of 14:51, 19 May 2016


!Sample program for solving Lid-driven cavity flow test using SIMPLE-algorithm
! Calculation of Xc and Yc with possibility for further development modul
!Copyright (C) 2010  Michail Kiričkov
!Copyright (C) 2016  Michail Kiričkov, Kaunas University for Technology

!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.

!**********************************************************************
!**********************************************************************
Subroutine Geom
include 'icomm_1.f90'
! calculation Xc,Yc
! ------------------------------------------------------------------------ 	
	do  2 I=2,NXmax
        do  2 J=2,NYmax
     	    Xc(I,J)=(  X(i-1,j-1) + X(i-1,j  ) + &
     	               X(i  ,j  ) + X(i  ,j-1)      ) * 0.25 
    	    Yc(I,J)=(  Y(i-1,j-1) + Y(i-1,j  ) + &
             	       Y(i  ,j  ) + Y(i  ,j-1)     ) * 0.25 
	2 continue
! ------------------------------------------------------------------------ 	
	do 4 I=2,NXmax
		Xc(i,1      ) = ( X(i  ,1    ) + X(i-1,1    ) ) * 0.5
		Xc(i,NYmax+1) = ( X(i  ,NYmax) + X(i-1,NYmax) ) * 0.5
		Yc(i,1      ) = ( Y(i  ,1    ) + Y(i-1,1    ) ) * 0.5
		Yc(i,NYmax+1) = ( Y(i  ,NYmax) + Y(i-1,NYmax) ) * 0.5
	4 continue 
! ------------------------------------------------------------------------ 	
	Xc(1      ,      1) = X(    1,    1)
	Xc(NXmax+1,      1) = X(NXmax,    1)
	Xc(      1,NYmax+1) = X(    1,NYmax)
	Xc(NXmax+1,NYmax+1) = X(NXmax,NYmax)
	Yc(1      ,      1) = Y(    1,    1)
	Yc(NXmax+1,      1) = Y(NXmax,    1)
	Yc(      1,NYmax+1) = Y(    1,NYmax)
	Yc(NXmax+1,NYmax+1) = Y(NXmax,NYmax)
!--------------------------------------------------------------------------
	do 5 J=2,NYmax
		Yc(1      ,j ) = ( Y(1     ,j) + Y(1    ,j-1) ) * 0.5
		Yc(NXmax+1,j ) = ( Y(NXmax ,j) + Y(NXmax,j-1) ) * 0.5
		Xc(1      ,j ) = ( X(1     ,j) + X(1    ,j-1) ) * 0.5
		Xc(NXmax+1,j ) = ( X(NXmax ,j) + X(NXmax,j-1) ) * 0.5
	5 continue 
! ------------------------------------------------------------------------ 	
! Xi (vertical) 
	Do 101 I=1,NXmax  
	Do 101 J=1,NYmax-1
		X_xi(I,J) = X(i  ,j+1) - X(i  ,j  )
		Y_xi(I,J) = Y(i  ,j+1) - Y(i  ,j  ) 
101 continue 

    ! Eta (horisontal) 
	Do 102 I=1,NXmax-1
	Do 102 J=1,NYmax  
		X_et(I,J) = X(i+1,j  ) - X(i  ,j  )
		Y_et(I,J) = Y(i+1,j  ) - Y(i  ,j  )
	102 continue
!--------------------------------------------------------------------------
! Xi (vertical) 
	Do 201 I=1,NXmaxC 
	Do 201 J=1,NYmax
		Del_X_xi(i  ,j  ) =  Xc(i  ,j+1) - Xc(i  ,j  )
		Del_Y_xi(i  ,j  ) =  Yc(i  ,j+1) - Yc(i  ,j  ) 
	201 continue
! Eta (horisontal) 
	Do 202 I=1,NXmax 
	Do 202 J=1,NYmaxC
		Del_X_et(i  ,j  ) =  Xc(i+1,j  ) - Xc(i  ,j  ) 
		Del_Y_et(i  ,j  ) =  Yc(i+1,j  ) - Yc(i  ,j  ) 
	202 continue
!--------------------------------------------------------------------------
	Do 303 I=2,NXmaxC-1   
	Do 303 J=2,NYmaxC-1
         Dx_c(i,j) = X(i,j) - X(i-1,j)
 	     Dy_c(i,j) = Y(i,j) - Y(i,j-1)
	303 continue
Return
End

My wiki