fathom/moab-docs-develop/ScdMeshF90_8F90_source.html

00001 ! MOAB structured mesh extension test
00002 !
00003 ! This test also tests fortran free-source format
00004 !
00005
00006 #define ERROR(rval) if (0 .ne. rval) call exit(1)
00007
00008 real function reinterpret_ptr(xm, ni, nj, nk)
00009 integer :: ni, nj, nk
00010 real, dimension(ni, nj, nk) :: xm
00011
00012 reinterpret_ptr = 0.0
00013 do k = 1, nk
00014    do j = 1, nj
00015       do i = 1, ni
00016          reinterpret_ptr = reinterpret_ptr + xm(i, j, k)
00017       end do
00018    end do
00019 end do
00020 end function reinterpret_ptr
00021
00022 program ScdMeshF90
00023 implicit none
00024 integer comm1, mysize,myproc,ier
00025 #include "iMesh_f.h"
00026 iMesh_Instance ::  mesh
00027 iBase_EntitySetHandle :: handle
00028 iBase_EntityHandle :: root_set
00029 iBase_EntityArrIterator :: iter
00030 iBase_TagHandle :: tagh
00031 integer :: local_dims(6),global_dims(6)
00032 integer :: geom_dim, num_verts, count, i, num_quads, rsum
00033 real xm
00034 pointer (rpxm1, xm(*))
00035 real reinterpret_ptr
00036
00037 ! declarations
00038
00039 ! create the Mesh instance
00040
00041 local_dims(1)=0
00042 local_dims(2)=0
00043 local_dims(3)=-1
00044 local_dims(4)=64
00045 local_dims(5)=64
00046 local_dims(6)=-1
00047
00048 global_dims(1)=0
00049 global_dims(2)=0
00050 global_dims(3)=-1
00051 global_dims(4)=64
00052 global_dims(5)=64
00053 global_dims(6)=-1
00054
00055 call iMesh_newMesh('MOAB', mesh, ier); ERROR(ier);
00056
00057 handle = 0
00058 call iMesh_createStructuredMesh(%VAL(mesh), local_dims, global_dims, %VAL(0),%VAL(0),%VAL(0), %VAL(1), %VAL(-1), &
00059   %VAL(-1), %VAL(-1), %VAL(0), %VAL(1), %VAL(1), handle, ier); ERROR(ier);
00060
00061 call iMesh_getRootSet(%VAL(mesh), root_set, ier); ERROR(ier);
00062
00063 call iMesh_getGeometricDimension(%VAL(mesh), geom_dim, ier); ERROR(ier);
00064
00065 call iMesh_getNumOfType(%VAL(mesh), %VAL(root_set), %VAL(iBase_FACE), num_quads, ier); ERROR(ier);
00066
00067 call iMesh_getNumOfType(%VAL(mesh), %VAL(root_set), %VAL(iBase_VERTEX), num_verts, ier); ERROR(ier);
00068
00069 call iMesh_initEntArrIter(%VAL(mesh), %VAL(root_set), %VAL(iBase_FACE), %VAL(iMesh_QUADRILATERAL),%VAL(num_quads), &
00070   %VAL(0), iter, ier); ERROR(ier);
00071
00072 call iMesh_createTagWithOptions(%VAL(mesh), "XM1", "moab:TAG_STORAGE_TYPE=DENSE; moab:TAG_DEFAULT_VALUE=0.0", &
00073   %VAL(5), %VAL(iBase_DOUBLE), tagh, ier); ERROR(ier);
00074
00075 call iMesh_tagIterate(%VAL(mesh), %VAL(tagh), %VAL(iter), rpxm1, count, ier); ERROR(ier);
00076
00077 call iMesh_endEntArrIter(%VAL(mesh), %VAL(iter), ier); ERROR(ier);
00078
00079 do i = 1, 5*64*64
00080   xm(i) = 1.0
00081 end do
00082
00083 rsum = reinterpret_ptr(xm, 5, 64, 64)
00084
00085 call iMesh_dtor(%VAL(mesh), ier); ERROR(ier);
00086
00087 if (rsum .ne. 5*64*64) call exit(1)
00088
00089 call exit(0)
00090 end