MOAB: Mesh Oriented datABase  (version 5.5.0)
ScdMeshF77.F
Go to the documentation of this file.
1 ! MOAB structured mesh extension test
2 !
3 ! This test also tests fortran free-source format
4 !
5 
6 #define ERROR(rval) if (0 .ne. rval) call exit(1)
7 
8  real function reinterpret_ptr(xm, ni, nj, nk)
9  integer ni, nj, nk
10  real xm(ni, nj, nk)
11 
12  reinterpret_ptr = 0.0
13  do 10 k = 1, nk
14  do 10 j = 1, nj
15  do 10 i = 1, ni
16  reinterpret_ptr = reinterpret_ptr + xm(i, j, k)
17  10 continue
18  return
19  end
20 
21  program scdmesh
22  implicit none
23  integer comm1, mysize,myproc,ier
24 #include "iMesh_f.h"
25  imesh_instance mesh
26  ibase_entitysethandle handle
27  ibase_entityhandle root_set
28  ibase_taghandle tagh
29  ibase_entityarriterator iter
30  integer local_dims(6),global_dims(6)
31  integer geom_dim,num_regions, num_verts, num_quads, count
32  integer*8 rpxm1
33  integer i
34  real rsum
35  !real, dimension(:) :: xm
36  real xm
37  pointer(rpxm1, xm(*))
38  real reinterpret_ptr
39 
40  ! declarations
41 
42  ! create the Mesh instance
43 
44  local_dims(1)=0
45  local_dims(2)=0
46  local_dims(3)=-1
47  local_dims(4)=64
48  local_dims(5)=64
49  local_dims(6)=-1
50 
51  global_dims(1)=0
52  global_dims(2)=0
53  global_dims(3)=-1
54  global_dims(4)=64
55  global_dims(5)=64
56  global_dims(6)=-1
57 
58  call imesh_newmesh('MOAB', mesh, ier)
59  error(ier)
60 
61  handle = 0
62  call imesh_createstructuredmesh(%VAL(mesh), local_dims,
63  1 global_dims, %VAL(0),%VAL(0),%VAL(0), %VAL(1), %VAL(-1),
64  1 %VAL(-1), %VAL(-1), %VAL(0), %VAL(1), %VAL(1), handle, ier)
65  error(ier)
66 
67  call imesh_getrootset(%VAL(mesh), root_set, ier)
68  error(ier)
69 
70  call imesh_getgeometricdimension(%VAL(mesh), geom_dim, ier)
71  error(ier)
72 
73  call imesh_getnumoftype(%VAL(mesh), %VAL(root_set),
74  1 %VAL(ibase_face), num_quads, ier)
75  error(ier)
76 
77  call imesh_getnumoftype(%VAL(mesh), %VAL(root_set),
78  1 %VAL(ibase_vertex), num_verts, ier)
79  error(ier)
80 
81 
82  call imesh_initentarriter(%VAL(mesh), %VAL(root_set),
83  1 %VAL(ibase_face), %VAL(imesh_quadrilateral),%VAL(num_quads),
84  1 %VAL(0), iter, ier)
85 
86  call imesh_createtagwithoptions(%VAL(mesh), "XM1",
87  1 "moab:TAG_STORAGE_TYPE=DENSE; moab:TAG_DEFAULT_VALUE=0.0",
88  1 %VAL(5), %VAL(ibase_double), tagh, ier)
89 
90  call imesh_tagiterate(%VAL(mesh),%VAL(tagh),%VAL(iter),rpxm1,
91  1 count,ier)
92 
93  call imesh_endentarriter(%VAL(mesh), %VAL(iter), ier)
94  error(ier)
95 
96  do 20 i = 1, 5*64*64
97  xm(i) = 1.0
98  20 continue
99 
100  rsum = reinterpret_ptr(xm, 5, 64, 64)
101 
102  call imesh_dtor(%VAL(mesh), ier)
103  error(ier)
104 
105  if (rsum .ne. 5*64*64) call exit(1)
106 
107  call exit(0)
108  end