ScdMeshF90.F90

Go to the documentation of this file.

! MOAB structured mesh extension test
! 
! This test also tests fortran free-source format
!
 
#define ERROR(rval) if (0 .ne. rval) call exit(1)
 
real function reinterpret_ptr(xm, ni, nj, nk)
integer :: ni, nj, nk
real, dimension(ni, nj, nk) :: xm
 
reinterpret_ptr = 0.0
do k = 1, nk
 do j = 1, nj
 do i = 1, ni
 reinterpret_ptr = reinterpret_ptr + xm(i, j, k)
 end do
 end do
end do
end function reinterpret_ptr
 
program scdmeshf90
implicit none
integer comm1, mysize,myproc,ier
#include "iMesh_f.h"
imesh_instance :: mesh
ibase_entitysethandle :: handle
ibase_entityhandle :: root_set
ibase_entityarriterator :: iter
ibase_taghandle :: tagh
integer :: local_dims(6),global_dims(6)
integer :: geom_dim, num_verts, count, i, num_quads, rsum
real xm
pointer(rpxm1, xm(*))
real reinterpret_ptr
 
! declarations
 
! create the Mesh instance
 
local_dims(1)=0
local_dims(2)=0
local_dims(3)=-1
local_dims(4)=64
local_dims(5)=64
local_dims(6)=-1
 
global_dims(1)=0
global_dims(2)=0
global_dims(3)=-1
global_dims(4)=64
global_dims(5)=64
global_dims(6)=-1
 
call imesh_newmesh('MOAB', mesh, ier); error(ier);
 
handle = 0
call imesh_createstructuredmesh(%VAL(mesh), local_dims, global_dims, %VAL(0),%VAL(0),%VAL(0), %VAL(1), %VAL(-1), &
 %VAL(-1), %VAL(-1), %VAL(0), %VAL(1), %VAL(1), handle, ier); error(ier);
 
call imesh_getrootset(%VAL(mesh), root_set, ier); error(ier);
 
call imesh_getgeometricdimension(%VAL(mesh), geom_dim, ier); error(ier);
 
call imesh_getnumoftype(%VAL(mesh), %VAL(root_set), %VAL(ibase_face), num_quads, ier); error(ier);
 
call imesh_getnumoftype(%VAL(mesh), %VAL(root_set), %VAL(ibase_vertex), num_verts, ier); error(ier);
 
call imesh_initentarriter(%VAL(mesh), %VAL(root_set), %VAL(ibase_face), %VAL(imesh_quadrilateral),%VAL(num_quads), &
 %VAL(0), iter, ier); error(ier);
 
call imesh_createtagwithoptions(%VAL(mesh), "XM1", "moab:TAG_STORAGE_TYPE=DENSE; moab:TAG_DEFAULT_VALUE=0.0", &
 %VAL(5), %VAL(ibase_double), tagh, ier); error(ier);
 
call imesh_tagiterate(%VAL(mesh), %VAL(tagh), %VAL(iter), rpxm1, count, ier); error(ier);
 
call imesh_endentarriter(%VAL(mesh), %VAL(iter), ier); error(ier);
 
do i = 1, 5*64*64
 xm(i) = 1.0
end do
 
rsum = reinterpret_ptr(xm, 5, 64, 64)
 
call imesh_dtor(%VAL(mesh), ier); error(ier);
 
if (rsum .ne. 5*64*64) call exit(1)
 
call exit(0)
end