moab
ListSetsNTagsF90.F90
Go to the documentation of this file.
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 
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Defines