Exodus  7.21
/exodus_for/test/testwt_nsid.f
1 C Copyright (c) 2005-2017 National Technology & Engineering Solutions
2 C of Sandia, LLC (NTESS). Under the terms of Contract DE-NA0003525 with
3 C NTESS, the U.S. Government retains certain rights in this software.
4 C
5 C Redistribution and use in source and binary forms, with or without
6 C modification, are permitted provided that the following conditions are
7 C met:
8 C
9 C * Redistributions of source code must retain the above copyright
10 C notice, this list of conditions and the following disclaimer.
11 C
12 C * Redistributions in binary form must reproduce the above
13 C copyright notice, this list of conditions and the following
14 C disclaimer in the documentation and/or other materials provided
15 C with the distribution.
16 C
17 C * Neither the name of NTESS nor the names of its
18 C contributors may be used to endorse or promote products derived
19 C from this software without specific prior written permission.
20 C
21 C THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
22 C "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
23 C LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
24 C A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
25 C OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
26 C SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
27 C LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
28 C DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
29 C THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
30 C (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
31 C OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
32 C
33 
34  program testwt
35 c
36 c This is a test program for the Fortran binding of the EXODUS II
37 c database write routines.
38 c
39  include 'exodusII.inc'
40 
41  integer iin, iout
42  integer exoid, num_dim,num_nodes,elem_map(7),num_elem,num_elem_blk
43  integer num_elem_in_block(10), num_nodes_per_elem(10),numattr(10)
44  integer num_node_sets, num_side_sets
45  integer i, connect(37), nnpe(10)
46  integer ebids(10)
47  integer num_qa_rec, num_info
48  integer cpu_word_size, io_word_size
49 
50  real x(100), y(100), z(100)
51 
52  character*(MXSTLN) coord_names(3)
53  character*(MXSTLN) cname
54  character*(MXSTLN) qa_record(4,2)
55  character*(MXLNLN) inform(3)
56 
57  data iin /5/, iout /6/
58 
59  call exopts (exabrt, ierr)
60  write (iout,'("after exopts, error = ", i4)') ierr
61  cpu_word_size = 0
62  io_word_size = 0
63 c
64 c create EXODUS II files
65 c
66  exoid = excre("test-nsided.exo",
67  1 exclob, cpu_word_size, io_word_size, ierr)
68  write (iout,'("after excre for test-nsided.exo, id: ", i8)') exoid
69  write (iout,'(" cpu word size: ",i4," io word size: ",i4)')
70  1 cpu_word_size, io_word_size
71  write (iout,'("after excre, error = ", i4)') ierr
72 c
73 c initialize file with parameters
74 c
75  num_dim = 3
76  num_nodes = 33
77  num_elem = 7
78  num_elem_blk = 1
79  num_node_sets = 0
80  num_side_sets = 0
81 
82  call expini (exoid, "This is a test", num_dim, num_nodes,
83  1 num_elem, num_elem_blk, num_node_sets,
84  2 num_side_sets, ierr)
85 
86  write (iout, '("after expini, error = ", i4)' ) ierr
87 
88  if (ierr .ne. 0) then
89  call exclos(exoid,ierr)
90  call exit (0)
91  endif
92 
93 c
94 c write nodal coordinates values and names to database
95 c
96 c Quad #1
97  x(1) = 0.0
98  x(2) = 1.0
99  x(3) = 1.0
100  x(4) = 0.0
101 
102  y(1) = 0.0
103  y(2) = 0.0
104  y(3) = 1.0
105  y(4) = 1.0
106 
107  z(1) = 0.0
108  z(2) = 0.0
109  z(3) = 0.0
110  z(4) = 0.0
111 
112 c Quad #2
113  x(5) = 1.0
114  x(6) = 2.0
115  x(7) = 2.0
116  x(8) = 1.0
117 
118  y(5) = 0.0
119  y(6) = 0.0
120  y(7) = 1.0
121  y(8) = 1.0
122 
123  z(5) = 0.0
124  z(6) = 0.0
125  z(7) = 0.0
126  z(8) = 0.0
127 
128 c Hex #1
129  x(9) = 0.0
130  x(10) = 10.0
131  x(11) = 10.0
132  x(12) = 1.0
133  x(13) = 1.0
134  x(14) = 10.0
135  x(15) = 10.0
136  x(16) = 1.0
137 
138  y(9) = 0.0
139  y(10) = 0.0
140  y(11) = 0.0
141  y(12) = 0.0
142  y(13) = 10.0
143  y(14) = 10.0
144  y(15) = 10.0
145  y(16) = 10.0
146 
147  z(9) = 0.0
148  z(10) = 0.0
149  z(11) =-10.0
150  z(12) =-10.0
151  z(13) = 0.0
152  z(14) = 0.0
153  z(15) =-10.0
154  z(16) =-10.0
155 
156 c Tetra #1
157  x(17) = 0.0
158  x(18) = 1.0
159  x(19) = 10.0
160  x(20) = 7.0
161 
162  y(17) = 0.0
163  y(18) = 0.0
164  y(19) = 0.0
165  y(20) = 5.0
166 
167  z(17) = 0.0
168  z(18) = 5.0
169  z(19) = 2.0
170  z(20) = 3.0
171 
172 c Wedge #1
173  x(21) = 3.0
174  x(22) = 6.0
175  x(23) = 0.0
176  x(24) = 3.0
177  x(25) = 6.0
178  x(26) = 0.0
179 
180  y(21) = 0.0
181  y(22) = 0.0
182  y(23) = 0.0
183  y(24) = 2.0
184  y(25) = 2.0
185  y(26) = 2.0
186 
187  z(21) = 6.0
188  z(22) = 0.0
189  z(23) = 0.0
190  z(24) = 6.0
191  z(25) = 2.0
192  z(26) = 0.0
193 
194 C Tetra #2
195  x(27) = 2.7
196  x(28) = 6.0
197  x(29) = 5.7
198  x(30) = 3.7
199 
200  y(27) = 1.7
201  y(28) = 1.7
202  y(29) = 1.7
203  y(30) = 0.0
204 
205  z(27) = 2.7
206  z(28) = 3.3
207  z(29) = 1.7
208  z(30) = 2.3
209 
210 C 3d Tri
211  x(31) = 0.0
212  x(32) = 10.0
213  x(33) = 10.0
214 
215  y(31) = 0.0
216  y(32) = 0.0
217  y(33) = 10.0
218 
219  z(31) = 0.0
220  z(32) = 0.0
221  z(33) = 10.0
222 
223  call expcor (exoid, x, y, z, ierr)
224  write (iout, '("after expcor, error = ", i4)' ) ierr
225  if (ierr .ne. 0) then
226  call exclos(exoid,ierr)
227  call exit (0)
228  endif
229 
230  coord_names(1) = "xcoor"
231  coord_names(2) = "ycoor"
232  coord_names(3) = "zcoor"
233 
234  call expcon (exoid, coord_names, ierr)
235  write (iout, '("after expcon, error = ", i4)' ) ierr
236  call exupda(exoid,ierr)
237  if (ierr .ne. 0) then
238  call exclos(exoid,ierr)
239  call exit (0)
240  endif
241 
242 
243 c
244 c write element order map
245 c
246 
247  do 10 i = 1, num_elem
248  elem_map(i) = i
249 10 continue
250 
251  call expmap (exoid, elem_map, ierr)
252  write (iout, '("after expmap, error = ", i4)' ) ierr
253  if (ierr .ne. 0) then
254  call exclos(exoid,ierr)
255  call exit (0)
256  endif
257 
258 c
259 c write element block parameters
260 c
261 
262  num_elem_in_block(1) = 7
263 
264  num_nodes_per_elem(1) = 37 ! This is total nodes per block
265 
266  ebids(1) = 10
267 
268  numattr(1) = 0
269 
270  cname = "nsided"
271 
272  call expelb (exoid,ebids(1),cname,num_elem_in_block(1),
273  1 num_nodes_per_elem(1),numattr(1),ierr)
274  write (iout, '("after expelb, error = ", i4)' ) ierr
275  if (ierr .ne. 0) then
276  call exclos(exoid,ierr)
277  call exit (0)
278  endif
279 
280 c
281 c write element connectivity
282 c
283  connect( 1) = 1
284  connect( 2) = 2
285  connect( 3) = 3
286  connect( 4) = 4
287  nnpe(1) = 4
288 
289  connect( 5) = 5
290  connect( 6) = 6
291  connect( 7) = 7
292  connect( 8) = 8
293  nnpe(2) = 4
294 
295  connect( 9) = 9
296  connect(10) = 10
297  connect(11) = 11
298  connect(12) = 12
299  connect(13) = 13
300  connect(14) = 14
301  connect(15) = 15
302  connect(16) = 16
303  nnpe(3) = 8
304 
305  connect(17) = 17
306  connect(18) = 18
307  connect(19) = 19
308  connect(20) = 20
309  nnpe(4) = 4
310 
311  connect(21) = 21
312  connect(22) = 22
313  connect(23) = 23
314  connect(24) = 24
315  connect(25) = 25
316  connect(26) = 26
317  nnpe(5) = 6
318 
319  connect(27) = 17
320  connect(28) = 18
321  connect(29) = 19
322  connect(30) = 20
323  connect(31) = 27
324  connect(32) = 28
325  connect(33) = 30
326  connect(34) = 29
327  nnpe(6) = 8
328 
329  connect(35) = 31
330  connect(36) = 32
331  connect(37) = 33;
332  nnpe(7) = 3
333 
334  call expelc (exoid, ebids(1), connect, ierr)
335  write (iout, '("after expelc, error = ", i4)' ) ierr
336  if (ierr .ne. 0) then
337  call exclos(exoid,ierr)
338  call exit (0)
339  endif
340 
341  call expecpp(exoid, exeblk, ebids(1), nnpe, ierr)
342  write (iout, '("after expecpp, error = ", i4)' ) ierr
343  if (ierr .ne. 0) then
344  call exclos(exoid,ierr)
345  call exit (0)
346  endif
347 c
348 c
349 c write QA records
350 c
351 
352  num_qa_rec = 2
353 
354  qa_record(1,1) = "TESTWT fortran version"
355  qa_record(2,1) = "testwt"
356  qa_record(3,1) = "07/07/93"
357  qa_record(4,1) = "15:41:33"
358  qa_record(1,2) = "FASTQ"
359  qa_record(2,2) = "fastq"
360  qa_record(3,2) = "07/07/93"
361  qa_record(4,2) = "16:41:33"
362 
363  call expqa (exoid, num_qa_rec, qa_record, ierr)
364  write (iout, '("after expqa, error = ", i4)' ) ierr
365  if (ierr .ne. 0) then
366  call exclos(exoid,ierr)
367  call exit (0)
368  endif
369 
370 
371 c
372 c write information records
373 c
374 
375  num_info = 3
376 
377  inform(1) = "This is the first information record."
378  inform(2) = "This is the second information record."
379  inform(3) = "This is the third information record."
380 
381  call expinf (exoid, num_info, inform, ierr)
382  write (iout, '("after expinf, error = ", i4)' ) ierr
383  if (ierr .ne. 0) then
384  call exclos(exoid,ierr)
385  call exit (0)
386  endif
387 
388 c ... Define and write some coordinate frames
389  call putfrm(exoid)
390 
391 c
392 c close the EXODUS files
393 c
394  call exclos (exoid, ierr)
395  write (iout, '("after exclos, error = ", i4)' ) ierr
396 
397  stop
398  end
399 
400  subroutine putfrm(exoid)
401  implicit none
402  include 'exodusII.inc'
403 
404  integer exoid, ierr, i
405  integer numfrm; ! Assumed to be 3 for remaining dimensions
406  integer cfids(3), tags(3)
407  real coord(27)
408 
409  numfrm = 3
410 
411  cfids(1) = 1
412  cfids(2) = 11
413  cfids(3) = 111
414 
415  tags(1) = excfrec
416  tags(2) = excfcyl
417  tags(3) = excfsph
418 
419 ! NOTE: These values may not be sensical; just used for testing.
420  do i=0,2
421  coord(9*i+1) = i+0.1
422  coord(9*i+2) = i+0.2
423  coord(9*i+3) = i+0.3
424  coord(9*i+4) = i+0.4
425  coord(9*i+5) = i+0.5
426  coord(9*i+6) = i+0.6
427  coord(9*i+7) = i+0.7
428  coord(9*i+8) = i+0.8
429  coord(9*i+9) = i+0.9
430  end do
431 
432  call expfrm(exoid, numfrm, cfids, coord, tags, ierr);
433  write (6,'("after expfrm, error = ", i4)') ierr
434 
435  return
436  end