File: Modified.f

package info (click to toggle)
xdmf 3.0%2Bgit20160803-3
  • links: PTS
  • area: main
  • in suites: stretch
  • size: 35,388 kB
  • ctags: 36,627
  • sloc: ansic: 265,382; cpp: 162,889; python: 10,976; f90: 1,378; yacc: 687; fortran: 464; xml: 200; java: 187; lex: 125; makefile: 82; sh: 28
file content (220 lines) | stat: -rw-r--r-- 5,195 bytes parent folder | download | duplicates (4)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C Create a Grid of Hexahedron Centered at 0,0,0
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
	SUBROUTINE CreateGrid( IDIM, JDIM, KDIM, XYZ, ICONN )

	INTEGER IDIM, JDIM, KDIM
	REAL*8	XYZ
	DIMENSION XYZ( 3, IDIM, JDIM, KDIM )
	INTEGER ICONN
	DIMENSION ICONN ( 8, ( IDIM - 1 ) * ( JDIM - 1 ) * ( KDIM - 1 ))

	INTEGER I, J, K, IDX
	REAL*8	X, Y, Z, DX, DY, DZ
	

C	Print *, 'Size = ', IDIM, JDIM, KDIM
	PRINT *, 'Initialze Problem'

C XYZ Values of Nodes
C  From -1 to 1
	DX = 2.0 / ( IDIM - 1 )
	DY = 2.0 / ( JDIM - 1 )
	DZ = 2.0 / ( KDIM - 1 )
	Z = -1.0
	DO 112 K= 1, KDIM
	Y = -1.0
	DO 111 J= 1, JDIM
	X = -1.0
	DO 110 I= 1, IDIM
	XYZ( 1, I, J, K ) = X
	XYZ( 2, I, J, K ) = Y
	XYZ( 3, I, J, K ) = Z
	X =  X + DX
110	CONTINUE
	Y =  Y + DY
111	CONTINUE
	Z =  Z + DZ
112	CONTINUE

C Connections
	IDX = 1
	DO 122 K= 0, KDIM - 2
	DO 121 J= 0, JDIM - 2
	DO 120 I= 1, IDIM - 1

	ICONN( 1, IDX ) = ( K * JDIM * IDIM ) + ( J * IDIM ) + I
	ICONN( 2, IDX ) = ( K * JDIM * IDIM ) + ( J * IDIM ) + I + 1
	ICONN( 3, IDX ) = ( ( K + 1 )  * JDIM * IDIM ) + ( J * IDIM ) + I + 1
	ICONN( 4, IDX ) = ( ( K + 1 )  * JDIM * IDIM ) + ( J * IDIM ) + I
	ICONN( 5, IDX ) = ( K * JDIM * IDIM ) + ( ( J + 1 ) * IDIM ) + I
	ICONN( 6, IDX ) = ( K * JDIM * IDIM ) + ( ( J + 1 )  * IDIM ) + I + 1
	ICONN( 7, IDX ) = ( ( K + 1 )  * JDIM * IDIM ) +
     C 		( ( J + 1 ) * IDIM ) + I + 1
	ICONN( 8, IDX ) = ( ( K + 1 )  * JDIM * IDIM ) +
     C 		( ( J + 1 ) * IDIM ) + I
	IDX = IDX + 1
120	CONTINUE
121	CONTINUE
122	CONTINUE


	RETURN
	END

CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C Create a Node Centered Solution Field
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
	SUBROUTINE NodeData( IDIM, JDIM, KDIM, XYZ, NCVALUES)

	INTEGER IDIM, JDIM, KDIM
	REAL*8	XYZ
	DIMENSION XYZ( 3, IDIM, JDIM, KDIM )
	REAL*8 NCVALUES
	DIMENSION NCVALUES( IDIM, JDIM, KDIM )

	INTEGER I, J, K
	REAL*8 X, Y, Z

	PRINT *, 'Calculating Node Centered Data'

	DO 212, K=1, KDIM
	DO 211, J=1, JDIM
	DO 210, I=1, IDIM
		X = XYZ( 1, I, J, K )
		Y = XYZ( 2, I, J, K )
		Z = XYZ( 3, I, J, K )
		NCVALUES( I, J, K ) = SQRT( ( X * X ) + ( Y * Y ) + ( Z * Z ))
210	CONTINUE
211	CONTINUE
212	CONTINUE

	RETURN
	END

CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C Create a Cell Centered Solution Field
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
	SUBROUTINE CellData( IDIM, JDIM, KDIM, ITER, KICKER, XYZ, CCVALUES)

	INTEGER IDIM, JDIM, KDIM, ITER, KICKER
	REAL*8	XYZ
	DIMENSION XYZ( 3, IDIM, JDIM, KDIM )
	REAL*8 CCVALUES
	DIMENSION CCVALUES( IDIM - 1, JDIM - 1, KDIM - 1 )

	INTEGER I, J, K

	PRINT *, 'Calculating Cell Centered Data for Iteration ', ITER
	DO 312, K=1, KDIM - 1
	DO 311, J=1, JDIM - 1
	DO 310, I=1, IDIM - 1
		X = XYZ( 1, I, J, K )
		CCVALUES( I, J, K ) = 
     C			SIN( ( ( X + 1 ) * IDIM * KICKER ) / 3 * ITER ) / 
     C				EXP( X / ( 1.0 * ITER )  )
310	CONTINUE
311	CONTINUE
312	CONTINUE

C  Waste Time
	DO 313 I=1, 1000000
		X = 0.1 * ITER / I
		Y = SQRT( X * X )
		Z = EXP( Y )
		
313	CONTINUE

	RETURN
	END

CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C Main Program :
C	Initialize Grid
C	Initialize Node Centered Data
C	For Iteration = 1 to 10
C		Generate Cell Centered Data
C	Done
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
	PROGRAM	HexMesh

	PARAMETER ( IDIM = 11 )
	PARAMETER ( JDIM = 13 )
	PARAMETER ( KDIM = 15 )

	REAL*8	XYZ
	DIMENSION XYZ( 3, IDIM, JDIM, KDIM )

	REAL*8	NCVALUES
	DIMENSION NCVALUES( IDIM, JDIM, KDIM )

	REAL*8	CCVALUES
	DIMENSION CCVALUES( IDIM - 1, JDIM - 1, KDIM - 1 )

	INTEGER ICONN
	DIMENSION ICONN ( 8, ( IDIM - 1 ) * ( JDIM - 1 ) * ( KDIM - 1 ))

	INTEGER ITER, KICKER, NITER, NARG
	INTEGER IUNIT
	CHARACTER*80	ARGIN

	
	NARG = IARGC()
	IF( NARG .GE. 1 ) THEN
		CALL GETARG( 1, ARGIN )
		READ( ARGIN, '(I)') NITER
	ELSE
		NITER = 10
	ENDIF
	CALL CreateGrid ( IDIM, JDIM, KDIM, XYZ, ICONN )
	CALL NodeData( IDIM, JDIM, KDIM, XYZ, NCVALUES)

CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C Added Routines to Write Out HDF5 via XDMF
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC

	IUNIT = 14
	OPEN( IUNIT, FILE='XYZ.dat', STATUS='unknown' )
	REWIND IUNIT
	WRITE ( IUNIT, * ) IDIM * JDIM * KDIM
	WRITE ( IUNIT, * ) XYZ
	CLOSE (  IUNIT )

	IUNIT = 14
	OPEN( IUNIT, FILE='CONN.dat', STATUS='unknown' )
	REWIND IUNIT
	WRITE ( IUNIT, * ) 'Hex', ( IDIM - 1 ) * ( JDIM - 1 ) * ( KDIM - 1 )
	WRITE ( IUNIT, * ) ICONN
	CLOSE (  IUNIT )

	IUNIT = 14
	OPEN( IUNIT, FILE='NodeValues.dat', STATUS='unknown' )
	REWIND IUNIT
	WRITE ( IUNIT, * ) NCVALUES
	CLOSE (  IUNIT )

	IUNIT = 14
	OPEN( IUNIT, FILE='CellValues.dat', STATUS='unknown' )
	REWIND IUNIT

	INHEX = ( IDIM - 1 )  * ( JDIM - 1 ) * ( KDIM - 1 )
	INPNT = IDIM * JDIM * KDIM
	KICKER = NITER
	DO 1000 ITER = 1, NITER
		CALL CellData( IDIM, JDIM, KDIM, ITER, KICKER, XYZ, CCVALUES)
		WRITE ( IUNIT, * ) CCVALUES
		CALL XDMFWRITE( 'Demo', ITER, INPNT, INHEX, XYZ, ICONN, NCVALUES, CCVALUES)
1000	CONTINUE
	CLOSE (  IUNIT )

	END