moab
|
00001 ! ListSetsNTags: list sets & tags from a mesh 00002 ! 00003 ! This program shows how to read and list sets and tags from a mesh 00004 ! 00005 ! Usage: SetsNTags <mesh_file_name> 00006 00007 00008 00009 #define ERRORR(a) if (0 .ne. err) print *, a 00010 00011 program ListSetsNTags 00012 00013 #include "iMesh_f.h" 00014 00015 iMesh_Instance mesh 00016 iBase_EntitySetHandle root_set 00017 integer err 00018 00019 IBASE_HANDLE_T rpsets, rptags 00020 pointer (rpsets, sets(0:*)) 00021 pointer (rptags, tags(0:*)) 00022 iBase_EntitySetHandle sets 00023 iBase_TagHandle tags 00024 integer sets_alloc, sets_size, tags_alloc, tags_size 00025 00026 real*8 dbl_val 00027 integer int_val, tag_type 00028 character*128 tname, fname 00029 character*1024 tname2 00030 00031 integer i, j, num_hops, num_commands, tname_len 00032 logical read_par 00033 data read_par/.false./ 00034 00035 num_commands = command_argument_count() 00036 if (num_commands .eq. 0) then 00037 fname = "../MeshFiles/125hex.vtk" 00038 else 00039 call get_command_argument(1, tname, tname_len, err) 00040 if (err .ne. 0) then 00041 ERRORR("Problem getting filename argument.") 00042 call exit 00043 endif 00044 fname = tname 00045 if (num_commands .eq. 2) then 00046 call get_command_argument(2, tname, tname_len, err) 00047 if (err .ne. 0) then 00048 ERRORR("Problem getting filename argument.") 00049 call exit 00050 endif 00051 if (tname(1:1) .eq. 'p' .or. tname(1:1) .eq. 'P') then 00052 read_par = .true. 00053 endif 00054 endif 00055 endif 00056 00057 ! create the Mesh instance 00058 call iMesh_newMesh("", mesh, err) 00059 ERRORR("Error creating new mesh.") 00060 00061 00062 call iMesh_getRootSet(%VAL(mesh), root_set, err) 00063 ERRORR("Couldn't get root set.") 00064 00065 ! load the mesh 00066 if (read_par) then 00067 call iMesh_load(%VAL(mesh), %VAL(root_set), fname, & 00068 " moab:PARALLEL=READ_PART moab:PARTITION=PARALLEL_PARTITION moab:PARTITION_DISTRIBUTE moab:PARALLEL_RESOLVE_SHARED_ENTS " & 00069 , err) 00070 else 00071 call iMesh_load(%VAL(mesh), %VAL(root_set), fname, "", err) 00072 endif 00073 ERRORR("Couldn't load mesh.") 00074 00075 ! get all sets 00076 sets_alloc = 0 00077 num_hops = 1 00078 call iMesh_getEntSets(%VAL(mesh), %VAL(root_set), %VAL(num_hops), & 00079 rpsets, sets_alloc, sets_size, err) 00080 ERRORR("Couldn't get all sets.") 00081 00082 ! iterate through them, checking whether they have tags 00083 do i = 0, sets_size-1 00084 ! get connectivity 00085 tags_alloc = 0 00086 call iMesh_getAllEntSetTags(%VAL(mesh), %VAL(sets(i)), & 00087 rptags, tags_alloc, tags_size, err) 00088 ERRORR("Failed to get ent set tags.") 00089 00090 if (0 .ne. tags_size) then 00091 print *, "Set ", sets(i), " Tags:" 00092 end if 00093 00094 ! list tag names on this set 00095 do j = 0, tags_size-1 00096 call iMesh_getTagName(%VAL(mesh), %VAL(tags(j)), tname, err) 00097 call iMesh_getTagType(%VAL(mesh), %VAL(tags(j)), tag_type, err) 00098 ERRORR("Failed to get tag type.") 00099 if (iBase_INTEGER .eq. tag_type) then 00100 call iMesh_getEntSetIntData(%VAL(mesh), %VAL(sets(i)), & 00101 %VAL(tags(j)), int_val, err) 00102 ERRORR("Failed to get int data type.") 00103 print *, tname, int_val 00104 else if (iBase_DOUBLE .eq. tag_type) then 00105 call iMesh_getEntSetDblData(%VAL(mesh), %VAL(sets(i)), & 00106 %VAL(tags(j)), dbl_val, err) 00107 print *, tname, dbl_val 00108 else 00109 print *, tname 00110 end if 00111 00112 end do 00113 00114 if (tags_size .ne. 0) call free(rptags) 00115 tags_alloc = 0 00116 end do 00117 00118 if (sets_size .ne. 0) call free(rpsets) 00119 00120 call iMesh_dtor(%VAL(mesh), err) 00121 ERRORR("Failed to destruct interface.") 00122 00123 ! return 00124 end program ListSetsNTags 00125