C*******************************************************************
C**
C** v e m g e n 3 d :
C**
C** generation of a subdivision of a 3-dimensional domain with
C** well-known boundaries into hexahedron elements. The program
C** can easily changed for other problems. The mesh data is read
C** by vemu02.
C**
C** by L. Grosz Karlsruhe, Oct. 1994
C**
C**
C*******************************************************************
C** B4
C** (0,1,1) / (1,1,1)
C** *----------*
C** / : B6 / |
C** / : / |
C** B5 *----------* B3 |
C** \ | *----|-----* (1,1,0)
C** | / | /
C** | / B2 | /
C** *----------*
C** xi3 ^ xi2 \ (1,0,0)
C** | / B1
C** --xi1
C**
C** This FORTRAN program generates an order 2 subdivison of a
C** three dimensional domain into hexahedron elements. The domain
C** has a parametrical representation whose domain is the unit
C** cube [0,1]^3 in the variables (xi1,xi2,xi3). There are six
C** boundary portions numbered from 1 to 6. Boundary 1 is
C** represented by xi3=0, boundary 2 is represented by xi2=0,
C** boundary 3 is represented by xi1=1, boundary 4 is represented
C** by xi2=1, boundary 5 is represented by xi1=0 and boundary 6
C** is reprsented by xi3=1. The parametrical representation
C** of the domain is computed from the parametrical representions
C** F1 and F6 of boundary 1 and 6 by a linear interpolation.
C** The code can be adapted to other domains by entering suitable
C** statements for F1 and F6 into the node generation.
C**
C** The boundaries are subdivied into quadrilateral elements of
C** order 2 and additionally all boundary nodes are specified as
C** nodes with Dirichlet conditions. Since the Dirichlet
C** conditions has the higher priority, the line elements will be
C** useless in the vecfem application. But if you want to activate
C** special boundary elements, you can remove the
C** corresponding boundary nodes from the generation of the
C** Dirichlet conditions.
C**
PROGRAM VEMEXM
C**
C**-----------------------------------------------------------------
C**
IMPLICIT NONE
C**
C**-----------------------------------------------------------------
C**
C** some parameters which may be chanced:
C**
C** ELEM1 = number of elements in x1 direction
C** ELEM2 = number of elements in x2 direction
C** ELEM3 = number of elements in x3 direction
C** NK = number of solution components
C** MESH = name of the mesh file
C**
INTEGER ELEM1,ELEM2,ELEM3,NK
CHARACTER*80 MESH
PARAMETER (NK=4)
C***
INTEGER Z1,Z2,Z3,N1,N2,N3,S,ELMID,D,IND
DOUBLE PRECISION X1,X2,X3,XI1,XI2,XI3,F11,F12,F13,F61,F62,F63,PI,
& ZERO,VALUE
ZERO=0
IND=1
C**
C**-----------------------------------------------------------------
C**
PRINT*,'Enter number of elements in x1- , x2- and x3- direction:'
READ(5,*) ELEM1,ELEM2,ELEM3
PRINT*,'Name of the mesh file :'
READ(5,'(80A)') MESH
C**
C**-----------------------------------------------------------------
C**
C** open output file :
C**
OPEN (99,FILE=MESH,STATUS='UNKNOWN',FORM='FORMATTED')
PRINT*,'opened file : ',MESH
C**
C**-----------------------------------------------------------------
C**
C**** the generation of the geometrical nodes :
C** ---------------------------------------
C**
C** The grid is rectangular in the domain [0,1]^3 of the
C** parametrical representation of the actual domain, where Ni
C** is the number points in XIi direction (i=1,2,3):
C**
N1=2*ELEM1+1
N2=2*ELEM2+1
N3=2*ELEM3+1
WRITE(99,*) N1*N2*N3
C**
DO 10 Z3=1,N3
DO 10 Z2=1,N2
DO 10 Z1=1,N1
XI1=DBLE(Z1-1)/DBLE(N1-1)
XI2=DBLE(Z2-1)/DBLE(N2-1)
XI3=DBLE(Z3-1)/DBLE(N3-1)
C**
C**-----------------------------------------------------------------
C**
C** here you can change the shape of the domain :
C**
C**
C** F6(0,1) *----------* F6(1,1)
C** / : B6 / |
C** / : / | if you set :
C** F6(0,0) *----------* F6(1,0)
C** | *----|-----* F1(1,1) F11=XI1 F12=XI2 F13=0
C** | / | / F61=XI1 F62=XI2 F63=1
C** | / | /
C** F1(0,0) *----------* F1(1,0) you will get the unit
C** / cube [0,1]^3.
C** B1
C**
C** Here we generate a curved channel with the unit square
C** as sectional area. There are straight inlet and outlet
C** of length 1. The inner radius of the curved section is
C** 1 and the outer radius is 2.
C**
C** ------,
C** / ,
C** 3 -|----- , ,
C** | ' ,
C** 2 -|----- . . , ,
C** . , |
C** 1 -- | | |
C** / | |/
C** 0 -| | ------
C** 0 1 2 3
C**
PI=4.*ATAN(1.D0)
IF (XI1.LE.1.D0/3) THEN
F11=XI1*3
F12=XI2
F13=2.
F61=XI1*3
F62=XI2
F63=3.
ELSEIF (XI1.LE.2.D0/3) THEN
F11=1.D0+SIN((XI1*3-1)*PI/2)
F12=XI2
F13=1.D0+COS((XI1*3-1)*PI/2)
F61=1.+2.D0*SIN((XI1*3-1)*PI/2)
F62=XI2
F63=1.+2.D0*COS((XI1*3-1)*PI/2)
ELSE
F11=2.
F12=XI2
F13=3*(1.-XI1)
F61=3.
F62=XI2
F63=3*(1.-XI1)
ENDIF
C**
C**-----------------------------------------------------------------
C**
X1=(1.-XI3)*F11+F61*XI3
X2=(1.-XI3)*F12+F62*XI3
X3=(1.-XI3)*F13+F63*XI3
WRITE(99,*) Z1+N1*(Z2-1)+N1*N2*(Z3-1),X1,X2,X3
10 CONTINUE
C**
PRINT*,'written nodes : ',N1*N2*N3
C**
C**-----------------------------------------------------------------
C**
C**** the generation of the elements :
C** -------------------------------
C**
C** The domain is covered by hexahedron elements of order 2
C** and consequently the boundaries are described by
C** quadrilateral elements of order 2. The succesion of the
C** nodes in the element is defined in vemu02 and vembuild(3).
C** The lowest node id in an element is S.
C**
C** There are two different element types:
C**
WRITE(99,*) 2
C**
C** These are the hexahedron elements:
C**
C** ELMID is the element id number, which allows to recognize
C** an element after the distribution to the processors.
C**
WRITE(99,*) ELEM1*ELEM2*ELEM3,3,8,20
DO 20 Z3=1,ELEM3
DO 20 Z2=1,ELEM2
DO 20 Z1=1,ELEM1
S=2*(Z1-1)+2*(Z2-1)*N1+2*N1*N2*(Z3-1)+1
ELMID=Z1+ELEM1*(Z2-1)+ELEM1*ELEM2*(Z3-1)
WRITE(99,'(22I5)') ELMID,IND,
& S,S+2,S+2*N1+2,S+2*N1,
& S+2*N1*N2,S+2*N1*N2+2,S+2*N1*N2+2*N1+2,S+2*N1*N2+2*N1,
& S+1,S+N1+2,S+2*N1+1,S+N1,
& S+N1*N2,S+N1*N2+2,S+N1*N2+2*N1+2,S+N1*N2+2*N1,
& S+2*N1*N2+1,S+2*N1*N2+N1+2,S+2*N1*N2+2*N1+1,S+2*N1*N2+N1
20 CONTINUE
C**
PRINT*,'written hexahedron elements : ',ELEM1*ELEM2*ELEM3
C**
C**-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
C**
C** These are the quadrilateral elements:
C**
WRITE(99,*) 2*(ELEM1*ELEM2+ELEM1*ELEM3+ELEM2*ELEM3),2,4,8
C**
DO 31 Z2=1,ELEM2
DO 31 Z1=1,ELEM1
C**
C**** elements on boundary 1:
C**
S=2*(Z1-1)+2*(Z2-1)*N1+1
ELMID=Z1+ELEM1*(Z2-1)+ELEM1*ELEM2*ELEM3
WRITE(99,*) ELMID,IND,
& S,S+2*N1,S+2*N1+2,S+2,S+N1,S+2*N1+1,S+N1+2,S+1
C**
C**** elements on boundary 6:
C**
S=2*(Z1-1)+2*(Z2-1)*N1+2*N1*N2*ELEM3+1
ELMID=Z1+ELEM1*(Z2-1)+ELEM1*ELEM2+ELEM1*ELEM2*ELEM3
WRITE(99,*) ELMID,IND,
& S,S+2,S+2*N1+2,S+2*N1,S+1,S+N1+2,S+2*N1+1,S+N1
31 CONTINUE
DO 32 Z3=1,ELEM3
DO 32 Z2=1,ELEM2
C**
C**** elements on boundary 5:
C**
S=2*(Z2-1)*N1+2*N1*N2*(Z3-1)+1
ELMID=Z2+ELEM2*(Z3-1)+2*ELEM1*ELEM2+ELEM1*ELEM2*ELEM3
WRITE(99,*) ELMID,IND,
& S,S+2*N1*N2,S+2*N1*N2+2*N1,S+2*N1,
& S+N1*N2,S+2*N1*N2+N1,S+N1*N2+2*N1,S+N1
C**
C**** elements on boundary 3:
C**
S=2*ELEM1+2*(Z2-1)*N1+2*N1*N2*(Z3-1)+1
ELMID=Z2+ELEM2*(Z3-1)+
& ELEM2*ELEM3+2*ELEM1*ELEM2+ELEM1*ELEM2*ELEM3
WRITE(99,*) ELMID,IND,
& S,S+2*N1,S+2*N1*N2+2*N1,S+2*N1*N2,
& S+N1,S+N1*N2+2*N1,S+2*N1*N2+N1,S+N1*N2
32 CONTINUE
DO 33 Z3=1,ELEM3
DO 33 Z1=1,ELEM1
C**
C**** elements on boundary 2:
C**
S=2*(Z1-1)+2*N1*N2*(Z3-1)+1
ELMID=Z3+ELEM3*(Z1-1)+
& 2*ELEM2*ELEM3+2*ELEM1*ELEM2+ELEM1*ELEM2*ELEM3
WRITE(99,*) ELMID,IND,
& S,S+2,S+2*N2*N1+2,S+2*N1*N2,
& S+1,S+N1*N2+2,S+2*N2*N1+1,S+N1*N2
C**
C**** elements on boundary 4:
C**
S=2*(Z1-1)+2*ELEM2*N1+2*N1*N2*(Z3-1)+1
ELMID=Z3+ELEM3*(Z1-1)+
& ELEM1*ELEM3+2*ELEM2*ELEM3+2*ELEM1*ELEM2+ELEM1*ELEM2*ELEM3
WRITE(99,*) ELMID,IND,
& S,S+2*N1*N2,S+2*N1*N2+2,S+2,
& S+N1*N2,S+2*N2*N1+1,S+N1*N2+2,S+1
33 CONTINUE
C**
PRINT*,'written quadrilateral elements : ',
& 2*(ELEM1*ELEM2+ELEM1*ELEM3+ELEM2*ELEM3)
C**
C**-----------------------------------------------------------------
C**
C** generation of the nodes with Dirichlet conditions :
C** -------------------------------------------------
C**
C** Here we generate the Dirichlet conditions for 3D Navier-
C** Stokes equation. The components 1,2,3 are the velocity
C** compontents in x1,x2,x3 direction. The velocity is prescribed
C** on the total boundary. The fourth component is the pressure,
C** which is set on a single point. The real parameter is used
C** to specify the velocity at the inlet (v1,v2,v3)=(val,0,0,0)
C** and the outlet (v1,v2,v3)=(0,val,0), where val is the
C** parabolic bubble over the sectional area. The program can be
C** easily adapted to other nodes selections and other input or
C** output profiles.
C**
WRITE(99,*) NK
C**
C** First the velocity components 1,2,3 :
C**
DO 40 D=1,NK-1
C**
WRITE(99,*) 2*((N1-1)*(N2-1)+(N1-1)*(N3-1)+(N2-1)*(N3-1)+1)
C**
DO 41 Z2=1,N2-1
DO 41 Z1=1,N1-1
WRITE(99,*) Z1+N1*(Z2-1),ZERO
WRITE(99,*) N1*N2*N3+1-Z1-N1*(Z2-1),ZERO
41 CONTINUE
DO 42 Z3=1,N3-1
DO 42 Z1=1,N1-1
WRITE(99,*) N1*N2*(N3-1)-N1*N2*(Z3-1)+Z1,ZERO
WRITE(99,*) N1*N2*Z3-Z1+1,ZERO
42 CONTINUE
DO 43 Z3=1,N3-1
DO 43 Z2=1,N2-1
XI2=DBLE(Z2-1)/DBLE(N2-1)
XI3=DBLE(Z3-1)/DBLE(N3-1)
VALUE=XI2*(XI2-1)*XI3*(XI3-1)*16
IF (D.EQ.1) THEN
WRITE(99,*) N1*N2*N3-N1*N2*(Z3-1)-N1*Z2+1,VALUE
WRITE(99,*) N1*N2*(Z3-1)+N1*Z2,ZERO
ELSEIF (D.EQ.3) THEN
WRITE(99,*) N1*N2*N3-N1*N2*(Z3-1)-N1*Z2+1,ZERO
WRITE(99,*) N1*N2*(Z3-1)+N1*Z2,-VALUE
ELSE
WRITE(99,*) N1*N2*N3-N1*N2*(Z3-1)-N1*Z2+1,ZERO
WRITE(99,*) N1*N2*(Z3-1)+N1*Z2,ZERO
ENDIF
43 CONTINUE
WRITE(99,*) N1*(N2-1)+1,ZERO
WRITE(99,*) N1*N2*(N3-1)+N1,ZERO
C**
PRINT*,2*((N1-1)*(N2-1)+(N1-1)*(N3-1)+(N2-1)*(N3-1)+1),
& ' Dirichlet conditions for component ',d
40 CONTINUE
C**
C** Only one Dirichlet condition for the fourth component:
C**
WRITE(99,*) 1
WRITE(99,*) 2*((ELEM1+1)/2-1)+2*((ELEM2+1)/2-1)*N1+
& 2*N1*N2*((ELEM2+1)/2-1)+1,ZERO
PRINT*,1,' Dirichlet condition for component ',NK
C**
C**-----------------------------------------------------------------
C**
C**** end of calculation
C** ------------------
C**
E N D