moab
|
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_regions, 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_regions, 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 do i = 1, 5*64*64 00078 xm(i) = 1.0 00079 end do 00080 00081 rsum = reinterpret_ptr(xm, 5, 64, 64) 00082 00083 if (rsum .ne. 5*64*64) call exit(1) 00084 00085 call exit(0) 00086 end