# This code creates the user interface for the mesh editor.
#
# Copyright (c) 1997 Pacific Marketing and Consulting, Inc,
#       and ICEM Systems, GmbH.  All rights reserved.
# $Revision$ on $Date$
# This file contains special comments of the form ## html ... which are
# used to automatically generate documentation

## <h3>Unstructured mesh editing and modification functions</h3>

## Does a mesh exist?

proc ic_uns_is_loaded {} {
    global uns_cur
    return [expr {$uns_cur != ""}]
}
set dont_record_command(ic_uns_is_loaded) 1

## Has the mesh been modified?

proc ic_uns_is_modified {} {
    global uns_cur
    if { [ info exists uns_cur ]  == 0 } {
	return 0
    }
    return [expr {($uns_cur != "") && [$uns_cur get -modified]}]
}
set dont_record_command(ic_uns_is_modified) 1

## Set the mesh modified flag.  This shouldn't be used
## for most operations since they set this flag themselves.

proc ic_uns_set_modified {mod} {
    global uns_cur
    if {$uns_cur != ""} { $uns_cur configure -modified $mod }
}

## Load the given unstructured domain <em>files</em>.  This must be a full
## pathname.  If <em>maxdim</em> is given this will be the maximum dimension
## of elements that will be loaded.  For example, a value of 2 means
## to load only surface and bar elements.
## If check_orient is 0 then no orientation check will be done.  If it's 1 then
## the code will try to pick a good family for the new surface elements.  If it's
## 2 then the name will be CREATED_FACES

proc ic_uns_load {files {maxdim 3} {quiet 0} {reset_family_prefix ""} {check_orient 1}} {
    global batch_mode uns_cur uns_families_have_dimension

    # HACK - USED IN THE BOCO EDITING CODE - SHOULD CHANGE
    catch { unset uns_families_have_dimension }
    
    set ret 0
    with_view_inactive {
	    set count 1
        foreach file $files {
            if {!$quiet} {
                mess "Loading domain \"$file\" ...\n"
            }
            domain_put_info "    file $file ------------------\n"
	        set new 0
            if {$uns_cur == ""} {
                set uns_cur [make_new_uns_mesh $file]
                if {$uns_cur == ""} return
		        set new 1
	        }
	        set reset_pid 0
	        if {$reset_family_prefix != ""} {
		        $uns_cur create_family $reset_family_prefix$count -1
		        set reset_pid $count
	        }
	        if $new { set which load } else { set which merge }	    
	        undo_on 0
	        set bad [catch {$uns_cur ${which}_domain $file $maxdim domain_put_info $reset_pid $quiet} res]
	        if {!$quiet} {
	            puts "[llength [$uns_cur list_families]] part(s)"
	        }
	        if !$new { $uns_cur configure -filename "" }
            make_standard_maps $uns_cur
            if $bad {
                mess "$file: $res\n" red
                undo_on 1
                return 0
            }
            set ret 1
	        incr count
        }
        foreach mm [$uns_cur list_maps] {
            set nn [$mm get -name]
            if [info exists got_map($nn)] {
                for {set i 1} {[$uns_cur get_map $nn.$i] != ""} {incr i} {}
                mess "Warning: renamed subset $nn to $nn.$i\n" red
                $mm configure -name $nn.$i
                set nn $nn.$i
            }
            set got_map($nn) 1
        }
        domain_after_load_mesh $quiet $check_orient
    }
    
    if [ic_wb2_input_parameter_mode] {
        ic_wb2_update_parameters input
    }
    
    return $ret
}

proc ic_load_unstruct {files {maxdim 3}} {
    return [ic_uns_load $files $maxdim]
}

proc ic_uns_load_one_domain {file {maxdim 3} {quiet 0} {reset_family_prefix ""} {check_orient 1}} {
    global batch_mode uns_cur uns_families_have_dimension
    
    catch { unset uns_families_have_dimension }
    
    set ret 0
    with_view_inactive {
	    set count 1
        if {!$quiet} {
            mess "Loading domain \"$file\" ...\n"
        }
        domain_put_info "    file $file ------------------\n"
        if {$uns_cur == ""} {
            set uns_cur [make_new_uns_mesh $file]
            if {$uns_cur == ""} return
            set load 1
        } else {
            set load 0
        }
        set reset_pid 0
        if {$reset_family_prefix != ""} {
            $uns_cur create_family $reset_family_prefix$count -1
            set reset_pid $count
        }    
        undo_on 0
        if $load {
            set bad [catch {$uns_cur load_domain $file $maxdim domain_put_info $reset_pid $quiet} res]
        } else {
            set bad [catch {$uns_cur merge_domain $file $maxdim domain_put_info $reset_pid $quiet} res]
            $uns_cur configure -filename ""
        }
        if {!$quiet} {
            puts "[llength [$uns_cur list_families]] part(s)"
        }
        make_standard_maps $uns_cur
        if $bad {
            mess "$file: $res\n" red
            undo_on 1
            return 0
        }
        set ret 1
        foreach mm [$uns_cur list_maps] {
            set nn [$mm get -name]
            if [info exists got_map($nn)] {
                for {set i 1} {[$uns_cur get_map $nn.$i] != ""} {incr i} {}
                mess "Warning: renamed subset $nn to $nn.$i\n" red
                $mm configure -name $nn.$i
                set nn $nn.$i
            }
            set got_map($nn) 1
        }
        domain_after_load_mesh $quiet $check_orient
    }
    if [ic_wb2_input_parameter_mode] {
        ic_wb2_update_parameters input
    }
    return $ret
}

## Import a number (<em>nfiles</em>) of unstructured mesh files
## (<em>files</em>) into a mesh object using the specified <em>backend</em>.
## The optional argument <em>create (default: 1)</em> allows one to
## overwrite the current mesh object, while <em>prec (default: 1 [single])</em>
## allows one to specify the real-number precision. One can also specify
## the time step <em>tstep (default: 0)</em> and any additional arguments
## (<em>args</em>) necessary for the import.

proc ic_uns_readexternal {backend nfiles files {create 1} {prec 1} \
	{tstep 0} args } {
    global uns_cur
    
    if {$uns_cur == "" || $create} {ic_uns_create_empty}
    
    busy 1
    set cmd [list $uns_cur load_external_mesh $prec $tstep $backend \
                 $nfiles]
    
    append cmd " $files $args"
    mess "$cmd\n"
    if [catch $cmd res] {
        mess $res\n red
	uns_mesh_attach_family_boco 0
        set uns_cur ""
        busy 0
        return ""
    }
    busy 0
    return $uns_cur
}

## Create an empty mesh if there is not already one available.  Returns 1 if
## it created a new one and 0 if there was an existing one.

proc ic_uns_create_empty {} {
    global uns_cur
    
    if {$uns_cur != "" } { return 0 }
    
    set uns_cur [make_new_uns_mesh ""]
    $uns_cur initialize_mesh
    make_standard_maps $uns_cur
    domain_after_load_mesh 1
    return 1
}

## Save the current unstructured mesh to the given <em>file</em>.  If the
## <em>inc_subs</em> argument is 1 (the default) then the current subsets
## are also saved.  <em>resnames</em> is an optional list of result names
## to save with the domain (assuming they have been defined in the mesh).
## If <em>only_subs</em> is non-empty it is a list of names of maps that will
## be the only ones saved.

proc ic_save_unstruct {file {inc_subs 1} {resnames ""} {only_types ""} \
		       {only_fams ""} {only_subs ""} {near_vols 0} {quiet 0}} {
    global uns_cur undo_redo
    
    if {$uns_cur == ""} {
        mess "No mesh\n" red
        return
    }
    if [file isdirectory $file] {
        user_error "$file is a directory"
        return
    }
    if {!$quiet} {
        mess "Writing domain \"$file\" ...\n"
    }
    set only_maps ""
    foreach os $only_subs {
        lappend only_maps [$uns_cur get_map $os]
    }
    busy 1
    domain_save_unstruct $uns_cur $file $only_types $only_fams $inc_subs \
        $resnames $near_vols $only_maps
    busy 0
    ic_undo_clear
    if {!$quiet} {
        mess "Done saving domain file.\n"
    }
}

## Print some information. The argument <em>what</em> is one of 
##<em>summary, element, node, or domain</em>. For <em>summary</em>
## and <em>domain</em>, the <em>name</em> argument is ignored.
## For <em>summary</em> the argument <em>opt</em> will be used
## to print min/max edge sides if set

proc ic_uns_print_info {what {name ""} {opt 0} {subset_name1 "max_edge_sides"} {subset_name2 "min_edge_sides"}} {
    global uns_cur ai_environment
    
    switch $what {
	summary { 
	    if ![ic_uns_is_loaded] return
	    unstruct_summary "" 0 $opt $subset_name1 $subset_name2
	}
	element {
	    set map [$uns_cur get_map $name]
	    foreach inf [$map element_info] {
		# inf is intnum extnum family type {nodes} mutable_flag {thicknesses} {prism heights}
		set fam [lindex $inf 2]
		if { ([info exists ai_environment] && $ai_environment) } {
		    set part [lindex [split $fam :] 0]
		    if {[lindex $inf 5] == "not mutable"} {
		        set mutable ", locked"
		    } else {
		        set mutable ""
		    }
		    if {$part == ""} { set part "<none>" }
		    if {[lindex $inf 7] != ""} {
			set heights [lindex $inf 7]
			set h1 [lindex $heights 0]
			set h2 [lindex $heights 1]
			set h3 [lindex $heights 2]
			set h4 [lindex $heights 3]
			mess "[lindex $inf 3] [lindex $inf 1] (internal [lindex $inf 0]) :\
			    part $part, nodes (internal [string trim [lindex $inf 4]]), \
			    heights $h1 $h2 $h3, average height $h4 $mutable\n"
		    } else {
			mess "[lindex $inf 3] [lindex $inf 1] (internal [lindex $inf 0]) :\
			    part $part, nodes (internal [string trim [lindex $inf 4]]) $mutable\n"
		    }
		} else {
		    if {[lindex $inf 5] == "not mutable"} {
		        if {[lindex $inf 6] != ""} {
		            mess "[lindex $inf 3] [lindex $inf 1] :\
			        fam $fam, nodes [lindex $inf 4], [lindex $inf 5],\
			        thickness [lindex $inf 6]\n"
			} else {
		            mess "[lindex $inf 3] [lindex $inf 1] :\
			        fam $fam, nodes [lindex $inf 4], [lindex $inf 5]\n"
			}
		    } else {
		        if {[lindex $inf 6] != ""} {
		            mess "[lindex $inf 3] [lindex $inf 1] :\
			        fam $fam, nodes [lindex $inf 4],\
			        thickness [lindex $inf 6]\n"
			} else {
		            mess "[lindex $inf 3] [lindex $inf 1] :\
			        fam $fam, nodes [lindex $inf 4]\n"
			}
		    }
		}
	    }
	}
	node {
	    set map [$uns_cur get_map $name]
	    foreach inf [$map element_info] {
		    set cs [ic_csystem_get_current]
		    set pos [string trim [lindex $inf 3]]
		    if {$cs == "global"} {
		        mess "node [lindex $inf 0] (internal [lindex $inf 4]) : dim [lindex $inf 1], pos $pos\n"
		    } else {
		        mess "node [lindex $inf 0] (internal [lindex $inf 4]) : dim [lindex $inf 1], pos [coords_into_local $pos] ($cs) $pos (global)\n"
		    }
		    set tmpmap [ic_uns_subset_create]
		    set node [lindex $inf 4]
		    set n [ic_uns_subset_add_near_nodes $tmpmap $node]
		    mess "attached elements:\n"
		    foreach el [ic_uns_subset_list_elements $tmpmap] {
		        set part [lindex $el 4]
		        mess "[lindex $el 0] [lindex $el 2] (internal [lindex $el 1]) : part $part, nodes (internal [string trim [lindex $el 3]])\n"
		    }
            ic_uns_subset_delete $tmpmap
	    }
	}
    domain  { domain_print_info }
    }
}
set dont_record_command(ic_uns_print_info) 1

proc ic_uns_get_immutable_elements {name} {
    global uns_cur
    
	set map [$uns_cur get_map $name]
	return [$map element_immutable_info]
}
set dont_record_command(ic_uns_get_immutable_elements) 1

## Check for duplicate element and node numbers.  Returns a list with two numbers - the
## number of dup elements and the number of dup nodes.  Note that 0-numbered nodes and
## elements are not counted if skip_0 is 1 (the default)

proc ic_uns_check_duplicate_numbers {{skip_0 1}} {
    global uns_cur
    if {$uns_cur == ""} { return "" }
    return [list [$uns_cur duplicate_numbers 0 $skip_0] [$uns_cur duplicate_numbers 1 $skip_0]]
}

## What is the numeric id for this family

proc ic_uns_lookup_family_pid {fam} {
    global uns_cur
    if {$uns_cur == ""} { return "" }
    return [$uns_cur lookup_family_pid $fam]
}
set dont_record_command(ic_uns_lookup_family_pid) 1

## Rename a family ..  Note that this doesn't need to be called any more if you call
## ic_geo_rename_family first

proc ic_uns_rename_family {old new} {
    global uns_cur
    if {$uns_cur != ""} {
        set maxlen [ic_geo_get_valid_namelen]
        if {[string len $new] > $maxlen} {
            mess "Part name too long; max $maxlen characters allowed\n" red
            return
        }
	    $uns_cur rename_family $old $new
	    $uns_cur configure -modified 1
    }
}

## Count the number of elements in each family.

proc ic_uns_count_in_families {fams {total 0}} {
    global uns_cur
    if {$uns_cur == ""} { return 0 }
    if $total {
	set val 0
	foreach i [eval $uns_cur count_in_family $fams] { incr val $i }
	return $val
    } else {
	return [eval $uns_cur count_in_family $fams]
    }
}
set dont_record_command(ic_uns_count_in_families) 1

## List all the non-empty families.  If prefix is unequal "", list only non-empty families with this prefix.

proc ic_uns_non_empty_families {{prefix ""}} {
    global uns_cur
    if {$uns_cur == ""} { return "" }
    set ret ""
    set allf [$uns_cur list_families]
    foreach f $allf n [eval $uns_cur count_in_family $allf] {
	    if $n { 
	        if {($prefix == "") || [string match $prefix* $f]} {
	            lappend ret $f
	        }
	    }
    }
    return $ret
}
set dont_record_command(ic_uns_non_empty_families) 1

## Return a list of the number of 0-sided, 1-sided, and 2-sided elements
## in the given families.

proc ic_uns_count_family_neighbors {fams} {
    global uns_cur
    
    set map [uns_map -mesh $uns_cur]
    $map add_family_type $fams 2d 0
    set res [$map count_neighbors]
    $map delete
    return $res
}
set dont_record_command(ic_uns_count_family_neighbors) 1

## Does the family have quadratic elements?

proc ic_uns_family_has_quadratic {fam} {
    set quadtypes {
	BAR_3 LINE_3 TETRA_10 HEXA_20 TRI_6 PENTA_15 QUAD_8 QUAD_9
	HEXA_27 PENTA_18 PYRA_14 POLYGON PYRA_13
    }
    
    set map [ic_uns_subset_create_family_type [list $fam] __all__ 1 0]
    set types [ic_uns_subset_list_types $map]
    set quad 0
    foreach t $types {
	if [lmember $quadtypes $t] { set quad 1; break }
    }
    ic_uns_subset_delete $map
    return $quad
}
set dont_record_command(ic_uns_family_has_quadratic) 1

proc ic_uns_family_has_type {fam type} {

    if {$fam == "" || $type == ""} { return 0 }
    set map [ic_uns_subset_create_family_type [list $fam] __all__ 1 0]
    set types [ic_uns_subset_list_types $map]
    set has_type 0
	if {[lsearch $types $type] >= 0} { set has_type 1 }
    ic_uns_subset_delete $map
    return $has_type
}
set dont_record_command(ic_uns_family_has_type) 1

proc ic_uns_family_match_type {fam type} {

    if {$fam == "" || $type == ""} { return 0 }
    set map [ic_uns_subset_create_family_type [list $fam] __all__ 1 0]
    set types [ic_uns_subset_list_types $map]
    set has_type 0
	if {[lsearch -glob $types $type] >= 0} { set has_type 1 }
    ic_uns_subset_delete $map
    return $has_type
}
set dont_record_command(ic_uns_family_match_type) 1

## Add to a subset by neighbors

proc ic_uns_subset_add_by_neighbors {fams to nsides} {
    global uns_cur
    
    set map [uns_map -mesh $uns_cur]
    $map add_family_type $fams 2d 0    
    set tomap [$uns_cur get_map $to]
    if {$tomap != ""} {
	$map add_by_neighbors $tomap $nsides
    }
    $map delete
}
set dont_record_command(ic_uns_subset_add_by_neighbors) 1

## Something has changed with the families - color, etc

proc ic_uns_families_changed {} {
    global uns_cur uns_families_have_dimension
    
    # HACK - USED IN THE BOCO EDITING CODE - SHOULD CHANGE
    catch {unset uns_families_have_dimension}
    
    if {$uns_cur != ""} {
	foreach im [$uns_cur list_maps] {
	    if ![$im get -dont_change_color_or_shade] {
		$im set_pid_colors
		$im signal_change 0
	    }
	}
    }
}
set dont_record_command(ic_uns_families_changed) 1

## Check whether a family exists.

proc ic_uns_check_family {name} {
    global uns_cur
    if {$uns_cur == ""} { return 0 }
    if {[$uns_cur lookup_family_pid $name] == ""} {
	return 0
    } else {
	return 1
    }
}
set dont_record_command(ic_uns_check_family) 1


## Move elements from one family (old_fam_name) to another (new_fam_name)

proc ic_uns_move_family_elements {old_fam_name new_fam_name {quiet 0}} {
    global uns_cur uns_families_have_dimension
    
    # HACK - USED IN THE BOCO EDITING CODE - SHOULD CHANGE
    catch {unset uns_families_have_dimension}
    
    set n_el_old_fam [$uns_cur count_in_family $old_fam_name]
    if {0 < $n_el_old_fam} {
	    set old_fam_pid [ic_uns_lookup_family_pid $old_fam_name]
	    $uns_cur move_family_elements $old_fam_pid $new_fam_name
	    if !$quiet { mess "Moved $n_el_old_fam elements from $old_fam_name to $new_fam_name\n" }
    }
}

## Create a new family if it's not already there.  Return 1 if a new family
## was created.

proc ic_uns_new_family {name {vis 1}} {
    global uns_cur ic_uns_new_family_cmd
    if {$uns_cur != ""} {
	set nf [$uns_cur create_family $name -1]
	$uns_cur configure -modified 1
	if $nf {
	    add_new_family $name $vis
	    foreach m [$uns_cur list_maps] {
		if ![$m get -dont_change_color_or_shade] { $m set_pid_colors }
	    }
	}
	set ic_uns_new_family_cmd [list ic_uns_new_family $name $vis]
	return $nf
    } else {
	set ic_uns_new_family_cmd ""
	return 0
    }
}

proc ic_uns_new_family_replay_result {} {
    global ic_uns_new_family_cmd
    return $ic_uns_new_family_cmd
}

## Delete a family, or list of families.

proc ic_uns_delete_family {fams} {
    global uns_cur
    
    if {$uns_cur != ""} {
	foreach f $fams {
	    $uns_cur delete_family $f
	}
	$uns_cur configure -modified 1
    }
}

## What types are in the current mesh?

proc ic_uns_list_types {} {
    global uns_cur
    if {$uns_cur == ""} { return "" }
    return [$uns_cur list_types]
}
set dont_record_command(ic_uns_list_types) 1

## What types could be in the current mesh?

proc ic_uns_list_possible_types {} {
    global uns_cur
    if {$uns_cur == ""} { return "" }
    return [$uns_cur list_possible_types]
}
set dont_record_command(ic_uns_list_possible_types) 1

## How many verts in this type

proc ic_uns_num_verts_in_type {type} {
    global uns_cur
    if {$uns_cur == ""} { return "" }
    return [$uns_cur num_verts_in_type $type]
}
set dont_record_command(ic_uns_num_verts_in_type) 1

## What is the dimension of the mesh?

proc ic_uns_dimension {} {
    
    # note lsearch returns -1 if no match, else list elements index -JKA
    set types [ic_uns_list_types]
    if {([lsearch -regexp $types  HEXA_+] >= 0) || \
	([lsearch -regexp $types PENTA_+] >= 0) || \
	([lsearch -regexp $types TETRA_+] >= 0) || \
	([lsearch -regexp $types  PYRA_+] >= 0)} {
        return 3
    } elseif {([lsearch -regexp $types QUAD_+] >= 0) || \
	    ([lsearch -regexp $types TRI_+] >= 0)} {
	    return 2
    } elseif {[lsearch -regexp $types BAR_+] >= 0} {
	    return 1
    } else {
	    return 0
    }
}
set dont_record_command(ic_uns_dimension) 1

## What families are in the current mesh?

proc ic_uns_list_families {{with_dim ""}} {
    global uns_cur
    if {$uns_cur == ""} { return "" }
    if {$with_dim == ""} {
	return [$uns_cur list_families]
    } elseif {$with_dim == "pids"} {
	return [$uns_cur list_families_pids]
    } else {
	return [$uns_cur list_families_with_dimension $with_dim]
    }
}
set dont_record_command(ic_uns_list_families) 1

## Count the number of elements in the given type.  If the type is MIXED,
## which is the default, then all elements will be counted.
## The type may be one of:
## <b>0d 1d 2d 3d node line tri quad tetra hexa penta pyra</b>
## in which case those types of elements will be listed

proc ic_count_elements {{type MIXED}} {
    global uns_cur
    if {$uns_cur == ""} { return 0 }
    switch $type {
	0d - node { set type NODE }
	1d - line { set type {BAR_2 BAR_3} }
	2d { set type {TRI_3 TRI_6 QUAD_4 QUAD_8 QUAD_9} }
	3d { set type {TETRA_4 TETRA_10 HEXA_8 HEXA_20 HEXA_27 PENTA_6 PENTA_15 PENTA_18 PYRA_5 PYRA_14 PYRA_13} }
	tri { set type {TRI_3 TRI_6} }
	quad { set type {QUAD_4 QUAD_8 QUAD_9} }
	tetra  { set type {TETRA_4 TETRA_10} }
	hexa { set type {HEXA_8 HEXA_20 HEXA_27} }
	penta { set type {PENTA_6 PENTA_15 PENTA_18} }
	pyra { set type {PYRA_5 PYRA_14 PYRA_13} }
    }
    return [eval $uns_cur count $type]
}
set dont_record_command(ic_count_elements) 1

## Count the number of nodes in the mesh.

proc ic_count_nodes {} {
    global uns_cur
    if {$uns_cur == ""} { return 0 }
    return [$uns_cur count nodes]
}
set dont_record_command(ic_count_nodes) 1

## Count the number of couplings

proc ic_uns_num_couplings {} {
    global uns_cur
    if {$uns_cur == ""} { return 0 }
    return [$uns_cur num_couplings]
}
set dont_record_command(ic_count_nodes) 1

## Return the names of the surfaces or curves that the elements in the map are
## closest to.  2-d elements get projected to surfaces, 1-d to curves.  
## type is either surface or curve

proc ic_uns_project_to_geometry {mapn type} {
    global uns_cur
    set map [$uns_cur get_map $mapn]
    foreach name [$map get_closest_geometry $type] {
	set got($name) 1
    }
    return [array names got]
}

## Create a new element, or in the case of NODE elements, as many NODE
## elements as there are vertices given.
## <ul>
## <li> <b>type</b> : the type of the element (NODE, BAR_2, TRI_3, etc)
## <li> <b>fam</b> : the family for the new element
## <li> <b>nodes</b> : the name of a subset that contains the necessary nodes
## <li> <b>make_consistent</b> : if 1, modify the volume mesh to make
## it consistent with the new element (if it's a surface element)
## <li> <b>cmapname</b> : the name of the subset to add the new elements to
## <li> <b>grab_existing</b> : if this is 1 and there are already elements
## like this available then add them to the map
## <li> <b>reset_dim</b> : if this is 1, nodes projection will be reset
## </ul>

proc ic_uns_create_element {type fam nodes make_consistent \
				{cmapname visible} {grab_existing 0} \
				{reset_dim 1} {update 1} {automatic 1}} {
    global uns_cur batch_mode
    ic_newop
    set map [$uns_cur get_map $nodes]
    set cmap [$uns_cur get_map $cmapname]
    $uns_cur configure -modified 1
    if $batch_mode { set update 0 }
    set cmd [list $cmap create_element $type $fam $map $make_consistent $grab_existing $reset_dim $automatic]
    if [catch $cmd res] {
	mess "$res\n" red
	return 1
    } else {
	if $update { after_create_uns_stuff }
	return 0
    }
}

## create hexa from opposite faces
proc ic_uns_create_hexa_from_faces { name faces { inherit_part 1 } { part "" }} {
    global uns_cur
    ic_newop
    set map [$uns_cur get_map $name]
    set face_map [$uns_cur get_map $faces]
    if {$face_map == ""} {
	mess "no such face map: $faces\n" red
	return
    }

    set nquads 0
    foreach el [ic_uns_subset_list_elements $faces] {
	if {[lindex $el 0] == "QUAD_4"} {
	    incr nquads
	}
    }
    if {$nquads != 2} {
	mess "could not find 2 QUAD_4 elements in the face map\n" red
	return
    }
    
    if {$part == ""} {
	set part "CREATED_MATERIAL"
	ic_uns_new_family $part
    }

    set ret [$map create_hexa_from_faces $face_map $inherit_part $part]
    if {$name != "all"} { $map delete }
    $uns_cur configure -modified 1
    update_uns_visible
    if {$ret == ""} {
	mess "1 hexa element created from faces\n"
    } else {
	mess "$ret\n" red
    }
}


## Create a point element at a particular node, which is closest to the
## named prescribed point.

proc ic_uns_create_node_element_near_point {pname fam} {
    global projlib uns_cur
    
    if {$uns_cur == ""} { return "" }

    set num [$projlib get_number_by_name point $pname]
    set loc [$projlib get_point_loc $num]
    set map [uns_map -mesh $uns_cur]
    $map nearest_node_to_pos $loc
    return [$map create_element NODE $fam $map 0 1 1 0]
}

## Set the elements in a subset to a family.

proc ic_uns_change_family {name fam} {
    global uns_cur uns_families_have_dimension
    
    # HACK - USED IN THE BOCO EDITING CODE - SHOULD CHANGE
    catch {unset uns_families_have_dimension}
    
    ic_newop
    set map [$uns_cur get_map $name]
    $map set_family $fam
    $uns_cur configure -modified 1
    update_uns_visible
}

## Move stuff from one part to another.

proc ic_uns_set_part {name newpart} {
    global uns_cur uns_families_have_dimension
    
    # HACK - USED IN THE BOCO EDITING CODE - SHOULD CHANGE
    catch {unset uns_families_have_dimension}
    
    set map [$uns_cur get_map $name]
    foreach oldfam [ic_uns_subset_families_used $name 0] {
	set newfam [ic_boco_change_part $oldfam $newpart]
	ic_uns_new_family $newfam
	$map move_family $oldfam $newfam
	ic_boco_add_or_remove_bc_icons $oldfam 0 [list unsmap $map]
	ic_boco_add_or_remove_bc_icons $newfam 1 [list unsmap $map]
    }
    $uns_cur configure -modified 1
    update_uns_visible
}

## This sets the family of elements to that of geometry entities 
## they are projected to.

proc ic_uns_set_projected_family {mapname} {
    global uns_cur projlib

    set map [$uns_cur get_map $mapname]
    if {$map == ""} { error "no map $mapname" }
    ic_newop
    set nchanged 0
    foreach type {surface curve point} {
	foreach ent [ic_geo_get_objects $type] {
	    set num [$projlib get_number_by_name $type $ent]    
	    set fam [$projlib get_family $type $num]
	    set proj_mapname [ic_uns_subset_create]
	    set proj_map [$uns_cur get_map $proj_mapname]
	    set nch [$map get_attached_elements $proj_map $type $fam $num]
	    if {$nch > 0} {
		eval $proj_map set_family $fam
	    }
	    ic_uns_subset_delete $proj_mapname
	}
    }
    $uns_cur configure -modified 1
    update_uns_visible
}

## Change the elements in a family to a new family, *if* when they are
## projected to surfaces, curves, etc they are nearest to a specific one.
## Returns the number of elements changed.
## <p>Example: ic_uns_change_family_if_project all OWALL NWALL surface NWALL.1
## <p>This works for surfaces, curves, and points.

proc ic_uns_change_family_if_project {mapname ofam nfam geotype geoname} {
    global uns_cur projlib
    
    if ![ic_uns_check_family $ofam] { return 0 }

    ic_newop
    
    set map [$uns_cur get_map $mapname]
    if {$map == ""} { error "no map $mapname" }
    
    if {$projlib == ""} { error "no geometry is loaded" }
    set geonum [$projlib get_number_by_name $geotype $geoname]
    if {$geonum == -1} { error "no $geotype $geoname" }
    ic_uns_new_family $nfam
    set nch [$map change_family_if_project $ofam $nfam $geotype $geonum]
    if $nch {
	$uns_cur configure -modified 1
	update_uns_visible
    }
    return $nch
}

## Find the elements attached to a geometry entity *if* when they are
## projected to surfaces, curves, etc they are nearest to a specific one.
## Returns subset of attached elements.
## <p>This works for bodies, surfaces, curves, and points.

proc ic_uns_get_attached_elements {geotype geoname {mapname ""}} {
    global uns_cur projlib
            
    if {$projlib == ""} { error "no geometry is loaded" }
    if {$geotype == "body"} {
	set matlpnt [ic_geo_get_body_matlpnt $geoname]
	set geofam [ic_geo_get_family material $matlpnt]
    } else {
	set geofam  [ic_geo_get_family  $geotype $geoname]
    }
    set geonum [$projlib get_number_by_name $geotype $geoname]
    if {$geonum == -1} { error "no $geotype $geoname" }
    
    set attsubset [ic_uns_subset_create $mapname]
    set map [$uns_cur get_map All]
    set nch [$map get_attached_elements [$uns_cur get_map $attsubset] \
	    $geotype $geofam $geonum]

    return $attsubset
}
set dont_record_command(ic_uns_get_attached_elements) 1

## Get material numbers
# **************************** why is this here?  It's geometry

proc ic_uns_list_material_numbers {} {
    global projlib
    return [$projlib list_material_numbers]
}

## Get material families
# **************************** why is this here?  It's geometry

proc ic_uns_list_material_families {} {
    global projlib
    return [$projlib list_material_families]
}

## Split elements

proc ic_uns_split_elements {name} {
    global uns_cur projlib
    ic_newop
    set map [$uns_cur get_map $name]
    #set vis [$uns_cur get_map visible]
    set fixmaps [uns_all_subsets]
    eval $map split_elements $projlib $fixmaps
    $uns_cur configure -modified 1
}

## Split spanning elements

proc ic_uns_split_spanning_edges {name { args "" } } {
    global uns_cur projlib
    ic_newop
    set map [$uns_cur get_map $name]
    set cmd "$map split_spanning_edges"
    foreach i $args {
        append cmd " $i"
    }
    set mess [ eval $cmd ]
    regsub -all \{ $mess "" mess
    regsub -all \} $mess "" mess
    mess $mess\n
    $uns_cur configure -modified 1
}

## Split edge. If propagate is specified, the split
## edge will propagate through elements, creating
## no new element types; if propagate==0, then it
## may, for example, split QUADs into TRIs.
## project can be set to 0 to turn off projection
## check: if 1 then check if split of any neighbor element is not supported

proc ic_uns_split_edges {name {propagate 0} {project 1} {check 0}} {
    global uns_cur projlib
    ic_newop
    set map [$uns_cur get_map $name]
    set fixmaps [uns_all_subsets]
    if {$check || ![ic_geo_is_loaded] || !$project} {
        set projObj ""
    } else {
        set projObj $projlib
    }
    set ret [$map split_edges $projObj $fixmaps "" "" "" $propagate $check]
    if {!$check} {
        $uns_cur configure -modified 1
        if !$propagate { display_update unstruct 0 "TRI_3 QUAD_4" }
    }
    return $ret
}

## Swap edge

proc ic_uns_swap_edges {name try_harder} {
    global uns_cur projlib
    ic_newop
    set map [$uns_cur get_map $name]
    set vis [$uns_cur get_map visible]
    $uns_cur configure -modified 1
    return [$map swap_edges $vis $try_harder]
}

## Swap the edges in a given TCL list <e>node_numbers</e> arranged
## thus: {edge1v1 edge1v2 edge2v1 edge2v2 ...}

proc ic_uns_swap_edges_node_numbers {node_numbers try_harder} {
    
    if {"" == $nums} { return 0 }    
    set nodessubset [ic_uns_subset_create]
    ic_uns_subset_add_node_numbers $nodessubset $node_numbers
    set retval [ic_uns_swap_edges $nodessubset $try_harder]
    ic_uns_subset_delete $nodessubset
    return $retval
}

## Swap edges automatic

proc ic_uns_swap_edges_auto {name minasp numiter {maxdev "-1.0"}} {
    global uns_cur
    set map [$uns_cur get_map $name]
    big_uns_op 1 {
	$map swap_edges_auto $minasp $maxdev $numiter
    }
    $uns_cur configure -modified 1
}

## Change element types

proc ic_uns_change_type {name from to {proj 0} { cons 0 } {normal 0}} {
    global uns_cur projlib
    set map [$uns_cur get_map $name]
    if $proj { set pl $projlib } else { set pl "" }
    big_uns_op 1 {
	if {($from == "all" || $from == "prism") && $to == "tetra"} {
	    set nch [$map change_type_${from}_${to} $pl $cons]
	} elseif {$from == "tetra" && $to == "hexa"} {
	    set nch [$map change_type_${from}_${to} $pl $normal]
	} else {
	    set nch [$map change_type_${from}_${to} $pl]
	}
    }
    $uns_cur configure -modified 1
    if {($from == "all" || $from == "prism") && $to == "tetra" && \
	$cons && $nch > 0} {
	set map2 [$uns_cur get_map all]
	set nf [$map2 check_volume_orient 1 NULL]
	if { $nf } {
	    set nf [$map2 check_volume_orient 1 NULL]
	}
    }
    set interr_mess "Interrupted - not all elements changed"
    if {($from == "quad" && $to == "tri")} {
         if {[lindex $nch end ] < 0} {
             mess "$interr_mess\n" red
         }
         return [lrange $nch 0 end-1]
    } else {
        if {$nch < 0} {
	    mess "$interr_mess\n" red
	}
    }
}

## Change element types shell to solid

proc ic_uns_change_shell_solid {name thickness adjust hext} {
    global uns_cur projlib
    set map [$uns_cur get_map $name]
    big_uns_op 1 {
	set nch [$map change_type_shell_solid $thickness $adjust $hext]
    }
    if {$nch < 0} {
	mess "Interrupted - not all elements changed\n" red
    }
    $uns_cur configure -modified 1
}


## Change all elements in family <em>fams</em> of type <em>from</em>
## to type <em>to</em> if below scalar <em>quality_limit</em> according
## to metric <em>metric</em>. Only supports QUAD_4 & TRI_3 so far.

proc ic_uns_change_type_by_quality {fams from to metric {quality_limit 0.2}} {
    
    if ![ic_uns_is_loaded] {
	mess "cannot change type by quality without a mesh loaded!\n" red
	return -1
    }
    
    mess "\nChanging $from elements in part(s) $fams to type $to according to metric $metric below $quality_limit...\n"
    
    set tmpmap [ic_uns_subset_create [ic_uns_subset_unused_name bsm_change_type_by_quality]]
    ic_uns_subset_add_families_and_types $tmpmap $fams $from

    set stat [ic_uns_metric $tmpmap $metric]
    if {0 >= [lindex $stat 0]} {
	ic_uns_subset_delete $tmpmap
	return -1	
    }
    
    set badmap [ic_uns_subset_create [ic_uns_subset_unused_name bsm_change_type_by_quality_bad]]
    ic_uns_set_with_diagnostic $badmap $tmpmap [list [list -1000 $quality_limit]]
    
    set nbads [ic_uns_subset_count_elements $badmap]
    if $nbads {
	mess "Found $nbads $from elements; converting them to $to...\n"

	set from_s ""
	switch -- $from {
	    QUAD_4 { set from_s "quad" }
	    TRI_3 {  set from_s "tri" }
	}
	
	set to_s ""
	switch -- $to {
	    QUAD_4 { set to_s "quad" }
	    TRI_3 {  set to_s "tri" }
	}
	
	ic_uns_change_type $badmap $from_s $to_s 0
    }
    
    ic_uns_subset_delete $tmpmap
    ic_uns_subset_delete $badmap
    mess "...done\n"
    
    return 1
}

## Smooth the current unstructured mesh.
## One or more arguments may be given.  These arguments are:
## <ul>
## <li> <b>smooth</b> <em>type</em> : Smooth all vertices attached to elements
## of the named type.
## <li> <b>freeze</b> <em>type</em> : Freeze all vertices attached to elements
## of the named type.
## <li> <b>float</b> <em>type</em> : Allow all vertices attached to elements
## of the named type to float - that is, they will move only 
## if they are attached to an element type marked <b>smooth</b>,
## but not if they are also attached to an element type marked <b>freeze</b>.
## This is the default state for all types except <b>NODE</b> elements
## which are frozen.
## <li> <b>family</b> <em>famname</em> : smooth elements of this family.  This
## argument can be given more than once for multiple families.
## If no family is given then all families are selected.
## <li> <b>metric</b> <em>val</em> : The quality metric to optimize.
## The default is "Determinant".
## <li> <b>upto</b> <em>val</em> : The highest quality element it will try
## to improve. The default is 0.5.
## <li> <b>iterations</b> <em>val</em> : How many iterations to do.
## The default is 5.
## <li> <b>prism_warp_weight</b> <em>val</em> : The prism warp weight.
## The default is 0.5.
## <li> <b>laplace</b> <em>on</em> : Smooth using the laplace algorithm.
## The default is 0 (off). If set to 2, edge length laplace is used.
## <li> <b>no_collapse</b> <em>on</em> : Disallow nodes to be merged
## The default is 0.
## <li> <b>sfit</b> <em>on</em> : Turn on surface fitting when smoothing
## QUAD_4 and HEXA_8 elements.
## The default is 0.
## <li> <b>ignore_pp</b> <em>on</em> : Ignore prescribed points when smoothing
## QUAD_4 and HEXA_8 elements. 
## The default is 0.
## <li> <b>group_bad_elem</b> <em>on</em> : Group bad elements 0/1.
## The default is 1.
## <li> <b>only_triangles</b> <em>on</em> : Only smooth triangles.
## The default is 0.
## <b>Obsolete option - use float, freeze, or smooth.</b>
## <li> <b>smooth_prisms</b> <em>on</em> : Smooth prisms. The default is 0.
## <b>Obsolete option - use float, freeze, or smooth.</b>
## <li> <b>fix_prisms</b> <em>on</em> : Don't smooth prisms. The default is 1.
## <b>Obsolete option - use float, freeze, or smooth.</b>
## <li> <b>refine</b> <em>on</em> : Use refinement. The default is 0.
## <b>Obsolete option - use float, freeze, or smooth.</b>
## <li> <b>fix_triangles</b> <em>on</em> : Don't move triangles.
## The default is 0.
## <b>Obsolete option - use float, freeze, or smooth.</b>
## <li> <b>smooth_tets</b> <em>val</em> : Smooth tetrahedra. The default is 1.
## <b>Obsolete option - use float, freeze, or smooth.</b>
## <li> <b>fix_tets</b> <em>val</em> : Don't smooth tetrahedra. 
## The default is 0.
## <b>Obsolete option - use float, freeze, or smooth.</b>
## <li>
## </ul>


proc ic_smooth_elements {args} {
    global smooth undo_redo uns_cur projlib interrupt_disable
    
    if {$uns_cur == ""} { error "No mesh is loaded yet" }
    
    set types ""
    set fams ""
    set map ""
    set metric Quality
    set upto 0.5
    set prism_warp_weight 0.5
    set violate_geometry 0
    set fix_families ""
    set val_violate_geometry 0.0
    set n_processors 1
    set quiet 0
    
    set post_smoother [ic_smooth_decide_post_smoother]
    if $post_smoother {
        set laplace_loc 0
        foreach {n v} $args {
            switch -- $n {
                laplace { set laplace_loc $v }
            }
        }
        if $laplace_loc {
            set post_smoother 0
        }
    }
    if $post_smoother {
	    set fix_triangles 0
	    set sfit 0
    	set ignore_pp 0
	    set group_bad_elem 1
	    set do_tris 0
	    set do_pentas 0
	    set do_quads 0
	    set do_hexas 0
    } else {
    	set smooth_freeze_float ""
        set iterations 5
    }

    foreach {n v} $args {
        if [ic_wb2_input_parameter_mode] {
            switch -- $n {
                upto {
                    if [ic_wb2_is_input_meshing_param_set tetra_smooth_aspect] {
                        set vv [ic_get_meshing_param_value variable tetra_smooth_aspect]
                        if {$vv != "___NA___" && ([string is integer -strict $vv] || [string is double -strict $vv])} {
                            set v $vv
                        }
                    } elseif {[ic_wb2_is_input_meshing_param_set tetra_smooth_aspect2]} {
                        set vv [ic_get_meshing_param_value variable tetra_smooth_aspect2]
                        if {$vv != "___NA___" && ([string is integer -strict $vv] || [string is double -strict $vv])} {
                            set v $vv
                        }
                    }
                }
                iterations {
                    if [ic_wb2_is_input_meshing_param_set tetra_smooth_niter] {
                        set vv [ic_get_meshing_param_value variable tetra_smooth_niter]
                        if {$vv != "___NA___" && [string is integer -strict $vv]} {
                            set v $vv
                        }
                    } elseif {[ic_wb2_is_input_meshing_param_set tetra_smooth_niter2]} {
                        set vv [ic_get_meshing_param_value variable tetra_smooth_niter2]
                        if {$vv != "___NA___" && [string is integer -strict $vv]} {
                            set v $vv
                        }
                    }
                }
            }
        }
	    switch -- $n {
	        type       { lappend types $v }
	        family     { lappend fams $v }
	        violate_geometry { set $n 1; set val_violate_geometry $v }
	        n_processors { set $n 1; set n_processors $v }
	        quiet { set quiet $v }
	        smooth - freeze - float {
		        if $post_smoother {
		            switch "$v $n" {
		                "TRI_3 smooth"   { set fix_triangles 0; set do_tris 1 }
		                "QUAD_4 smooth"  { set fix_triangles 0; set do_quads 1 }
		                "HEXA_8 smooth"  { set do_hexas 1 }
		                "PENTA_6 smooth" { set do_pentas 1  }
		                default {}
		            }
		        } else {
			        lappend smooth_freeze_float $n $v
		        }
	        }
	        default {
		        set $n $v 
	        }
	    }
    }
    
    if $post_smoother {
	    foreach {n2 v2} $args {
	        switch -- $n2 {
		        smooth - freeze - float {
		            switch "$v2 $n2" {
		                "TRI_3 float"   {
					        if !$do_quads {
					 	        set fix_triangles 0
					        }
					    }
                        "TRI_3 freeze"  {
					        if {$do_hexas || $do_pentas} {
						    set fix_triangles 1
					        }
					    }
		                "QUAD_4 float"  {
					        if !$do_tris {
						        set fix_triangles 0
					        }
					    }
                        "QUAD_4 freeze" {
					        if {$do_hexas || $do_pentas} {
						        set fix_triangles 1
					        }
					    }
		                default {}
		            }
		        }
	        }
	    }
    }

    if  {$projlib == ""} {
	    mess "You can't smooth without a tetin file.\n" red
	    error "You can't smooth without a tetin file."
    }
    
    set ok 1
    if $post_smoother {
	    set del_map 0
	    if {$map == ""} {
	        if {$types == ""} { set types MIXED }
	        if {$fams == ""}  { set fams all }
	        set map [uns_map -mesh $uns_cur]
	        $map add_family_type $fams $types 0
	        set del_map 1
	    } else {
	        set map [$uns_cur get_map $map]
	    }
        if {[info exists laplace] && $laplace} {
	        set how 3
	    } else {
	        switch $metric {
                Determinant     { set how 0 }
                "Min angle"     { set how 7 }
                "Max orthogls"  { set how 1 }
                Warp            { set how 2 }
                "Max warpgls"   { set how 2 }
                "Max warp"      { set how 2 }
                "Quality (4.3 version)" { set how 4 }
                Quality         { set how 4 }
                Skew            { set how 5 }
		        "Aspect ratio"  { set how 6 }
		        default {
		            mess "Warning: yon't know how to smooth for $metric; using \"Quality\" instead.\n" red
		            set how 4
		        }
	        }
	    }
	    if $do_hexas {
	        set mesh_type 0
	    } elseif $do_pentas {
	        set mesh_type 1
	    } elseif $do_quads {
	        set mesh_type 2
	    } elseif $do_tris {
	        set mesh_type 4
	    } else {
            # tetras
	        set mesh_type 3
	    }
	    mess "Starting post smoothing ...\n"
	    big_uns_op 1 {	    
	        set ok [$map post_smooth_elements NULL . type_selected $how \
		    mesh_type $mesh_type \
		    sfit $sfit ign_prescribed_points $ignore_pp \
		    fix_boundaries $fix_triangles \
		    limit_bad_determ $upto limit_bad_angle $upto \
		    group_bad_elem $group_bad_elem]
	    }
	    catch { interrupt finish }
	    if $del_map {
	        $map delete
	    }	
    } else {
	    set opts "$upto $iterations "
	    foreach i $smooth_freeze_float {
	        lappend opts $i	   
	    }
	    set surf_smooth_only 1
	    foreach {t v} $smooth_freeze_float {
	        if {$t == "smooth" && $v != "TRI_3" && $v != "QUAD_4"} {
		        set surf_smooth_only 0
		        break
	        }
	    }
	    if {($surf_smooth_only) && (![ic_geo_is_loaded])} {
	        mess "Error: no geometry loaded for surface mesh smoothing\n" red
	        return
	    }
	    if {[info exists laplace] && $laplace != "0"} {
	        if {$laplace == "1"} {
		        append opts " laplace"
	        } elseif {$laplace == "2"} {
		        append opts " laplace_edge"
	        }
	        if [info exists residual_sf] {
		        append opts " -residual_sf $residual_sf"
	        }
	        if [info exists residual_vl] {
		        append opts " -residual_vl $residual_vl"
	        }
	    }
	    if [info exists min_edge_len] { 
	        append opts " -min_edge_len $min_edge_len" 
	    }
	    lappend opts prism_warp_weight $prism_warp_weight
	    switch $metric {
		    Quality - Determinant {}
		    "Min angle" { set angle 1 }
		    "Max warp" - Skew { 
		        mess "Warning: don't know how to smooth volume elements for $metric; using \"Quality\" instead.\n" red
		    }
		    "inscr_aspect" { set inscr_aspect 1 }
	    }
	    # tetra options
	    foreach i {refine no_collapse angle inscr_aspect} {
	        if {[info exists $i]  && [set $i]} {
			    lappend opts $i
		    }
	    }
	    if $violate_geometry {
		    if {$val_violate_geometry > 0.0} {
		        lappend opts violate_geometry $val_violate_geometry
		    } else {
		        set val [expr -1.0 * $val_violate_geometry]
		        lappend opts violate_geometry relative $val
		    }
	    }
	    if {[info exists max_degree] && $max_degree > 0} {
		    lappend opts max_degree $max_degree
	    }
	    global current_metric
	    if {[info exists current_metric] && ($current_metric == "Custom quality")} {
		    lappend opts "custom_diag"
		    lappend opts "[diagnostic_get_weights]"
	    }
	    # set cmd smooth_triangles
	    set cmd smooth_elements
        lappend opts nproc $n_processors
        if {$fix_families != ""} {
		    eval lappend opts fix_families $fix_families
	    }
	    if {[info exists all_elements] && $all_elements} {
		    lappend opts all_elements
	    }
	    if {$map == ""} {
	        if {[info exists subset] && $subset != ""} {
		        set map [$uns_cur get_map $subset]
	        } else {
		        set map [$uns_cur get_map All]
	        }
	    } else {
	        set map [$uns_cur get_map $map]
	    }
        if !$quiet {
	        mess "Starting smoothing ...\n"
	        mess "$cmd $opts\n"
	    } else {
	        lappend opts quiet
	    }
	    big_uns_op 1 {
	        if [eval $map $cmd $opts] { set ok 0 }
	        set nf [$map check_volume_orient 1 NULL]
	        if $nf {
		        set nf [$map check_volume_orient 1 NULL]
	        }
	    }
    }
    $uns_cur configure -modified 1
    if $ok {
        if !$quiet {
            mess "Done smoothing.\n"
        }
    } else {
        mess "Smoothing interrupted.\n"
    }
    return $ok
}

## Smooth all elements in family <em>fams</em> of types <em>types</em>
## if below scalar <em>quality_limit</em> according to metric <em>metric</em>

proc ic_uns_smooth_by_quality {fams types metric {quality_limit 0.5} {additional_args ""}} {
    
    if ![ic_uns_is_loaded] {
	mess "cannot smooth by quality without a mesh loaded!\n" red
	return -1
    }
    
    mess "\nSmoothing elements of type $types in families $fams according to $metric below...\n"
    
    set tmpmap [ic_uns_subset_create [ic_uns_subset_unused_name bsm_smooth_by_quality]]    
    ic_uns_subset_add_families_and_types $tmpmap $fams $types    
    
    set stat [ic_uns_metric $tmpmap $metric]
    ic_uns_subset_delete $tmpmap
    if {0 >= [lindex $stat 0]} {
	ic_uns_subset_delete $tmpmap
	return -1	
    }
    
    set badmap [ic_uns_subset_create [ic_uns_subset_unused_name bsm_change_type_by_quality_bad]]
    ic_uns_set_with_diagnostic $badmap $tmpmap [list [list -1000 $quality_limit]]
    
    set nbads [ic_uns_subset_count_elements $badmap]
    if $nbads {
	
	mess "found $nbads elements; smoothing up to them to $quality_limit...\n"

	set args " upto $quality_limit iterations 20 metric [list $metric] smooth TRI_3 smooth QUAD_4 map $badmap"
	if {$args != ""} {set args [concat $args $additional_args]}
	set cmd ic_smooth_elements 
	if [catch {[eval $cmd $args] } res] {
	    mess "\n$res\n" red
	}
    } else {
	mess "...no elements found with $metric below $quality_limit...\n"
    } 
    
    ic_uns_subset_delete $tmpmap
    ic_uns_subset_delete $badmap
    
    mess "...done\n"
    
    return 0
}

## Delete selected elements from the currently loaded unstructured mesh.
## The arguments come in keyword value pairs.  The possible options are:
## <ul> 
## <li> <b>type</b> <em>typename</em> : delete elements of this type
## where typename is TETRA_4 or HEXA_8
## or another standard name.  If no type name is given then all types
## are selected.
## <li> <b>family</b> <em>famname</em> : delete elements of this family.
## If no family is given then all families are selected.
## </ul>
## <p>If multiple types are given then all types selected are deleted, and
## likewise for families.

proc ic_delete_elements {args} {
    global uns_cur

    if {$uns_cur == ""} return

    set types ""
    set fams ""
    set name ""
    set no_undo 0
    foreach {n v} $args {
        switch -- $n {
            type { lappend types $v }
            family { lappend fams $v }
            subset { set name $v }
            no_undo { set no_undo $v }
            default { error "unknown option $n $v" }
        }
    }
    if {$name != ""} {
        set map [$uns_cur get_map $name]
        set del 0
    } else {
        if {$types == ""} { set types MIXED }
        if {$fams == "" }  { set fams all }
        set map [uns_map -mesh $uns_cur]
        $map add_family_type $fams $types 0
        set del 1
    }
    set nn [lindex [$map count] 0]
    if {[lindex [$map count] 0] > 1000 && !$no_undo} {
        big_uns_op 1 {
            $map delete_contents
        }
    } else {
        if {!$no_undo} {ic_newop}
        $map delete_contents
    }
    if $del { $map delete }
#    mess "$nn elements deleted: types $types, fams $fams\n"
    $uns_cur configure -modified 1
}

## Move nodes in the selected elements to the given location.
## The arguments come in keyword value pairs.  The possible options are:
## <ul> 
## <li> <b>type</b> <em>typename</em> : delete elements of this type
## where typename is TETRA_4 or HEXA_8
## or another standard name.  If no type name is given then all types
## are selected.
## <li> <b>family</b> <em>famname</em> : delete elements of this family.
## If no family is given then all families are selected.
## <li> <b>how</b> <em>mode</em> : can be either <b>set</b> or <b>delta</b>.
## <li> <b>x</b> <em>x</em> : the x value to set or increment.
## <li> <b>y</b> <em>y</em> : the y value to set or increment.
## <li> <b>z</b> <em>z</em> : the z value to set or increment.
## </ul>
## <p>If multiple types are given then all types selected are moved, and
## likewise for families.  If any of the X Y or Z values are not given then
## that coordinate is not changed.

proc ic_move_nodes {args} {
    global uns_cur
    
    set types ""
    set fams ""
    set x ""
    set y ""
    set z ""
    set how set
    foreach {n v} $args {
	switch -- $n {
	    type { lappend types $v }
	    family { lappend fams $v }
	    x - y - z - how { set $n $v }
	    default { error "unknown option $n $v" }
	}
    }
    if {$types == ""} { set types MIXED }
    if {$fams == ""}  { set fams all }
    set map [uns_map -mesh $uns_cur]
    $map add_family_type $fams $types 0
    
    set doit ""; set val ""
    
    foreach v {x y z} {
	if {[set $v] == ""} {
	    lappend doit 0
	    lappend val 0
	} else {
	    lappend doit 1
	    lappend val [set $v]
	}
    }
    set setp [expr {$how == "set"}]

    $map add_attached_nodes
    ic_newop
    set amt [$map move_nodes_exact $setp $doit $val ""]
    #puts "$map move_nodes_exact $setp $doit $val"
    
    if [lindex $amt 3] {
	mess "[lindex $amt 3] nodes moved, min [lindex $amt 0],\
		max [lindex $amt 1],\
		mean [expr {[lindex $amt 2] / ([lindex $amt 3] + 0.0)}]\n"
    } else {
	mess "0 nodes moved\n"
    }
    $map delete
    $uns_cur configure -modified 1
}

## Project all the nodes in a map to the line defined by the two points
## This also sets the type to volume so they are no longer associated with any
## geometry  (if unset_dim != 0)

proc ic_uns_project_nodes_to_line {pt1 pt2 unset_dim name} {
    global uns_cur projlib
    
    ic_newop
    if { $name == "" } return
    set map [$uns_cur get_map $name]
    $map project_nodes_to_line $pt1 $pt2
    if $unset_dim {
	$map set_node_dimension none $projlib "" 0 0 ""
    }
}

## Project all the nodes in a map to the plane defined by a pt and norm
proc ic_uns_project_nodes_to_plane {pt norm name} {
    global uns_cur projlib
    
    ic_newop
    if { $name == "" } return
    set map [$uns_cur get_map $name]
    $map project_nodes_to_plane $pt $norm
}

## Change the family of selected elements from the currently 
## loaded unstructured mesh.
## The arguments come in keyword value pairs.  The possible options are:
## <ul> 
## <li> <b>type</b> <em>typename</em> : select elements of this type
## where typename is a standard element type such as TETRA_4 or HEXA_8.
## If no type name is given then all types are selected.
## <li> <b>family</b> <em>famname</em> : select elements of this family.
## If no family is given then all families are selected.
## <li> <b>newfam</b> <em>famname</em> : the family to switch to.  This option
## must be given.
## </ul>
## <p>If multiple types are given then all types selected are selected, and
## likewise for families.

proc ic_change_family_elements {args} {
    global uns_cur batch_mode
    
    set types ""
    set fams ""
    set newfam ""
    foreach {n v} $args {
	switch -- $n {
	    type { lappend types $v }
	    family { lappend fams $v }
	    newfam { set newfam $v }
	    default { error "unknown option $n $v" }
	}
    }
    if {$newfam == ""} { error "No newfam argument given" }
    if {$types == ""} { set types MIXED }
    if {$fams == ""}  { set fams all }
    set do_update 1
    if $batch_mode { set do_update 0 }
    fam_check_new $newfam $do_update
    set map [uns_map -mesh $uns_cur]
    $map add_family_type $fams $types 0
    ic_newop
    $map set_family $newfam
    update_uns_visible
    $map delete
    $uns_cur configure -modified 1
}

## Change the selected elements from linear to quadratic.
## options ****

proc ic_change_linear_quadratic {args} {
    global projlib uns_type_visible uns_cur
    
    set check_proj 0
    set iters 10
    set max_dev_chord 35
    set max_dev_half [ expr 1.0 / 6.0 ]
    set max_dev_nproj 30.0
    set max_leap 3.5
    set midface 1
    set project 1
    set refine 0
    set all_elem 1
    set name all
    set check_max_dev_half 0
    set check_max_dev_nproj 0
    set check_max_dev_chord 0
    set check_tet10_standard 0
    set check_tet10_strong 0
    set smooth_refine 0
    set create_interf 0
    set calc_projection 1
    set calc_projection_tol 0.0000001

    foreach {n v} $args {
	    if ![info exists $n] { error "No such parameter $n" }
	    set $n $v
    }
    if $all_elem {
	    set map [$uns_cur get_map all]
    } else {
	    set map [$uns_cur get_map $name]
    }
    set nch 0
    set batch 0
    set vt_table ""
    set n_vt_in_table 0
    set size_entry_vt_table 0
    big_uns_op 1 {
	set nch [$map change_type_linear_quadratic $projlib \
		     $iters $max_dev_half $check_max_dev_half \
		     $max_dev_nproj $check_max_dev_nproj \
		     $max_dev_chord $check_max_dev_chord \
		     $check_tet10_standard $check_tet10_strong \
             $check_proj $max_leap $midface $create_interf $refine \
             $smooth_refine $calc_projection $calc_projection_tol \
             $project $batch $vt_table $n_vt_in_table \
             $size_entry_vt_table $vt_table $n_vt_in_table \
             $size_entry_vt_table]
    }
    if !$all_elem { $map delete }
    if {$nch < 0} {
	    mess "Interrupted - not all elements changed\n" red
    }
    update_uns_available
    $uns_cur configure -modified 1
}

## Change the selected elements from quadratic to linear.
## options ****

proc ic_change_quadratic_linear {name refine {keep_interf 0}} {
    global uns_type_visible uns_cur
    
    set nch 0
    foreach p [$uns_cur list_types] {
	set has_type($p) 1
    }
    set map [$uns_cur get_map $name]
    big_uns_op 1 {
	set nch [$map change_type_quadratic_linear $refine $keep_interf]
    }
    display_update unstruct 0
    foreach p [$uns_cur list_types] {
	if {![info exists has_type($p)] && \
		![info exists uns_type_visible($p)]} {
	    switch $p {
		BAR* - QUAD* - TRI* {
		    set uns_type_visible($p) 1
		}
		default {
		    set uns_type_visible($p) 0
		}
	    }
	}
    }
    ic_delete_disconnected_vertices
    update_uns_available
    
    if {$nch < 0} {
	mess "Interrupted - not all elements/nodes done\n" red
    } elseif $nch {
	mess "$nch elements/nodes converted\n"
    }
    $uns_cur configure -modified 1
}

proc ic_uns_refine_by_midside_nodes {args} {
    global projlib uns_type_visible uns_cur
    
    set check_proj 0
    set iters 10
    set max_dev_chord 35
    set max_dev_half [ expr 1.0 / 6.0 ]
    set max_dev_nproj 30.0
    set max_leap 3.5
    set midface 0
    set project 0
    set refine 0
    set check_max_dev_half 0
    set check_max_dev_nproj 0
    set check_max_dev_chord 0
    set check_tet10_standard 0
    set check_tet10_strong 0
    set smooth_refine 0
    set create_interf 0
    set calc_projection 0
    set calc_projection_tol 0.0000001
    set keep_interf 0
    set refine_midside 1
    set name all
    foreach {n v} $args {
        if ![info exists $n] { error "No such parameter $n" }
        set $n $v
    }
    set map [$uns_cur get_map $name]
    set nch 0
    set batch 0
    set vt_table ""
    set n_vt_in_table 0
    set size_entry_vt_table 0
    big_uns_op 1 {
	    set nch [$map change_type_linear_quadratic $projlib \
		     $iters $max_dev_half $check_max_dev_half \
		     $max_dev_nproj $check_max_dev_nproj \
		     $max_dev_chord $check_max_dev_chord \
		     $check_tet10_standard $check_tet10_strong \
             $check_proj $max_leap $midface $create_interf $refine \
             $smooth_refine $calc_projection $calc_projection_tol \
             $project $batch $vt_table $n_vt_in_table \
             $size_entry_vt_table $vt_table $n_vt_in_table \
             $size_entry_vt_table]
    }
    #update_uns_available
    #$uns_cur configure -modified 1
    if {$nch < 0} {
        mess "Interrupted Step 1 - not all elements refined\n" red
    }
    #set map [$uns_cur get_map all]
    big_uns_op 1 {
        set nch [$map change_type_quadratic_linear $refine_midside $keep_interf]
    }
    ic_delete_disconnected_vertices
    update_uns_available
    $uns_cur configure -modified 1
    if {$nch < 0} {
        mess "Interrupted Step 2 - not all elements refined\n" red
    }
}

## Convert all TRI_3 elements into QUAD_4 elements.

proc ic_change_tri_quad {args} {
    global uns_type_visible projlib batch_mode uns_cur

    set skew 160
    set warp 20
    set iters 6
    set conver 0.25
    set improvement 1
    set quadrization 1
    set debug 0
    set proj 0
    foreach {n v} $args {
        switch $n {
            skew - warp - iters - conver - improvement - proj - quadrization - debug {
                set $n $v
            }
            default { error "unknown option $n $v" }
        }
    }
    
    if {[info exists uns_type_visible(TRI_3)] && \
            ![info exists uns_type_visible(QUAD_4)]} {
        set uns_type_visible(QUAD_4) [set uns_type_visible(TRI_3)]
    }
    if $proj {
        set proj_lib $projlib
    } else {
	set proj_lib ""
    }

    big_uns_op 1 {
        set map [$uns_cur get_map all]
        $map tri_to_quad $skew $warp $quadrization $proj_lib $debug 
        if $improvement {
            $map improve_quad $projlib 0
        }
        if {$iters > 0} {
            ic_smooth_quad all $proj $iters $conver 0 4 
        }
    }
    if !$batch_mode {
        update_uns_available
    }
    $uns_cur configure -modified 1
}


## Extrude selected elements from the currently loaded unstructured mesh.
## The arguments come in keyword value pairs.  The possible options are:
## <ul> 
## <li> <b>type</b> <em>typename</em> : extrude elements of this type, which
## can be TRI_3 or QUAD_4.  If no type name is given then all types
## are selected.
## <li> <b>family</b> <em>famname</em> : extrude elements of this family.  This
## argument can be given more than once for multiple families.
## If no family is given then all families are selected.
## <li><b>dir</b> <em>direction</em> : elements should grow in this direction.
## It can take any one of the following strings:
##     normal       - Normal to the elements,
##     curve_axial  - Along curve dir axially,
##     curve_normal - Along curve dir normal to the curve tangent,
##     "X Y Z"      - Arbitrary Direction
## <li> <b>curve</b> <em>curvename</em> : extrude along the curve
## <li> <b>curvedir</b> <em>[0,1]</em> : direction = 1 if the elements to be 
## extruded in the reverse direction of the curve.
## <li><b>twist</b> <em>twist</em> : twist angle per layer.
## <li><b>space</b> <em>spacing</em> : spacing between adjacent layers.
## <li><b>numlayers></b> <em>numlayers</em> : number of layers to extrude.
## <li><b>volf</b> <em>volume_family</em> : family for the new volume elements.
## <li><b>sidef></b> <em>side_family</em> : family for the exposed sides.
## <li><b>topf</b> <em>top_family</em> : family for the top of the extrusion.
## <li><b>del_orig</b> <em>on</em> : if on is 1 delete the original surface
## <li><b>save_verts</b> <em>on</em> : if on is 1 then save temporary data
## so that another extrusion can be done in the same area
## <li><b>save_node_map</b> <em>name</em> : if given this is the name of
## an UnsMap object that will contain the list of new nodes that are created
## (and the bottom layer which already exists).
## </ul>

proc ic_extrude {args} {
    global uns_cur projlib
    
    if {$uns_cur == ""} { error "no mesh is loaded yet" }
    
    set types ""
    set dir "0 0 1"
    set space 1
    set numlayers 1
    set volf ""
    set sidef ""
    set topf ""
    set dirx_func ""
    set diry_func ""
    set dirz_func ""
    set space_func ""
    set trans_rot_vec "0 0 1"
    set map ""
    set all_elements 0
    set families ""
    set del_orig 0
    set del_covered 1
    set save_verts 0
    set rpoint "0 0 0"
    set rdir "1 0 0"
    set rangle "10.0"
    set save_node_map ""
    set curve ""
    set curvedir 0
    set sidef_is_default 0
    set twist 0
    set degen_tol 0
    set project 0
    set spacing_transl_rot 0.0
    
    foreach {n v} $args {
	switch -- $n {
	    type  { lappend types $v }
	    types {eval lappend types $v}
	    dir - trans_rot_vec - spacing_transl_rot - 
	    space - numlayers - volf - sidef - topf -
	    dirx_func - diry_func - dirz_func - space_func -
	    map - del_orig - save_verts - rpoint - rdir - rangle -
	    all_elements - families - save_node_map - curve  - curvedir -
	    twist - sidef_is_default - del_covered - degen_tol - project {
		set $n $v
	    }
	    family { lappend families $v }
	    default    { error "unknown option $n $v" }
	}
    }

    set del_map 0
    if $all_elements {
        set map [$uns_cur get_map all]
    } elseif {$families != ""} {
        if {$types == ""} { set types MIXED }
        set map [uns_map -mesh $uns_cur]
        $map add_family_type $families $types 0
        $map reorient_volume 0
        set del_map 1
    } else {
        set map [$uns_cur get_map $map]
    }

    set fams ""
    foreach f {volf sidef topf} {
        if {([set $f] != "") && ([set $f] != "inherited")} { lappend fams [set $f] }
    }
    
    set newfams [ic_unstruct_make_families_exist $fams]

    set dir_fixed 1
    if {$dir == "normal"} {
	set dir "0 0 0"
	set dir_fixed 2
    } elseif {$dir == "rotate"} {
	set dir "0 0 0"
	set dir_fixed 3
    } elseif {$dir == "rotate_nomerge"} {
	set dir "0 0 0"
	set dir_fixed 4
    } elseif {$dir == "func"} {
	set dir "0 0 0"
	set dir_fixed 0
    } elseif {$dir == "curve_axial"} {
	set dir "0 0 0"
	set dir_fixed  5
    } elseif {$dir == "curve_normal"} {
	set dir "0 0 0"
	set dir_fixed  6
    }
    set space_fixed 1
    if {$space == "func"} {
	set space 0
	set space_fixed 0
    } elseif {$space == "bunching"} {
	set space 0
	set space_fixed -1
    }

    set save_node_map_obj ""
    if {$save_node_map != ""} {
	set save_node_map_obj [uns_map -mesh $uns_cur -name $save_node_map \
				   -list_type 2]
    }

    if { ($dir_fixed == 5 ||  $dir_fixed == 6) && $curve == ""} {
        mess "Error: No cure specified for Extrusion\n" red
        return
    }
    set curve_num -1
    if {$curve != "" && $projlib != "" } {
        set curve_num [$projlib get_number curve $curve]
    }
    set dir [coords_dir_into_global $dir]
    set rdir [coords_dir_into_global $rdir]
    set rpoint [coords_into_global $rpoint]
    
    big_uns_op 1 {
        set err 0
	    set orig_map [uns_map -mesh $uns_cur]
	    $orig_map copy_from $map 1
	    if [catch {$map extrude_elements $numlayers \
		       $dir_fixed $dir $dirx_func $diry_func $dirz_func \
		       $rpoint $rdir \
		       $space_fixed $space $space_func $rangle \
		       $volf $sidef $topf $save_verts $save_node_map_obj \
		       $projlib $curve_num $curvedir $twist $sidef_is_default \
		       $trans_rot_vec $spacing_transl_rot $degen_tol $project} s] {
	        mess "Error: $s\n" red
	    } else {
	        mess "[lindex $s 1] volume elements created, [lindex $s 0] uncovered faces fixed\n"
	        set ends_merged [lindex $s 2]
	        #in rotate merge this would have already been deleted
	        if {$del_orig && !$ends_merged} { 
		        # Here we have to make sure that we don't make any new uncovered
		        # faces by deleting these.
		        if $del_covered {
		            $orig_map remove_covering_faces
		        }
		        mess "Deleting [lindex [$orig_map count] 0] surface elements\n"
		        $orig_map delete_contents
	        }
	    }
	    $orig_map delete
    }
    unstruct_disconnected_verts 1
    display_update unstruct
    $uns_cur configure -modified 1
    if $del_map { $map delete }
}

# This is called from uns_extrude()
proc unstruct_extrude_eval {expr layer} {
    regsub -all layer $expr $layer expr
    return [eval expr $expr]
}

## This is the old "standalone" program of Uncouple which can
## be launched from the classic ICEM CFD Manager ("icemcfd -3").

proc ic_uncouple_main {args} {
    global uns_cur

    set map [uns_map -mesh $uns_cur]
    set err [eval $map uncouple_main $args]
    #$uns_cur configure -modified 1
    return $err
}

## Regression testing for unstructured meshes using a
## &quot;unique&quot; ID string.

proc ic_test_mesh {{id ""} {min 0} {tol 0} {db -1}} {
    global uns_cur

    set map [uns_map -mesh $uns_cur]
    set err [eval $map test_mesh $id $min $tol $db]
    $uns_cur configure -modified 1
    return $err
}

## Test the quality of unstructured meshes.

proc ic_test_mesh_quality {{min 0} {tol 0} {db -1}} {
    global uns_cur

    set map [uns_map -mesh $uns_cur]
    set err [eval $map test_mesh "none" $min $tol $db]
    $uns_cur configure -modified 1
    return $err
}

## Regression testing for premeshes using a
## &quot;unique&quot; ID string.

proc ic_test_premesh {{id "n_hexa-n_quad-0-0-n_bar-n_coupling-n_vertex-quality"} \
    {fam ""} {tmp_file "ic_test_premesh_tmp.uns"} {min 0} {tol 0} {db -1}} {
    foreach f $fam {
        ic_hex_write_file $tmp_file $f proj 2 dim_to_mesh 1 no_boco
        ic_uns_load_one_domain $tmp_file 2 1
    }
    ic_delete_disconnected_vertices 1
    set err [ic_test_mesh $id $min $tol $db]
    ic_unload_mesh 1
    file delete $tmp_file
    return $err
}

## Test the quality for premeshes.

proc ic_test_premesh_quality {{min 0} {tol 0} {fam ""} \
    {tmp_file "ic_test_premesh_tmp.uns"} {nele_min 0} {nele_max 0} {db 0}} {
    foreach f $fam {
        ic_hex_write_file $tmp_file $f proj 2 dim_to_mesh 1 no_boco
        ic_uns_load_one_domain $tmp_file 2 1
    }
    ic_delete_disconnected_vertices
    set err [ic_test_mesh_quality $min $tol $db]
    if {$err == 0 && $nele_min != 0 && $nele_max != 0} {
        set n_count [expr [ic_count_elements QUAD_4] + [ic_count_elements TRI_3]]
        if {$n_count < $nele_min || $n_count > $nele_max} {
            ic_mess "wrong number of elements ($nele_min < $n_count < $nele_max)\n" red
            set err 1
        }
    }
    ic_unload_mesh 1
    file delete $tmp_file
    return $err
}

## Calculate the length of the given mesh
## <ul>
## <li> <b>name</b>: name of map of the selected elements
## </ul>

proc ic_uns_length {{name "visible"}} {
    global uns_cur

    busy reset
    set map [$uns_cur get_map $name]
    busy 1
    set length [eval $map uns_length]
    busy 0
    return $length
}

## Calculate the area of the given mesh
## <ul>
## <li> <b>name</b>: name of map of the selected elements
## </ul>

proc ic_uns_area {{name "visible"}} {
    global uns_cur

    busy reset
    set map [$uns_cur get_map $name]
    busy 1
    set area [eval $map uns_area]
    busy 0
    return $area
}

## Calculate the volume of the given mesh
## <ul>
## <li> <b>name</b>: name of map of the selected elements
## </ul>

proc ic_uns_volume {{name "visible"}} {
    global uns_cur

    busy reset
    set map [$uns_cur get_map $name]
    busy 1
    set volume [eval $map uns_volume]
    busy 0
    return $volume
}

## Find worst angle in surface mesh.  Returns maximum corner error or warpage.

proc ic_worst_angle {} {
    global uns_cur

    set map [uns_map -mesh $uns_cur]
    set err [eval $map worst_angle]
    $uns_cur configure -modified 1
    return $err
}

## Merge the mesh elements.  The two lists are the family names for the
## surfaces to be merged and the family names for the volume families
## (if any) to be kept fixed.

proc ic_merge_meshes {merge_fams fixed_fams { remove_interface 0 } } {
    global uns_cur
    big_uns_op 1 {
	set map [$uns_cur get_map all]
	if { $remove_interface } {
		$map merge_meshes $merge_fams $fixed_fams -remove_interface
	} else {
		$map merge_meshes $merge_fams $fixed_fams
	}
	$map check_volume_orient 1 NULL
    }
    update_uns_available
    $uns_cur configure -modified 1
}

## Convert a struct mesh to unstruct.<br>
## <b>which</b> is a list of domain numbers - blank if all<br>
## <b>dims</b> is the max dimension to convert - 3 means everything<br>
## <b>all_elems</b> means to convert internal subfaces, edges, and vertices
## which aren't projected to families into unstructured elements also
## (which will be in the ORFN family)<br>

proc ic_struct_to_unstruct {which dims all_elems} {
    global uns_cur str_cur
    
    if {$str_cur == ""} { error "there is no struct mesh" }
    if {$uns_cur != ""} { error "there is already an unstruct mesh" }
    
    busy 1
    set stuff [$str_cur make_unstructured $which $dims $all_elems]
    ic_unload_mesh ;# do_cmd ic_unload_mesh
    set uns_cur [make_new_uns_mesh ""]
    make_standard_maps $uns_cur
    eval $uns_cur import_mesh $stuff
    initialize_unstruct_visibility
    domain_after_load_mesh
    busy 0
    $uns_cur configure -modified 1
    display_update
    update_uns_visible
}

## Moving meshes.

proc ic_uns_move_mesh {origin axis trans theta mm_cmd surfs fsurfs vols} {
    global uns_cur
    
    set args "-rotorigin {$origin} -about {$axis} -trans {$trans} \
 -theta {$theta} -surfs {$surfs} -fluidsurfs {$fsurfs} -fluids {$vols} \
 $mm_cmd"
    
    # puts "about to movemesh with $args"
    eval $uns_cur move_mesh $args
    $uns_cur configure -modified 1
}

proc ic_yplus {ypsurfs fsurfs fluids movemesh_cmd yplus \
		   resmode be file fileismap vertoff var yptol \
		   maxypiter avgmode usecorr corrthres distance} {
    global uns_cur
    
    # required are yplus target value, file name, result mode,
    # and averaging mode
    
    set args "-yplus $yplus -file $file $resmode $avgmode"
    
    # set all optional arguments
    
    if {$fsurfs == "-allfluidsurfs"} {
	append args " $fsurfs"
    } elseif {$fsurfs != ""} {
	append args " -fluidsurfs $fsurfs"
    }
    
    if {$fluids == "-allfluids"} {
	append args " $fluids"
    } elseif {$fluids != ""} {
	append args " -fluids $fluids"
    }
    
    if {$movemesh_cmd != ""} { append args " $movemesh_cmd" }
    if {$fileismap == "1"} { append args " -fileismap" }
    if {$usecorr} { append args " -usecorr" }
    
    foreach n {ypsurfs vertoff be var yptol \
		   maxypiter corrthres distance} {
	set val [set $n]
	if {$val != ""} { append args " -$n $val" }
    }
    # puts "about to y+ with $args"
    
    eval $uns_cur y+ $args
    $uns_cur configure -modified 1
}

proc ic_cache_nodepos {} {
    global uns_cur
    if ![ic_uns_is_loaded] {
	mess "There is no current mesh: please load one\n"
	return
    }
    set map [$uns_cur get_map all]
    $map cache_coords
}

proc ic_free_nodecache {} {
    global uns_cur
    if ![ic_uns_is_loaded] {
	mess "There is no current mesh: please load one\n"
	return
    }
    set map [$uns_cur get_map all]
    $map free_cached_coords
}

## Uncouples hanging nodes of hexahedra.
##
## Users have to take care that the ratio of refinement parameters
## of adjacent faces/blocks has to be 1, 3, 9, 27, 81 ...
##
## The refinement scheme is stable, i.e. the minimum angle does
## not depend on the subdivision level. Concave regions are filled
## with a fine mesh.
##
## 3-1-1 refinement is not supported.  3-3-1 works for 2.5D cases,
## 3-3-3 is fine in general.
## <ul>
## <li><b>proj</b>: Do surface projection if not 0.
## <li><b>three</b>: Pure 3-3-3 refinement if > 0; allow unstable patterns if < 0.
## <li><b>db</b>: Do some checking and printing if > 0.  Default is 0.
## </ul>

proc ic_uns_uncouple {which {proj 0} {three 0} {db 0}} {
    global uns_cur batch_mode
    set err 0
    set map [$uns_cur get_map $which]
    big_uns_op 1 {
        if [catch {
            $map uncouple $proj $three $db
        } res] {
            ic_mess "$res\n" red
            if {!$batch_mode && $three >= 0} {
                ic_mess "Suggestion: Please undo and try again with \"Allow \
                    unstable patterns\".\n" green
            }
            set err 1
        }
    }
    $uns_cur configure -modified 1
    return $err
}

## redistribute prisms

proc ic_uns_redistribute_prism_edge { height {fix_height 1} {ratio 0.0} {local 0} {end_aspect 0.3} {ignore 0}} {
    global uns_cur
    set map [$uns_cur get_map All]
    set fix_ratio 0
    if { $fix_height || $ratio == 0.0 } {
        set param $height
    } else {
        set param $ratio
	    set fix_ratio 1
    }
    set cmd "$map redistribute_prism_edge $param end_aspect $end_aspect"
    if $fix_ratio {
	    append cmd " fix_ratio"
    }
    if $local {
	    append cmd " local"
    }
    if $ignore {
	    append cmd " ignore"
    }
    big_uns_op 1 {
	    eval $cmd
    }
    update_uns_available
    $uns_cur configure -modified 1
}

## Split prisms

proc ic_uns_split_prisms {which layers ratio { layer_number "" } \
			      { height "" } {fams ""} {fams_srf ""} {skip_pyras ""} } {
    global uns_cur    
    
    if ![$uns_cur count PENTA_6 PENTA_15 PENTA_18] {
        user_error "There are no prisms in this mesh"
        return
    }
    
    set map [$uns_cur get_map $which]
    big_uns_op 1 { 
        if {$layer_number != ""} {
	        set cmd "$map split_prism_edge ratio $ratio"
	        if { $height != "" } {
		        append cmd " height $height"
	        }
	        foreach l [ split $layer_number , ] {
		        append cmd " layer $l n_layers $layers"
	        }
	        if {$fams != "" } {
		        append cmd " $fams"
	        }
	        if {$fams_srf != "" } {
		        append cmd " ( $fams_srf )"
	        }
	        if { $skip_pyras == "skip_pyras" } {
		        append cmd " skip_pyras"
	        }
    	    eval $cmd
        } elseif {$height != ""} {
	        if { $skip_pyras == "skip_pyras" } {
    	        eval $map split_prism_edge $layers exponential $ratio height $height $fams skip_pyras
            } else {
    	        eval $map split_prism_edge $layers exponential $ratio height $height $fams
            }
	    } else {
	        if { $skip_pyras == "skip_pyras" } {
    	        eval $map split_prism_edge $layers exponential $ratio $fams "( $fams_srf )" skip_pyras
            } else {
    	        eval $map split_prism_edge $layers exponential $ratio $fams "( $fams_srf )"
            }
        }
    }
    update_uns_available
    $uns_cur configure -modified 1
}

## Dissolve prisms

proc ic_uns_dissolve_prisms {which height_ratio prism_qual triangle_qual \
	                     clear_tops} {
    global uns_cur
    set map [$uns_cur get_map $which]
    # note that disolve is misspelled in the c-code
    set cmd "$map disolve_prisms height_ratio $height_ratio \
			prism_quality $prism_qual \
			triangle_quality $triangle_qual"
    if $clear_tops { lappend cmd clear_tops }
    eval $cmd
    update_uns_available
    $uns_cur configure -modified 1
}

## Convert tetras to hexas.  It won't be done if the hexas have aspect ratio
## worse than <b>min_aspect</b>.

proc ic_uns_convert_to_hexas {{min_aspect 1} {volfams ""} {use_active_lcs 0}} {
    global uns_cur

    set  map [$uns_cur get_map all]
    big_uns_op 1 {
	if {$use_active_lcs == 1} {
            eval $uns_cur convert_to_hexas min_aspect $min_aspect $volfams use_active_lcs 
        } else {
            eval $uns_cur convert_to_hexas min_aspect $min_aspect $volfams 
        }
	set nf [$map check_volume_orient 1 NULL]
    }
    update_uns_available
    $uns_cur configure -modified 1
}

## Convert tetras to hexas in batch mode from input file. 
## It won't be done if the hexas have aspect ratio worse than <b>min_aspect</b>.

proc ic_uns_convert_to_hexas_in_batch {infile outfile {min_aspect 1} {volfams ""} {use_active_lcs 0}} {
    set prog "icemcfd/smooth"
    
    set argv " $infile -no_check -command"

    if {$use_active_lcs == 1} {
## not implemented
##      append argv " \"convert_to_hexas min_aspect $min_aspect $volfams use_active_lcs\"" 
        append argv " \"convert_to_hexas min_aspect $min_aspect $volfams \"" 
    } else {
        append argv " \"convert_to_hexas min_aspect $min_aspect $volfams \"" 
    }
    append argv " -o $outfile"

    catch {run_application_batch $prog SMOOTHER_BIN $argv}
    if ![file exists $outfile] {
	ic_mess "tet2hex conversion failed\n"
    }
    
    ic_mess "tet2hex conversion finished\n"
}

## Create or delete couplings

proc ic_uns_coupling {what args} {
    global uns_cur
    switch $what {
	create {
	    $uns_cur create_coupling [$uns_cur get_map [lindex $args 0]] \
		[$uns_cur get_map [lindex $args 1]]
	}
	clear {
	    $uns_cur clear_couplings
	}
    }
    $uns_cur configure -modified 1
}

## Create or delete thickness for surface mesh
##
##  from_solid = 1 = nearest point projection
##  from_solid = 2 = piercing
##

proc ic_uns_thickness {what {name all} {val 0} {strict 1} {from_solid 0} {surfs ""}} {
    global uns_cur projlib
    
    if {$uns_cur == ""} return
    
    set map [$uns_cur get_map $name]
    switch $what {
	create {
            set nums ""
            foreach obj $surfs {
            lappend nums [$projlib get_number_by_name surface $obj]
            }
	    $map create_thickness $strict $from_solid $nums 
	}
	clear {
	    $map clear_thickness
	}
	set {
	    $map set_thickness $val 1
	}
	set_part {
	    $map set_thickness $val 0
	}
    }
    $uns_cur configure -modified 1
    ic_uns_families_changed
}

## Apply thickness on specific nodes

proc ic_uns_thickness_at_node {name val} {
    global uns_cur
    if {$uns_cur == "" || $name == ""} return
    set map [$uns_cur get_map $name]
    $map create_thickness_node $val
    $uns_cur configure -modified 1
}


## Create or delete bar orientations for line elements

proc ic_uns_bar_orientation {what {name all} {x1 0} {x2 0} {x3 0} {wa1 0} {wa2 0} {wa3 0} {wb1 0} {wb2 0} {wb3 0}} {
    global uns_cur
    
    if {$uns_cur == ""} return
    
    set map [$uns_cur get_map $name]
    switch $what {
	clear {
	    $map clear_bar_orientation
	}
	set {
	    $map set_bar_orientation $x1 $x2 $x3 $wa1 $wa2 $wa3 $wb1 $wb2 $wb3 1
	}
	set_part {
	    $map set_bar_orientation $x1 $x2 $x3 $wa1 $wa2 $wa3 $wb1 $wb2 $wb3 0
	}
	get {
	    return [$map get_bar_orientation]
	}
    }
    $uns_cur configure -modified 1
    ic_uns_families_changed
}

## List the strings in the domain file

proc ic_uns_list_strings {} {
    global uns_cur
    return [$uns_cur list_strings]
}
set dont_record_command(ic_uns_list_strings) 1

## Set a string in the domain file

proc ic_uns_set_string {name val} {
    global uns_cur
    $uns_cur set_string $name $val
    $uns_cur configure -modified 1
}

## Split double walls

proc ic_uns_split_double_wall {which} {
    global uns_cur
    set map [$uns_cur get_map $which]
    ic_newop
    set ret [$map split_double_wall]
    update_uns_visible
    if ![string match "*no double wall*" $ret] {
        $uns_cur configure -modified 1
    }
    return $ret
}

## Split internal faces

proc ic_uns_split_internal_faces {which fam {new_fam_suffix ""} {splitfam 0} {volfam ""}} {
    global uns_cur projlib
    set map [$uns_cur get_map $which]
    
    set original [ic_uns_subset_create]
    ic_uns_update_family_type $original $fam 2d update
    set sub [ic_uns_subset_create]
    ic_uns_subset_add_by_neighbors $fam $sub 2

    set cmd [list $map split_internal_faces]
    set cmd [concat $cmd $fam]
    
    if { $new_fam_suffix != "" } {
# create the new families if necessary
	set nfams ""
	foreach f $fam {
	    lappend nfams $f$new_fam_suffix
	    ic_uns_new_family $f$new_fam_suffix
	}
    	set cmd [concat $cmd new_families $nfams]
    }
    if {$volfam != ""} {
	ic_uns_new_family $volfam
	lappend cmd volfam $volfam
    }
    big_uns_op 1 {
        set ret [eval $cmd]
    }
    # Set the internal wall families to the surface family
    if $splitfam {
	set smap [$uns_cur get_map $sub]
	set ret [eval $smap split_internal_face_family $projlib]

	set sub2 [ic_uns_subset_create]
	ic_uns_update_family_type $sub2 $fam 2d update
	ic_uns_subset_subtract_from $sub2 $original
	set smap [$uns_cur get_map $sub2]
	set ret [eval $smap split_internal_face_family $projlib]
	ic_uns_subset_delete $sub2

	foreach matfam [ic_uns_list_material_families] {
	    set sourcemap [ic_uns_subset_create]
	    set types 3d
	    ic_uns_subset_add_families_and_types $sourcemap $matfam $types	    
	    ic_uns_subset_add_layer $sourcemap 1 all surf
	    set tmpmap [ic_uns_subset_create]
	    set types 2d
	    ic_uns_subset_add_families_and_types $tmpmap $matfam $types

	    ic_uns_subset_subtract_from $sourcemap $tmpmap
	    ic_uns_update_family_type $sourcemap __same__ 2d restrict_to
	    catch {unset sfam}
	    foreach el [ic_uns_subset_list_elements $sourcemap] {
		set elfam [lindex $el 2]
		if ![info exists sfam($elfam)] {
		    set sfam($elfam) 1
		} else {
		    incr sfam($elfam)
		}
	    }

	    set nfam ""; set nmax 0;
	    foreach f [array names sfam] {
		if {$sfam($f) > $nmax} {
		    set nfam $f
		    set nmax $sfam($f)
		}
	    }

	    if {$nfam != ""} {
		ic_uns_new_family $nfam
		ic_uns_change_family $tmpmap $nfam
	    }
	    ic_uns_subset_delete $sourcemap
	    ic_uns_subset_delete $tmpmap
	}
    }
    update_uns_available
    update_uns_visible
    ic_uns_subset_delete $sub
    ic_uns_subset_delete $original

    $uns_cur configure -modified 1
    return $ret
}

## Make consistent

proc ic_uns_make_consistent {which { count_open "" } { flood_fill 1 } } {
    global uns_cur
    set map [$uns_cur get_map $which]
    big_uns_op 1 {
	set cmd "make_consistent $count_open"
	if { $flood_fill == 0 } {
		append cmd " -no_flood_fill"
	}
	set ret [ eval $map $cmd ]
	set nf [$map check_volume_orient 1 NULL]
        if { $nf } {
		set nf [$map check_volume_orient 1 NULL]
	}
    }
    update_uns_available
    $uns_cur configure -modified 1
    return $ret
}

## Check edges

proc ic_uns_check_edges {which} {
    global uns_cur
    set map [$uns_cur get_map $which]
    set ret [$map check_edges]
    update_uns_visible
    $uns_cur configure -modified 1
    return $ret
}

## Split pyras

proc ic_uns_split_pyras {which} {
    global uns_cur
    set map [$uns_cur get_map $which]
    set ret [$map split_pyras]
    update_uns_visible
    $uns_cur configure -modified 1
    return $ret
}

## Check orientation of the subset <b>which</b> which
## is, by default, <em>All</em>.
## returns 1 for ok
## err_name is the name of a subset which will be created if there are errors

proc ic_uns_check_orientation {{which All} {err_name ""} {do_fix 0} {quiet 0}} {
    global uns_cur fam_visible interrupt_disable
    
    set map [$uns_cur get_map $which]
    set only_active 0
    if {$which == "visible" || $which == "selected"} {
	    $map clear
	    set parts ""
	    foreach f [array names fam_visible] {
	        set vis [get_fam_visible $f]
	        if $vis { lappend parts $f }
	    }
#	    $map promote_type 2
	    $map add_family_type $parts MIXED 0
	    set only_active 1
    }
    if {$err_name == ""} {
	    set err_map NULL
    } else {
	    set err_map [$uns_cur get_map $err_name]
	    #set err_map [uns_map -mesh $uns_cur -name $err_name -visible 0]
    }
    if $do_fix { set chfix Fixing } else { set chfix Checking }
    if ![info exists interrupt_disable] {
        interrupt begin "$chfix orientation" "$chfix orientation" 1000
    }
    set ret [$map check_orientation $do_fix $err_map "" $only_active]
    catch { interrupt finish }
    
    update_uns_visible
    if !$quiet { ic_print_error_log $ret }
    $uns_cur configure -modified 1
    foreach i $ret {
        set i [ string trim $i ]
        if [ string match "no orientation errors" $i ] continue
        if [ string match "faces are correctly oriented" $i ] continue
        #mess "I interpret \"$i\" as a problem\n"
        return 0
    }
    return 1
}

## Change orientation

proc ic_uns_orient { dir } {
    global uns_cur
    if [ catch { $uns_cur orient_mesh $dir } res ] {
	ic_mess "$res\n" red
	return 1
    } else {
	return 0
    }
}

## Change orientation

proc ic_uns_reorient {name how args} {
    global uns_cur
    set map [$uns_cur get_map $name]
    
    ic_newop
    busy 1
    switch $how {
	dir {
	    set dir [coords_dir_into_global [lindex $args 0]]
	    set n [$map reorient_direction $dir]
	}
	flip {
	    set n [$map reorient_all]
	}
	vol {
	    set n [$map reorient_volume [lindex $args 0]]
	}
	consistent {
	    set ref [$uns_cur get_map [lindex $args 0]]
	    set n [$map reorient_consistent $ref]
	}
	ijk {
	    set args1 [lindex $args 0]
	    set how_ijk [lindex $args1 0]
	    if {$how_ijk == "1"} {
		set ref [$uns_cur get_map [lindex $args1 1]]
	    	set n [$map reorient_origin $ref]
	    } else {
		if [catch {eval $map reorient_ijk $args1} n] {
		    mess "Error: reorient_ijk failed\n" red
		    busy 0
		    return 0
		}
#		set n [$map reorient_ijk $args1]
	    }
	}
    }
    busy 0
    if $n { $uns_cur configure -modified 1 }
    return $n
}

## Reorder elements

proc ic_uns_reorder {name how args} {
    global uns_cur
    set map [$uns_cur get_map $name]
    
    ic_newop
    busy 1
    switch $how {
	dir {
	    
	    set dir [coords_dir_into_global [lindex $args 0]]
	    set n [$map reorder_direction $dir]
	}
    }
    busy 0
    if $n { $uns_cur configure -modified 1 }
    return $n
}

## Return the max vertex degree

proc ic_uns_max_vertex_degree {which} {
    global uns_cur
    set map [$uns_cur get_map $which]
    set ret [$map max_vertex_degree]
    return $ret
}
set dont_record_command(ic_uns_max_vertex_degree) 1

## Coarsen the mesh

proc ic_uns_coarsen {which aspect fixfams tol n_iter surface \
		     size_check max_size} {
    global uns_cur
    
    #fix for bug - 7732
    if ![ic_geo_is_loaded] {
	ic_empty_tetin
    }
    set map [$uns_cur get_map $which]
    
    if {$fixfams != ""} { set fixfams "fix_families $fixfams" }
    
    # need a tolerance for triangle coarsening
    set toler ""
    if { [ic_count_elements TETRA_4 ] == 0 } {
	set toler "tol $tol"
    }
    set cmd "coarsen_elements $aspect $toler"
    if { $n_iter >= 1 } {
	append cmd " n_iter $n_iter"
    }
    if { $surface } {
	append cmd " surface"
    }
    if { $size_check } {
	append cmd " size_check"
    }
    if { $max_size != "" } {
	append cmd " max_size $max_size"
    }
    append cmd " $fixfams"
    
    big_uns_op 1 {
	eval $map $cmd
	set nf [$map check_volume_orient 1 NULL]
    } 1

    # this operation deletes disconnected vertices
    # delete them automatically say Anshul & Ben
    ic_delete_disconnected_vertices
    
    # The coarsener resets all node numbers to -1, so fix them here
    # Eventually this should change
    ic_uns_renumber_nodes all 1
    
    $uns_cur configure -modified 1
}

##  Coarsen quad dominant mesh

proc ic_uns_coarsen_quad { {name visible} {dev 0.1} {edge_len -1} {steps 1} } {
   global uns_cur
   ic_newop
   set map [$uns_cur get_map $name]
   busy 1
    big_uns_op 1 {
	eval $map coarsen_quad $dev $edge_len $steps
   ic_delete_disconnected_vertices
    } 1
   set proj [ic_geo_is_loaded]
   busy 0
   $uns_cur configure -modified 1
   ic_mess "Done with Coarsening\n" red
}

## Merge nodes by tolerance.  <b>name</b> is the map to merge, <b>tol</b>
## is the tolerance below which to merge.  If <b>pos</b> and <b>norm</b> are 
## non-null triples, they define a plane to limit the node merging to.
## That is, only nodes on the plane are considered for merging.
## If <b>propagate</b> is selected set, then the merging will continue through
## the mesh. If <b>force</b> is set, then the nodes will be merged regardless
## of their dimension.
## If <b>merge_average</b> is selected set, then the nodes will be merged by the
## average.

proc ic_uns_merge_nodes {name tol { pos "0 0 0" } { norm "0 0 0" } \
			     { propagate 0 } {force 0} {merge_blindly 0} \
			     { merge_average 0} {only_unconnected_single_edges 0}} {
    global uns_cur
    set map [$uns_cur get_map $name]
    ic_newop
    busy 1
    if {$tol == ""} {
        #puts "$map merge_nodes $propagate $force"
        #puts "have [$map count]"
        set n [$map merge_nodes $propagate $force $merge_average]
        #puts $n
    } else {
        if {$tol == "by_min_edge"} {
            set tol [expr {[$map min_edge_length] / 10.0}]
        }
        if {$tol == "by_min_edge2"} {
            set tol [expr {[$map min_edge_length] / 50.0}]
        }
        if {$tol == 0.0} { set tol 0.001}
        mess "Merging nodes with tolerance $tol\n"
        set n [$map merge_nodes_tol $tol 1 $pos $norm $force $merge_blindly $only_unconnected_single_edges]
        mess "[lindex $n 2] merged nodes were eliminated\n"
    }
    busy 0
    if [lindex $n 2] { $uns_cur configure -modified 1 }
    set ret_val [concat $n [expr [lindex [$map count] 1] - 1]] 
    # this operation deletes disconnected vertices
    # delete them automatically say Anshul & Ben
    ic_delete_disconnected_vertices 
    return $ret_val
}

proc ic_uns_merge_nodes_old {name tol} {
    global uns_cur
    set map [$uns_cur get_map $name]
    ic_newop
    busy 1
	mess "Merging nodes with tolerance $tol\n"
	$map merge_unstruct $tol
    busy 0
}

## Tries to merge the list of nodes given in a flat TCL list <e>nums</e>,
## returns the number of nodes merged. For the remaining arguments,
## see ic_uns_merge_nodes above.

proc ic_uns_merge_node_numbers {nums tol { pos "0 0 0" } { norm "0 0 0" } \
        { propagate 0 } } {
    
    if {"" == $nums} { return 0 }
    set nodessubset [ic_uns_subset_create]
    ic_uns_subset_add_node_numbers $nodessubset $nums    
    set retval [ic_uns_merge_nodes $nodessubset $tol $pos $norm $propagate]
    ic_uns_subset_delete $nodessubset
    return $retval
}

## Report the min triangle size

proc ic_uns_min_tri_size {name} {
    global uns_cur
    set map [$uns_cur get_map $name]
    return [$map min_tri_size]
}
set dont_record_command(ic_uns_min_tri_size) 1

proc ic_uns_min_quad_size {name} {
    global uns_cur
    set map [$uns_cur get_map $name]
    return [$map min_quad_size]
}
set dont_record_command(ic_uns_min_quad_size) 1

## Move nodes

proc ic_uns_move_nodes_exact {name set pos dir { csys_name "" }} {
    global uns_cur
    ic_newop
    set map [$uns_cur get_map $name]
    $uns_cur configure -modified 1
    set pos2 $pos
    set dir2 $dir
    if { $csys_name == "" } {
	set pos2 [coords_into_global $pos]
	set dir2  [coords_dir_into_global $dir]
    }
    return [$map move_nodes_exact $set $pos2 $dir2 $csys_name]
}

## Delete elements adjacent to nodes in the given map
proc ic_uns_delete_nodes {name {fix_uncovered 1}} {
    global uns_cur

    ic_newop
    set elmap [ic_uns_subset_create]
    ic_uns_add_near_node $elmap $name
    set map [$uns_cur get_map $elmap]
    if $fix_uncovered {
        set fix_fam ""
        set surf_fams [ic_uns_list_families 2]
        set elfams [ic_uns_subset_list_families $elmap]
        foreach f $elfams {
            if {[lsearch $surf_fams $f] > -1} {
                set fix_fam $f
                break
            }
        }
        set ngh_map [ic_uns_subset_create "" 0 $elmap]
        ic_uns_subset_add_layer $ngh_map 1 all all
    }
    $map delete_contents
    ic_uns_subset_delete $elmap
    if $fix_uncovered {
        if {$fix_fam == ""} {set fix_fam UNCOVERED_FACES}
        if [ic_uns_check_family $fix_fam] {
            ic_uns_fix_uncovered_faces $ngh_map $fix_fam
        }
        ic_uns_set_projected_family $ngh_map
        ic_uns_subset_delete $ngh_map
    }
    $uns_cur configure -modified 1
}

## Refine triangular/quad/tetra surface mesh.
## <ul>
## <li> <b>dev</b>: maximum surface deviation or -1
## <li> <b>steps</b>: maximum number of refinement steps
## <li> <b>proj</b>: do surface projection if not 0
## <li> <b>tri_only</b>: refine triangles only if not 0
## <li> <b>edge</b>: maximum edge length or -1
## <li> <b>asp</asp></b>: maximum aspect ratio or -1
## </ul>

proc ic_uns_refine_surface {name dev steps proj {tri_only 0} {edge -1} \
    {asp -1} {nobound 0} } {
    global uns_cur projlib

    set debug 0
    if {$debug} {
        ic_mess "$name = \"[ic_uns_subset_list_elements $name]\"\n" red
    }
    set map [$uns_cur get_map $name]
    if $proj {
        set pl $projlib
    } else {
        set pl NULL
    }
    if {$debug} {
        ic_mess "ic_uns_refine_surface, dev = $dev, steps = $steps, proj = $proj" red
        ic_mess ", edge = $edge, asp = $asp, tri_only = $tri_only" red
        ic_mess ", nobound = $nobound, pl = $pl\n" red
    }
    set nch 0
    set new_elems ""
    if {$name == "visible"} {
        big_uns_op 0 {
            set nch [$map surf_refine $dev $edge $asp $steps $tri_only $nobound $pl]
        }
    } else {
        ic_newop
        start_new_elems
        busy 1
        set nch [$map surf_refine $dev $edge $asp $steps $tri_only $nobound $pl]
        finish_new_elems
        busy 0
    }
    if {[lindex $nch end] >= 0} {
        set new_elems [lrange $nch 0 end]
    }
    $uns_cur configure -modified 1
    return $new_elems
}

## Insert tetras

proc ic_uns_insert_tetra {{name all} {mid 0}} {
    global uns_cur projlib
    
    set map [$uns_cur get_map $name]
    ic_newop
    busy 1
    if [catch {
        $map insert_tetra $mid
    } res] {
        ic_mess "$res\n" red
    }
    busy 0
    $uns_cur configure -modified 1
}

## Delete the contents of a subset

proc ic_uns_delete_contents {name} {
    global uns_cur
    if {$uns_cur == ""} { return }
    ic_newop
    set map [$uns_cur get_map $name]
    $map delete_contents
    $uns_cur configure -modified 1
}

## Project nodes

proc ic_uns_set_node_dimension {name how {add_bars 0} {fam_active ""} {proj_mth 0} {normal_flag 0} {dir_vec ""}} {
    global uns_cur projlib
    ic_newop
    set map [$uns_cur get_map $name]
    set n_rej 0
    if {$how == "reset"} {
        busy 1
        start_new_elems
        $map reset_node_dimension $add_bars
        finish_new_elems
        busy 0
        display_update unstruct 0
    } else {
        if {$dir_vec == ""} {
            set dir_vector [list 0 0 0]
        } else {
            set dir_vector $dir_vec
        }
        set n_rej [$map set_node_dimension $how $projlib $fam_active $proj_mth $normal_flag $dir_vector]
        if {[string is integer $n_rej] && $n_rej > 0} {
            mess "Did not project $n_rej node(s)\n" red
            if $normal_flag {
                mess "because angle between surface normal and vector defined by original and projected node greater than 5 degrees\n" red
            }
        }
    }
    $uns_cur configure -modified 1
    return $n_rej
}

## Get node positions

proc ic_uns_get_node_positions {name} {
    global uns_cur
    set map [$uns_cur get_map $name]
    return [$map get_node_positions]
}
set dont_record_command(ic_uns_get_node_positions) 1

## Set node positions

proc ic_uns_set_node_positions {name pos_list} {
    global uns_cur
    ic_newop
    set map [$uns_cur get_map $name]
    eval $map set_node_positions $pos_list
    $uns_cur configure -modified 1
}

## Get all the node positions for the elements in this map.  This returns a
## list of {x y z} values, for each node in each element.  If <b>allow_dups</b>
## is 1 duplicates are allowed, otherwise the duplicates are filtered out
## and no guarantee is made about the ordering of the vertex positions.

proc ic_uns_get_element_vertex_positions {name allow_dups} {
    global uns_cur
    set map [$uns_cur get_map $name]
    return [$map get_element_vertex_positions 0 $allow_dups]
}
set dont_record_command(ic_uns_get_node_positions) 1

## Add adjacent tetras from one map to another

proc ic_uns_add_adjacent_tetras {dest src} {
    global uns_cur
    set dmap [$uns_cur get_map $dest]
    set smap [$uns_cur get_map $src]
    $uns_cur configure -modified 1
    return [$dmap add_adjacent_tetras $smap]
}

## Add all elements to a map near the nodes in another map

proc ic_uns_add_near_node {dest src} {
    global uns_cur
    set dmap [$uns_cur get_map $dest]
    set smap [$uns_cur get_map $src]
    $dmap add_near_node $smap
    $uns_cur configure -modified 1
}

## Restrict what's in a subset to a set of families and types.
## <ul>
## <li><b>name</b> is the name of the subset
## <li><b>fams</b> is a list of families to turn on, or if preceeded by a ! then
## to turn off (if a family isn't listed then it's not touched, __all__ means
## all families, and __same__ means don't touch any)
## <li><b>types</b> is a list of types to turn on, or if preceeded by a ! then
## to turn off (if a type isn't listed then it's not touched, __all__ means
## all types, and __same__ means don't touch any)
## <li><b>what</b> is update, restrict_to, add, or remove
## <li><b>force</b> is 0 if this command should not touch non-family-type
## maps.
## </ul>

proc ic_uns_update_family_type {name {fams __all__} {types __all__} {what update} {force 1}} {
    global uns_cur temp_family_var temp_type_var
    
    if {$uns_cur == ""} return
    set map [$uns_cur get_map $name]
    if {"" == $map} { return }
    
    if {$fams == "__same__"} {
	set famvar ""
    } else {
	set famvar temp_family_var
	catch {unset temp_family_var}
	if {$fams == "__all__"} {
	    foreach f [$uns_cur list_families] { set temp_family_var($f) 1 }
	} else {
	    foreach f [$uns_cur list_families] { set temp_family_var($f) 0 }
	    foreach f $fams {
		if [string match !* $f] {
		    set temp_family_var([string range $f 1 end]) 0
		} else {
		    set temp_family_var($f) 1
		}
	    }
	}
    }
    if {$types == "__same__"} {
	set typevar ""
    } else {
	set typevar temp_type_var
	catch {unset temp_type_var}
	foreach f [$uns_cur list_types] { set temp_type_var($f) 0 }
	foreach f $types {
	    set on 1
	    if [string match !* $f] {
		set on 0
		set type [string range $f 1 end]
	    }
	    switch $f {
		0d {
		    foreach f {NODE} {
			set temp_type_var($f) $on
		    }
		}
		1d {
		    foreach f {BAR_2 BAR_3 LINE_2 LINE_3} {
			set temp_type_var($f) $on
		    }
		}
		2d {
		    foreach f {TRI_3 TRI_6 QUAD_4 QUAD_8 QUAD_9} {
			set temp_type_var($f) $on
		    }
		}
		3d {
		    foreach f {
			TETRA_4 TETRA_10 HEXA_8 HEXA_20 PENTA_6 PENTA_15
			HEXA_27 PENTA_18 PYRA_5 PYRA_14 PYRA_13
		    } {
			set temp_type_var($f) $on
		    }
		}
		__all__ {
		    foreach f [$uns_cur list_types] {
			set temp_type_var($f) $on
		    }
		}
		default {
		    set temp_type_var($f) $on
		}
	    }
	}
    }
    
    #puts [list $map ${what}_family_type $famvar $typevar $force]
    #parray $famvar
    #parray $typevar
    
    if {$what == "remove" } {
        $map ${what}_family_type $famvar $typevar
    } else {
        $map ${what}_family_type $famvar $typevar $force
    }
    $uns_cur configure -modified 1
}
    
# dont record this command otherwise you get a new replay line
# everytime you change the display 
# command that use the families or types had better
# have a separate way to know the families

# Actually this is needed because you get things like
# ic_uns_subset_add_pick_single 1d uns_sel_0 {-0.42796005706134094 0.18188302425106989 0} {0 0 0.0014265335235378032} Selected
# which depend on it
# set dont_record_command(ic_uns_update_family_type) 1

## Split a node non-manifold

proc ic_uns_split_node_non_man {sel_map move_map} {
    global uns_cur
    set smap [$uns_cur get_map $sel_map]
    set mmap [$uns_cur get_map $move_map]
    if [ catch { $smap split_node_non_man $mmap } res ] {
	user_error $res
    }
    $uns_cur configure -modified 1
}

## Fix some nonmanifold verts

proc ic_uns_fix_non_man {name} {
    global uns_cur projlib
    
    ic_newop
    set map [$uns_cur get_map $name]
    $map fix_nmanvert $projlib
    $uns_cur configure -modified 1
    set nleft [lindex [$map count] 1]
    if $nleft {
	mess "$nleft non-manifold vertices\
		could not be fixed\n" red
    } else {
	mess "All non-manifold vertices were fixed.\n"
    }
    return $nleft
}

## Fix missing internal faces

proc ic_uns_fix_missing_internal {name fam proj} {
    global uns_cur projlib
    
    if $proj { set pl $projlib } else { set pl "" }
    
    set map [$uns_cur get_map $name]
    big_uns_op 0 {
	set nn [$map fix_missing_internal_faces $fam $pl]
    }
    if $nn { $uns_cur configure -modified 1 }
    mess "$nn internal faces added\n"
    return $nn
}

## Fix uncovered faces

proc ic_uns_fix_uncovered_faces {name fam} {
    global uns_cur
    
    set nn 0
    set map [$uns_cur get_map $name]
    big_uns_op 0 {
	    set nn [$map fix_uncovered $fam 0]
    }
    $uns_cur configure -modified 1
    mess "$nn uncovered faces added\n"
    return $nn
}

## Fix triangle boxes

proc ic_uns_fix_triangle_boxes {name fam} {
    global uns_cur projlib
    
    set map [$uns_cur get_map $name]
    big_uns_op 0 {
        set nn [$map fix_triangle_box $fam]
    }
    $uns_cur configure -modified 1
    mess "$nn triangle boxes replaced with tetras\n"
    return $nn
}

## Fix incorrectly oriented volume elements

proc ic_uns_fix_volume_orientation {name} {    
    global uns_cur
    
    set map [$uns_cur get_map $name]
    $map check_volume_orient 1 NULL
    set n2 [$map check_volume_orient 0 NULL]
    if $n2 {
        mess "$n2 elements could not be fixed -- probably the element quality is too bad.\n" red
    } else {
        mess "Fixed all element orientations.\n"
    }
    return $n2
}

## Fix problematic elements (plus two layers) by remeshing the map of given name

proc ic_uns_fix_subset_by_remeshing {mapname} {    
    
    set nbads [ic_uns_subset_count_elements $mapname]
    if {0 >= $nbads} { return 0 }
    
    set nlayers 3
    set types {TRI_3 QUAD_4}
    set fams [ic_uns_list_families]
    ic_uns_subset_add_layer $mapname $nlayers $fams $types
    
    mess "\nRemeshing [ic_uns_subset_count_elements $mapname] elements to fix problematic regions\n"
    
    set proj [ic_geo_is_loaded]
    set debug 0
    set all_dim 0
    set max_steps 20
    if [catch { ic_remesh_bad_elements $mapname 2 $proj $debug $all_dim $max_steps } res] {
	mess "$res\n" red
	return 0
    }
    mess "...done.\n"
    return 1
}

## Create a "scan plane" based on one element.  This only works for hexas
## and prisms
## ssname set n1 n2 n3 size1 size2 size3
## ssname advance n1 n2 n3

proc ic_uns_scan_plane {mapname what args} {
    global uns_cur
    
    set map [$uns_cur get_map $mapname]
    switch $what {
	set {
	    foreach a $args n {n1 n2 n3 s1 s2 s3} v {1 1 1 0 0 0} {
		if {$a == ""} { set $n $v } else { set $n $a }
	    }
	    $map scan_plane_set $n1 $n2 $n3 $s1 $s2 $s3
	}
	advance {
	    $map scan_plane_advance [lindex $args 0] [lindex $args 1] \
		[lindex $args 2]
	}
    }
}

## Duplicate elements and their nodes

proc ic_uns_duplicate_elements {src dest} {
    global uns_cur
    ic_newop
    set map [$uns_cur get_map $src]
    set dmap [$uns_cur get_map $dest]
    $uns_cur configure -modified 1
    return [$dmap duplicate_elements $map]
}

## Move an existing mesh subset.  The <b>name</b> argument gives the subset
## to operate on.
## <ul>
## <li> <b>cent</b> : a list of X Y Z giving the center for rotation, scaling,
## and mirroring, which could be "centroid"
## <li> <b>translate</b> : the X Y Z values for translating the entity
## <li> <b>rotate</b> : the number of degrees to rotate the object about the
## axis given by <b>rotate_axis</b>
## <li> <b>rotate_axis</b> : the vector giving the axis to rotate about
## <li> <b>scale</b> : a scale value, or 3 values giving the factor to scale
## in X Y and Z
## <li> <b>mirror</b> : the axis about which to mirror
## <li> cent, translate, rotate_axis and mirror are defined in active LCS 
## </ul>

proc ic_uns_move_elements {name args} {
    global uns_cur
    
    set map [$uns_cur get_map $name]
    if {$map == ""} return
    if {[$map get -list_type] != 0} {
	set nn [$map separate_nodes]
	if $nn {
	    mess "$nn nodes detached from non-moving elements\n"
	}
    }
    
    set cent "0 0 0"
    set translate ""
    set rotate ""
    set rotate_axis "0 0 1"
    set scale ""
    set mirror ""
    
    foreach {n v} $args { set $n $v }
    
    if {$cent == "centroid"} {
	set bb [$map get_bbox]
	set bmin [lindex $bb 0]; set bmax [lindex $bb 1]
	set cent ""
	foreach i {0 1 2} {
	    lappend cent [expr {([lindex $bmin $i] + [lindex $bmax $i]) / 2.0}]
	}
    } else {
	set cent [coords_into_global $cent]
    }
    set rotate_axis [coords_dir_into_global $rotate_axis]
    set translate   [coords_dir_into_global $translate]
    set mirror      [coords_dir_into_global $mirror]
    
# big_uns_op 1 does not work for multiple copies (for Onyx ID 40101, Ulrike)
    big_uns_op 0 {
	if {$translate != ""} {
	    $map translate_nodes $translate
	}
	if {$rotate != ""} {
	    $map rotate_nodes $rotate_axis $rotate $cent
	}
	if {$scale != ""} {
	    if {[llength $scale] == 1} { set scale "$scale $scale $scale" }
	    $map scale_nodes $scale $cent
	}
	if {$mirror != ""} {
	    $map mirror_nodes $mirror $cent
	}
    }
    $uns_cur configure -modified 1
}

# --------------------------------------------------------------------------

## Create a subset.  The options are:
## <ul>
## <li> <b>name</b> : the name to use - default is a uniquely generated one
## <li> <b>vis</b> : 1 if the map should be visible
## <li> <b>copy_from</b> : if not blank, the name of a map to copy the
## initial contents of this one from
## <li> <b>pid_colors</b> : if 1, display the elements colored by family,
## otherwise the color parameter of the map is used
## <li> <b>editable</b> : 1 if this map should be modifiable
## </ul>
## The return value is the name of the map.

proc ic_uns_subset_create {{name ""} {vis 0} {copy_from ""} {pid_colors 1} \
			   {editable 1}} {
    global uns_cur batch_mode
    global tdv_default
    
    if {$uns_cur == ""} { return "" }
    if {$name == ""} { 
	set name [ic_uns_subset_unused_name uns_sub_] 
    } else {
    	if [ ic_uns_subset_exists $name ]  return ""
    }

    set map [uns_map -mesh $uns_cur -name $name -visible $vis \
		 -editable $editable -list_type 2]
    if $pid_colors { $map set_pid_colors }
    if !$batch_mode { $tdv_default add_image $map }
    if {$copy_from != ""} {
	set cmap [$uns_cur get_map $copy_from]
	$map copy_from $cmap 0
	$map promote_type 2
    }
    update_uns_available
    $uns_cur configure -modified 1
    return [$map get -name]
}

## Create a temporary subset with a given set of types and families.
## Either may be __all__.  Returns "" if the thing is empty unless
## empty_ok is 1, in which case it returns the empty map.
## If make_visible is 1 then it will make this subset visible.
## If make_explicit then it will be promoted to EXPLICIT_LIST

proc ic_uns_subset_create_family_type {fams types {empty_ok 0} {make_visible 1} {make_explicit 0}} {
    global uns_cur batch_mode tdv_default
    
    if {$uns_cur == ""} { return "" }
    set name [ic_uns_subset_unused_name uns_sub_] 
    set map [uns_map -mesh $uns_cur -name $name -list_type 1 -visible $make_visible]
    ic_uns_update_family_type $name $fams $types update 1
    if $make_explicit { $map promote_type 2 }
    if {!$empty_ok && ![lindex [$map count] 0]} {
	$map delete
	return ""
    } else {
	$map set_pid_colors
	if !$batch_mode { $tdv_default add_image $map }
	return $name
    }
}

## Is there a subset with the given name?

proc ic_uns_subset_exists { name } {
    global uns_cur
    if {$uns_cur == ""} { return 0 }
    if {$name == "" || $name == "{}"} { return 0 }
    set map [$uns_cur get_map $name]
    if { $map == "" } {
        return 0
    } else {
        return 1
    }
}
set dont_record_command(ic_uns_subset_exists) 1

##  Rename a subset

proc ic_uns_subset_rename {old new} {
    global uns_cur
    set map [$uns_cur get_map $old]
    $map configure -name $new
}
set dont_record_command(ic_uns_subset_rename) 1

## Return an unused subset name with the given prefix
## Note that this gives names unique for both geometry and mesh

proc ic_uns_subset_unused_name {{pref ""}} {
    return [ic_geo_subset_unused_name $pref]

}
set dont_record_command(ic_uns_subset_unused_name) 1

## Change the color on a subset.  Turn off pid colors.

proc ic_uns_subset_color {name color} {
    global uns_cur
    set map [$uns_cur get_map $name]
    $map set_pid_colors off
    $map configure -color $color
}

## Copy from one subset to another.  If etype is 0, 1, 2, 3, or a list of those,
## then copy only elements of that dimension.  Also etype can be node or edge
## which will pick nodes or bars

proc ic_uns_subset_copy {dest src {etype ""}} {
    global uns_cur

    if {$uns_cur == ""} { return "" }
    if {$dest == ""} {
	set dest [ic_uns_subset_unused_name uns_sub_]
	set dmap [uns_map -mesh $uns_cur -name $dest -editable 0 -list_type 2]
    } else {
	set dmap [$uns_cur get_map $dest]
    }
    if {$src == "__all_visible__"} {
	foreach m [$uns_cur list_maps] {
	    if [$m get -visible] { lappend smaps $m }
	}
    } else {
	set smaps [$uns_cur get_map $src]
    }
    if {$dmap == ""} { error "no such subset $dest" }
    if {$smaps == ""} { error "no such subset $src" }
    if {($etype == "") || ($etype == "element")} {
	set n 0
	foreach smap $smaps {
	    if $n {
		$dmap add_from $smap
	    } else {
		$dmap copy_from $smap 0
	    }
	    incr n
	}
    } else {
	foreach et $etype {
	    switch $et {
		node { set et 0 }
		edge { set et 1 }
		default { set et [string index $et 0] }
	    }
	    foreach smap $smaps {
		$dmap copy_only_dim $smap $et
	    }
	}
    }
    $uns_cur configure -modified 1
    return $dest
}

## Copy vertices from one subset to another

proc ic_uns_subset_copy_verts {dest src} {
    global uns_cur
    set dmap [$uns_cur get_map $dest]
    set smap [$uns_cur get_map $src]
    if {$dmap == ""} { error "no such subset $dest" }
    if {$smap == ""} { error "no such subset $src" }
    $dmap copy_verts_from $smap
    $uns_cur configure -modified 1
}

## If this map is not explicit, make a copy of it and make sure that it is

proc ic_uns_subset_copy_if_not_explicit {name} {
    global uns_cur batch_mode
    global tdv_default
    
    set map [$uns_cur get_map $name]
    if {[$map get -list_type] != 2} {
	set name [ic_uns_subset_unused_name uns_sub_]
	set exp [uns_map -mesh $uns_cur -name $name]
	$exp set_pid_colors
	if !$batch_mode { $tdv_default add_image $exp }
	$exp copy_from $map 0
	$exp promote_type 2
	$uns_cur configure -modified 1
	return [$exp get -name]
    } else {
	return ""
    }
}

## Invert the contents of a subset

proc ic_uns_invert_subset {name {refmap all}} {
    global uns_cur
    set map [$uns_cur get_map $name]
    set ref [$uns_cur get_map $refmap]
    $map invert $ref
    $uns_cur configure -modified 1
}
 
## Decompose the given subset name <em>which</em> into
## a set of subsets, each being a region of connected elements.
## The given subset is unmodified. The return value is a list of
## names of the new subsets.
 
proc ic_uns_subset_into_connected_regions {which} {
 
    # this is the list of subsets created, each being a region
    # of connected elements
    set result_subsets ""
 
    # copy the given subset to a temp working subset
    # we'll leave "which" intact, and work on "tmpwhich"
    set tmpwhich [ic_uns_subset_create]
    ic_uns_subset_copy $tmpwhich $which
 
    # while the working source map tmpwhich has any elements...
    while [ic_uns_subset_count_elements $tmpwhich] {
 
        # get the list of els left in tmpwhich
        set els [ic_uns_subset_list_elements $tmpwhich]
        if {"" == $els} { break }
 
        # get the first element remaining in the orginal subset
        set first_el [lindex $els 0]
        if {"" == $first_el} { break }
 
        # get the element's type and number
        set type [lindex $first_el 0]
        set num  [lindex $first_el 1]
        if {("" == $type) || ("" == $num)} { break }
 
        # create a new subset for the it's region
        set tmpnewname [ic_uns_subset_unused_name $which]
        set newregion  [ic_uns_subset_create $tmpnewname]	
 
        # add that first element as a seed to this new empty subset
        ic_uns_subset_add_number $newregion $num 1 $type
 
        # add layers until there are no more attached elements to add
        set nels [ic_uns_subset_count_elements $newregion] ;# should be 1
        set nnewels 0
        while {$nels > $nnewels} {
            set nels [ic_uns_subset_count_elements $newregion]
            ic_uns_subset_add_attached $newregion $tmpwhich all
            set nnewels [ic_uns_subset_count_elements $newregion]
        }
        # subtract this "newregion" from the working source map
        ic_uns_subset_subtract_from $tmpwhich $newregion
	
        if {0 < [ic_uns_subset_count_elements $newregion]} {
            # add the name of the new subset region to the return list
            lappend result_subsets $newregion
        } else {
            ic_uns_subset_delete $newregion
        }
    }
 
    if {0 < [ic_uns_subset_count_elements $tmpwhich]} {
        mess "Problem in decomposing subset $which into connected regions\n" red
    }
    # delete the, now empty, working source_map
    ic_uns_subset_delete $tmpwhich
    
    return $result_subsets
}

proc ic_uns_subset_into_connected_regions2 {which how} {
 
    set removed 0 

    # this is the list of subsets created, each being a region
    # of connected elements
    set result_subsets ""

    # copy the given subset to a temp working subset
    # we'll leave "which" intact, and work on "tmpwhich"
    set tmpwhich [ic_uns_subset_create]
    ic_uns_subset_copy $tmpwhich $which

    # while the working source map tmpwhich has any elements...
    while [ic_uns_subset_count_elements $tmpwhich] {
 
        # get the list of els left in tmpwhich
        set els [ic_uns_subset_list_elements $tmpwhich]
        if {"" == $els} { break }
 
        # get the first element remaining in the orginal subset
        set first_el [lindex $els 0]
        if {"" == $first_el} { break }
 
        # get the element's type and number
        set type [lindex $first_el 0]
        set num  [lindex $first_el 1]
        if {("" == $type) || ("" == $num)} { break }
        

        # create a new subset for the it's region
        set tmpnewname [ic_uns_subset_unused_name $which]
        set newregion  [ic_uns_subset_create $tmpnewname]
        # add that first element as a seed to this new empty subset
        ic_uns_subset_add_number $newregion $num 1 $type
 
        # add layers until there are no more attached elements to add
        set nels [ic_uns_subset_count_elements $newregion] ;# should be 1
        set nnewels 0
        while {$nels > $nnewels} {
            set nels [ic_uns_subset_count_elements $newregion]
            ic_uns_subset_add_attached $newregion $tmpwhich $how
            set nnewels [ic_uns_subset_count_elements $newregion]
        }
        # subtract this "newregion" from the working source map
        ic_uns_subset_subtract_from $tmpwhich $newregion
	
        if {0 < [ic_uns_subset_count_elements $newregion]} {
            if {[ic_uns_subset_count_elements $newregion] > 1} {
                # add the name of the new subset region to the return list
                lappend result_subsets $newregion
            } else {
                ic_uns_subset_delete $newregion
                incr removed
            }
        } else {
            ic_uns_subset_delete $newregion
        }
    }
 
    if {0 < [ic_uns_subset_count_elements $tmpwhich]} {
        mess "Problem in decomposing subset $which into connected regions\n" red
    }
    # delete the, now empty, working source_map
    ic_uns_subset_delete $tmpwhich
    
    
    # LINE_2 elements could be missing; add them
    set lnum [ic_uns_subset_count_elements $which LINE_2]
    
    
    foreach e [ic_uns_subset_list_elements $which] {
        if {[lindex $e 0] == "LINE_2"} {
            append linfo([lindex $e 1]) [lindex $e 3]
        }
    }
    foreach s $result_subsets {
        foreach e [ic_uns_subset_list_elements $s] {
             if {[lindex $e 0] != "LINE_2"} {
                append sinfo($s) "[lindex $e 3] "
             }
        }
        if ![info exists sinfo($s)] continue
        set sinfo($s) [lsort -unique $sinfo($s)]
        foreach e [array names linfo] {
            set e1 [lindex $linfo($e) 0]
            set e2 [lindex $linfo($e) 1]
            if {([lsearch $sinfo($s) $e1] >= 0) || ([lsearch $sinfo($s) $e2] >= 0)} {
                ic_uns_subset_add_number $s $e 0 LINE_2
                incr lnum -1
            }
        }
    }
    if {$lnum > 0} {
        mess "Could not break up all elements from subset $which into connected regions\n" red
    }

    return $result_subsets
}

## Return the name of a subset containing the surface boundary elements of the
## given surface name <em>sname</em>. Returns nullstring if error.

proc ic_uns_subset_surface_boundary {sname} {
    
    if ![ic_uns_is_loaded] {
        error "must have mesh loaded to get mesh on surface boundary"
    }
    if ![ic_geo_is_loaded] {
        error "must have geometry loaded to get mesh on surface boundary"
    }
    # make sure surface exists in tetin
    if {"" == [ic_geo_check_objects_exist surface $sname]} {
        mess "Error: surface $sname does not exist in geometry\n" red
        return ""
    }
    set boundary_map_name [ic_uns_subset_create]
    set boundary_map_ptr [uns_get_subset $boundary_map_name]
    if {"" == $boundary_map_ptr} {
        ic_uns_subset_delete $boundary_map_name
        return ""
    }
    $boundary_map_ptr get_boundary_elements $sname
    if { 0 > [ic_uns_subset_count_elements $boundary_map_name MIXED]} {
        ic_uns_subset_delete $boundary_map_name
        set boundary_map_name ""
    }
    return $boundary_map_name
}

## Return the name of a subset containing the ordered vertices of the bars along
## the given set of curves <em>curve_names</em>. Returns null-string if error.

proc ic_uns_subset_get_vertices_on_curves { curve_names } {
    
    # test: ic_uns_subset_get_vertices_on_curves topo_surf/13e33
    
    if ![ic_uns_is_loaded] {
	error "must have mesh loaded to get vertices on curve group"
    }
    if ![ic_geo_is_loaded] {
	error "must have geometry loaded to get vertices on curve group"
    }
    
    set curve_nums [ic_geo_sub_get_numbers_by_names "curve" $curve_names]
    if {"" == $curve_nums} {
	mess "Error: could not retrieve curves for construction of vertex map\n" red
	return ""
    }
    
    set vertex_map_name [ic_uns_subset_create]
    set vertex_map_ptr [uns_get_subset $vertex_map_name]
    if {"" == $vertex_map_ptr} {
	ic_uns_subset_delete $vertex_map_name
	return ""
    }
    $vertex_map_ptr get_ordered_verts_on_bars_of_curves $curve_nums
    
    if { 0 > [ic_uns_subset_count_nodes $vertex_map_name]} {
	ic_uns_subset_delete $vertex_map_name
	set vertex_map_name ""
    }
    
    #mess "debug: got [ic_uns_subset_count_nodes $vertex_map_name] vertices\n" purple
    #mess "debug: such that: [ic_uns_subset_list_elements $vertex_map_name]...\n" purple
    
    return $vertex_map_name
}
set dont_record_command(ic_uns_subset_get_vertices_on_curves) 1

## What is the name of the current visible map - maybe a subset and maybe
## Selected

proc ic_uns_subset_get_current {} {
    global uns_cur
    set map [$uns_cur get_map visible]
    if {$map == ""} { return "" }
    return [$map get -name]
}
set dont_record_command(ic_uns_subset_get_current) 1

## Set the current visible map

proc ic_uns_subset_set_current {name} {
    global uns_cur

    set prev [$uns_cur get_map visible]
    set map [$uns_cur get_map $name]
    if { $map == "" } {
	error "no such map $name\n"
    }
    
    if {$prev == $map} {
	$map configure -visible 1
	return
    }
    with_view_inactive {
	if {$prev != ""} { $prev configure -visible 0 }
	
	if [$map get -reset_first] {
	    $map configure -reset_first 0
	    # prev can be NULL--I'm not sure what's happening
	    # here, but we can't call copy_from with NULL
	    if {$prev != ""} { $map copy_from $prev 0 }
	    $map promote_type 2
	}
	$uns_cur set_visible_map $map
	$map configure -visible 1
    }
}

## Delete a subset

proc ic_uns_subset_delete {name} {
    global uns_cur

    if ![ic_uns_is_loaded] { return }
    set map [$uns_cur get_map $name]
    if { $map != "" } {
	if {[$uns_cur get_map visible] == $map} {
	    ic_uns_subset_set_current selected
	}
    	$map delete
	$uns_cur configure -modified 1
    }
}

## Configure a subset

proc ic_uns_subset_configure {name args} {
    global uns_cur ic_uns_subset_configure_cmd
    
    set ic_uns_subset_configure_cmd ""
    if {$uns_cur == ""} return
    if {$name == ""} {
        set maps [$uns_cur list_maps]
    } else {
        set maps [$uns_cur get_map $name]
        if {$maps == ""} return
    }
    foreach map $maps {
        set conf ""
        foreach {v n} $args {
            if [catch {$map cget $v} cur] continue
            if {[$map get -dont_change_color_or_shade] && ($name == "") && [lmember {-color -shade -color_by_quality} $v]} continue
            if {$cur != $n} {
                lappend conf $v $n
                if {($v == "-color_by_bcfield") && ($n != "")} {
                    ic_uns_subset_update_bcfield_color_map $n $name
                }
            }
        }
        if {$conf != ""} {
            if {[$map get -name] == ""} continue
            eval $map configure $conf
            append ic_uns_subset_configure_cmd [concat ic_uns_subset_configure [list [$map get -name]] $conf]\n
        }
    }
}

proc ic_uns_subset_configure_replay_result {} {
    global ic_uns_subset_configure_cmd
    return $ic_uns_subset_configure_cmd
}
set dont_record_command(ic_uns_subset_configure_replay_result) 1

## Configure a subset by toggling the given args

proc ic_uns_subset_configure_toggle {name args} {
    global uns_cur ic_uns_subset_configure_cmd

    if {$name == ""} {
        set maps [$uns_cur list_maps]
    } else {
        set maps [$uns_cur get_map $name]
        if {$maps == ""} { error "No such subset $name" }
    }

    foreach map $maps {
        set conf ""
        set name [$map get -name]
        foreach v $args {
            set cur [$map cget $v]
            if {($cur != 0) && ($cur != 1)} {
                mess "cannot toggle $v on subset! $v is $cur\n" red
            } else {
                set n [expr !$cur]
                lappend conf $v $n
            }
        }
        eval ic_uns_subset_configure $name $conf
    }
}

## Get the value for a subset's given configuration param

proc ic_uns_subset_configure_get {name param} {
    global uns_cur

    if {$name == ""} {
        error "Must specify subset in getting configuration\n"
    } elseif {$name == "__all_visible__"} {
	set name visible ;# maybe approximately right
    } else {
        set map [$uns_cur get_map $name]
        if {$map == ""} { error "No such subset $name" }
    }

    set val [$map cget $param]
    if {"" == $val} {
#       mess "no value for $param in subset $name"
    }
    return $val
}
set dont_record_command(ic_uns_subset_configure_get) 1

## Make a subset visible or not

proc ic_uns_subset_visible {name vis} {
    global uns_cur
    if {$uns_cur == ""} return
    set map [$uns_cur get_map $name]
    if {$map != ""} {
        $map configure -visible $vis
    } else {
        foreach map2 [$uns_cur list_maps] {
            if [string match $name/* [$map2 get -name]] {
                $map2 configure -visible $vis
            }
        }
    }
}

## List the names of the visible subsets

proc ic_uns_subset_list_visible {{except ""}} {
    global uns_cur
    
    if {$uns_cur == ""} { return "" }
    set from_maps ""
    foreach m [$uns_cur list_maps] {
	if {[$m get -visible] && ([$m get -name] != $except)} {
	    lappend from_maps [$m get -name]
	}
    }
    return $from_maps
}
set dont_record_command(ic_uns_subset_list_visible) 1

## Check to see if a subset has the cut flag turned on

proc ic_uns_subset_is_cut { name } {
    global uns_cur
    set map [$uns_cur get_map $name]
    return [$map get_cut_plane]
}
set dont_record_command(ic_uns_subset_is_cut) 1

## Count the number of elements in a subset.

proc ic_uns_subset_count_elements {name {type MIXED}} {
    global uns_cur
    if { $uns_cur == "" || ! [ info exists uns_cur ] } {
	#puts "uns_cur doesn't exist"
	return "0"
    }
    set map [$uns_cur get_map $name]
    if { $map == "" } {
	#puts "$uns_cur get_map $name returned the empty string"
	return "0"
    }
    return [lindex [$map count $type] 0]
}
set dont_record_command(ic_uns_subset_count_elements) 1

## Count the number of nodes in a subset.

proc ic_uns_subset_count_nodes {name} {
    global uns_cur
    set map [$uns_cur get_map $name]
    return [lindex [$map count] 1]
}
set dont_record_command(ic_uns_subset_count_nodes) 1

## Get the average edge length in a subset

proc ic_uns_subset_average_edge_length {name} {
    set ave "0."
    set map [uns_get_subset $name]
    if {"" == $map} {
	error "No such map \"$name\"" 
	return 0
    }
    if [catch {$map ave_edge_length} ave] {
	error "Could not get average edge length in subset \"$name\""
	return 0
    }
    return $ave
}
set dont_record_command(ic_uns_subset_average_edge_length) 1

## Get the average surface deviation in a subset

proc ic_uns_subset_average_surface_deviation {name} {
    set ave "0."
    set map [uns_get_subset $name]
    if {"" == $map} {	
	error "No such map \"$name\"" 
	return 0
    }
    if [catch {$map ave_surf_dev} ave] {
	error "Could not get average surface deviation in subset \"$name\""
	return 0
    }
    return $ave
}
set dont_record_command(ic_uns_subset_average_surface_deviation) 1

## List the families that appear in a subset.  Each family appears only once.

proc ic_uns_subset_list_families {name} {
    global uns_cur
    if {$uns_cur == ""} { return "" }
    set map [$uns_cur get_map $name]
    if {$map == ""} { return "" }
    return [$map list_families]
}
set dont_record_command(ic_uns_subset_list_families) 1

## List the volume families that appear in a subset.  Each family appears only once.

proc ic_uns_subset_list_volume_families {name} {
    global uns_cur
    if {$uns_cur == ""} { return "" }
    set map [$uns_cur get_map $name]
    if {$map == ""} { return "" }
    return [$map list_families_with_dimension 3]
}
set dont_record_command(ic_uns_subset_list_volume_families) 1

## Return the families or parts that are used in this subset.
## If there are nodes in the subset then the elements attached to those
## nodes will also be included

proc ic_uns_subset_families_used {name parts} {
    global uns_cur
    set map [$uns_cur get_map $name]
    foreach ff [$map list_families] {
	if $parts { set ff [lindex [split $ff :] 0] }
	set found($ff) 1
    }
    return [array names found]
}
set dont_record_command(ic_uns_subset_families_used) 1

## Copy only the elements in a specified family or part into a new subset

proc ic_uns_subset_copy_only_families {from fam ispart} {
    set map [ic_uns_subset_create "" 0 $from]
    if $ispart {
	set fams [ic_geo_list_families_in_part $fam]
    } else {
	set fams [list $fam]
    }
    ic_uns_update_family_type $map $fams __same__ restrict_to
    return $map
}

## List all the element data for a subset in the following format:
##   {{eltype elnum ext_elnum {elnode1 elnode2 ...} fam_name} 
##    {eltype elnum ext_elnum {elnode1 elnode2 ...} fam_name} ...
##    {VERTEX vnum {x y z} dimension extvnum}
##    {VERTEX vnum {x y z} dimension extvnum} ...}
## where element vertices specified explicitly in the subset (not elements of type NODE)
## are at the end of the list.

proc ic_uns_subset_list_elements {name} {
    global uns_cur
    set list ""
    set map [$uns_cur get_map $name]
    foreach inf [$map element_info] {
	# This ordering is a big mess
	if {[lindex $inf 2] == "VERTEX"} {
	    lappend list "[lindex $inf 2] [lindex $inf 4] {[lindex $inf 3]} [lindex $inf 1] [lindex $inf 0]"
	} else {
	    lappend list "[lindex $inf 3] [lindex $inf 0] [lindex $inf 1] {[lindex $inf 4]} [lindex $inf 2]"
	}
    }
    return $list
}
set dont_record_command(ic_uns_subset_list_elements) 1

## Are any nodes in this subset periodic?

proc ic_uns_subset_nodes_are_periodic {name} {
    global uns_cur
    set map [$uns_cur get_map $name]
    return [$map nodes_are_periodic]
}
set dont_record_command(ic_uns_subset_nodes_are_periodic) 1

## List the element types that appear in a subset.  Each type appears only once.

proc ic_uns_subset_list_types {name} {
    global uns_cur
    set map [$uns_cur get_map $name]
    return [$map list_types]
}
set dont_record_command(ic_uns_subset_list_types) 1

## List all the subsets that are editable.  If only_user is 1 then skip the ones
## that begin with uns_sel_ or CONTACT

proc ic_uns_subset_list {{only_user 0}} {
    global uns_cur
    if {$uns_cur == ""} { return "" }
    set ret ""
    foreach map [$uns_cur list_maps] {
	if {([$map get -list_type] == 2) && [$map get -editable]} {
	    set name [$map get -name]
	    if {$only_user && ([string match uns_sel_* $name] || [string match "CONTACT *" $name])} continue
	    lappend ret $name
	}
    }
    return [lsort $ret]
}
set dont_record_command(ic_uns_subset_list) 1

## List all the maps (optionally just the visible ones).  If <b>pat</b> is given then
## return those whose names match.

proc ic_uns_map_list {only_vis {pat *}} {
    global uns_cur
    set ret ""
    foreach map [$uns_cur list_maps] {
	    if {$only_vis && ![$map get -visible]} continue
	    if {($pat != "*") && ![string match $pat [$map get -name]]} continue
	    set name [$map get -name]
	    if {$name == ""} continue
	    lappend ret $name
    }
    return [lsort $ret]
}
set dont_record_command(ic_uns_map_list) 1

## Remove all stuff from a subset

proc ic_uns_subset_clear {name} {
    global uns_cur
    set map [$uns_cur get_map $name]
    $map clear
    $uns_cur configure -modified 1
}

## Add stuff from one subset to another

proc ic_uns_subset_add_from {dest src} {
    global uns_cur
    set dmap [$uns_cur get_map $dest]
    set smap [$uns_cur get_map $src]
    if {$dmap == ""} { error "no such subset $dest" }
    if {$smap == ""} { error "no such subset $src" }
    $dmap add_from $smap
    $uns_cur configure -modified 1
}

## Remove stuff in one subset from another

proc ic_uns_subset_subtract_from {dest src} {
    global uns_cur
    set dmap [$uns_cur get_map $dest]
    set smap [$uns_cur get_map $src]
    if {$dmap == ""} { error "no such subset $dest" }
    if {$smap == ""} { error "no such subset $src" }
    $dmap subtract_from $smap
    $uns_cur configure -modified 1
}

## Add a list of elements by numbers.
## rel = 0 : internal within the given type
## rel = 1 : internal within all types
## rel = 2 : external
## Note that the nums can also be ranges of the form N1-N2

proc ic_uns_subset_add_number {name nums rel type} {
    global uns_cur
    set map [$uns_cur get_map $name]
    $uns_cur configure -modified 1
    return [$map add_with_number $nums $rel $type]
}

## Add a list of nodes by numbers
## If extern is 1 use external numbers otherwise internal
## Note that the nums can also be ranges of the form N1-N2

proc ic_uns_subset_add_node_numbers {name nums {extern 0}} {
    if {"" == $nums} return ""
    set map [uns_get_subset $name]
    ic_uns_set_modified 1
    return [$map add_nodes_by_number $nums $extern]
}

## List the unique internal (external) node numbers of the subset 
## If extern is 1 use external numbers otherwise internal

proc ic_uns_subset_list_node_numbers {name {extern 0}} {
    global uns_cur
    
    set use 4; set nums ""
    if $extern { set use 0 }
    set map [$uns_cur get_map $name]
    if {$map == ""} { error "no such subset $name" }
    foreach i [$map element_info] {
	if {[lindex $i 2] == "VERTEX"} {
	    foreach n [string trim [lindex $i $use]] {
	        if {[lsearch $nums $n] >= 0} continue
	        lappend nums $n
	    }
	}
    }
    return [lsort -dictionary $nums]
}
set dont_record_command(ic_uns_subset_list_node_numbers) 1

## Add elements in a region

proc ic_uns_subset_add_region {name p1 p2 partly {dims {0 1 2 3}}} {
    global uns_cur
    set map [$uns_cur get_map $name]
    $uns_cur configure -modified 1
	set lcs [ic_csystem_get_current]
    if {$lcs != "global"} {
        set type [lindex [ic_csystem_get $lcs] 0]
        switch $type {
	        cylindrical - spherical {
                set xmin [lindex $p1 0]; set ymin [lindex $p1 1]; set zmin [lindex $p1 2]
                set xmax [lindex $p2 0]; set ymax [lindex $p2 1]; set zmax [lindex $p2 2]
	            foreach inf [ic_uns_subset_info all] {
	                if {[lindex $inf 2] != "VERTEX"} continue
	                set pos [lindex $inf 3]
	                set x [lindex $pos 0]; set y [lindex $pos 1]; set z [lindex $pos 2]
	                if {($x >= $xmin) && ($x <= $xmax) && ($y >= $ymin) && ($y <= $ymax) && ($z >= $zmin) && ($z <= $zmax)} {
                        $map add_near_pos [coords_into_global "$x $y $z"] $dims
		            }
                }
                $map uniqify
	        }
	        default {
	            return [$map add_in_region_lcs $p1 $p2 $partly $dims]
	        }
        }
    } else {
        return [$map add_in_region $p1 $p2 $partly $dims]
    }
}

## Add elements near a position

proc ic_uns_subset_add_near_pos {name pos {dims {0 1 2 3}} {max_dim ""}} {
    global uns_cur
    
    set map [$uns_cur get_map $name]
    $uns_cur configure -modified 1
    if {$max_dim != ""} {
        return [$map add_near_pos2 [coords_into_global $pos] $dims $max_dim]
    } else {
        return [$map add_near_pos [coords_into_global $pos] $dims]
    }
}

## Add elements near a set of nodes

proc ic_uns_subset_add_near_nodes {name nodes {ext 0}} {
    global uns_cur
    set map [$uns_cur get_map $name]
    $uns_cur configure -modified 1
    if $ext {
        return [eval $map add_near_external_node_number $nodes]
    } else {
        return [eval $map add_near_node_number $nodes]
    }
}

## Add a layer.  If fams = active then it means active fams, all means
## all fams.  types = active means active types, all all types,
## surf means all surface types.

proc ic_uns_subset_add_layer {name nlayers fams types} {
    global uns_cur
    if ![ic_uns_subset_exists $name] {
	mess "Error: subset \"$name\" does not exist\n" red
	return -1
    }
    set map [$uns_cur get_map $name]    
    set n 0
    for {set i 0} {$i < $nlayers} {incr i} {
	incr n [$map add_external_layer [layer_fam_list $fams] \
		    [layer_type_list $types]]
    }
    $uns_cur configure -modified 1
    return $n
}

## Remove a layer. If fams = active then it means active fams, all means
## all fams.  types = active means active types, all all types,
## surf means all surface types. 

proc ic_uns_subset_remove_layer {name nlayers types} {
    global uns_cur
    if ![ic_uns_subset_exists $name] {
	mess "Error: subset \"$name\" does not exist\n" red
	return -1
    }
    set map [$uns_cur get_map $name]    
    set n 0
    for {set i 0} {$i < $nlayers} {incr i} {
	# This is a bit sketchy ...  We want to mark everything that has the
	# currently active types and *all* families for this operation ...
	incr n [$map remove_external_layer [layer_type_list $types]]
    }
    $uns_cur configure -modified 1
    return $n
}

## Add attached elements

proc ic_uns_subset_add_attached {name src how {angle 0}} {
    global uns_cur
    
    set map [$uns_cur get_map $name]
    
    if {$src == "__all_visible__"} {
	set smap [uns_map -mesh $uns_cur]
	foreach m [$uns_cur list_maps] {
	    if [$m get -visible] { $smap add_from $m }
	}
	set del 1
    } elseif {$src == "surf"} {
	set smap [uns_map -mesh $uns_cur]
	$smap add_family_type all "1d 2d" 1
	set del 1
    } elseif {[llength $src] == 1} {
	set smap [$uns_cur get_map $src]
	if {$smap == ""} { error "no such map $src" }
	set del 0
    } else {
	set smap [uns_map -mesh $uns_cur]
	foreach s $src {
	    set sm [$uns_cur get_map $s]
	    if {($sm != "") && ($sm != $map)} {
		$smap add_from $sm
		#puts "$smap add_from $sm"
		#puts [$sm count_elements MIXED xx]
	    }
	}
	set del 1
    }
    
    switch $how {
	all {
	    $map add_attached $smap 0 0 -1
	}
	fam {
	    $map add_attached $smap 0 1 -1
	}
	part {
	    $map add_attached $smap 0 2 -1
	}
	curve {
	    #puts "$map add_attached $smap 1 0 -1"
	    #puts [$smap count_elements MIXED xx]
	    $map add_attached $smap 1 0 -1
	}
	angle {
	    $map add_attached $smap 0 0 $angle
	    #puts "$map add_attached $smap 0 0 $angle"
	}
	until_discontinuity {
	    $smap add_until_discontinuity "" ""
	    $map add_from $smap
	}
    }
    $uns_cur configure -modified 1
    if $del { $smap delete }
}

## Get all a map of those elements of type <em>des_types</em> in <em>des_families</em>
## that are attached to the subset with name <em>src_map</em>.

proc ic_uns_subset_get_elements_attached_to_subset { src_map {des_families ""} {des_types ""} } {
    #
    # --> Get the subset/map of elements attached to this in it
    #
    set att_map [ic_uns_subset_create "" 0 $src_map]
    ic_uns_subset_add_layer $att_map 1 "all" "all"
    ic_uns_subset_subtract_from $att_map $src_map
    #
    # --> Get the elements out of it which are the desired type and family
    #
    if { ("" != $des_types) || ("" != $des_families) } {
	ic_uns_update_family_type $att_map $des_families $des_types "restrict_to"
    }
    #
    # --> Return the new map, the deletion for which the user is responsible
    #
    return $att_map
}

## Remove elements with a specific normal

proc ic_uns_subset_remove_normal {name norm} {
    global uns_cur
    set map [$uns_cur get_map $name]
    $map remove_with_normal $norm
    $uns_cur configure -modified 1
}

## Remove all surface elements that are connected to one other surface on
## all sides.

proc ic_uns_subset_remove_manifold_elements {name} {
    global uns_cur
    set map [$uns_cur get_map $name]
    $map remove_manifold
    $uns_cur configure -modified 1
}

## Restrict a subset to its cut.  Note that the point and normal given
## here are in the <b>global</b> coordinate system.  This returns the number
## of elements displayed in the cut

proc ic_uns_subset_get_cutspeed {name} {
   global uns_cur
   set map [$uns_cur get_map $name]
   return [$map get -last_cutspeed]
}


proc ic_uns_subset_cut {name what {on 0} {whole 1} {pt "0 0 0"} {norm "1 0 0"} {in_scan 0}} {
    global uns_cur
    set map [$uns_cur get_map $name]
    switch $what {
	restrict {
	    $map restrict_to_cut
	    set n 0
	}
	set {
            $map set_cut_inscan $in_scan
	    set n [$map set_cut_plane $on $whole $pt $norm]
	    #puts "$map set_cut_plane $on $whole \{$pt\} \{$norm\}"
	    #if $n { mess "$n elements displayed\n" }
	}
    }
    $uns_cur configure -modified 1
    return $n
}

## Return the bbox of a subset.  If no_cut is 1 then it will be the bbox with no
## plane cut taken into account.

proc ic_uns_subset_bbox {name {no_cut 0}} {
    global uns_cur
    set map [$uns_cur get_map $name]
    return [$map get_bbox $no_cut]
}
set dont_record_command(ic_uns_subset_bbox) 1

## Return the average normal of a subset.  This skips any non-2D elements.

proc ic_uns_subset_normal {name} {
    global uns_cur
    set map [$uns_cur get_map $name]
    set res [$map element_normal]

    # element_normal modified 11/02/05: return "{normal} max_angle_from_normal"
    # next check is for transition time 
    if {[llength $res] == 2} {
	return [lindex $res 0]
    } else {
	return $res
    }
}
set dont_record_command(ic_uns_subset_normal) 1

## Is this subset editable (i.e. not selected or all)

proc ic_uns_subset_is_editable {name} {
    global uns_cur
    set map [$uns_cur get_map $name]
    return [$map get -editable]
}
set dont_record_command(ic_uns_subset_is_editable) 1

# Returns element info

proc ic_uns_subset_info {name} {
    global uns_cur
	set map [$uns_cur get_map $name]
	return [$map element_info]
}
set dont_record_command(ic_uns_subset_info) 1

proc ic_uns_subset_metric {{parts ""} {types ""} {crit Quality} {verbose 1}} {
    global uns_cur
     
    if {$uns_cur == ""} { return "" }
    set name [ic_uns_subset_create [ic_uns_subset_unused_name] 0]
    if {$parts == ""} { set parts [ic_uns_list_families] }
#	if {$types == ""} { set types [ic_uns_list_types] }
    if {$types == ""} {
	    foreach type [ic_uns_list_types] {
            if {[regexp NODE+ $type] || [regexp LINE_+ $type] || [regexp BAR_+ $type]} continue
	        lappend types $type
	    }
	}
    ic_uns_update_family_type $name $parts $types update 1
    set map [$uns_cur get_map $name]
    set st [eval $map compute_diagnostic \"$crit\" ""]
    set nok [lindex $st 0]; set nundef [lindex $st 1]; set nbad [lindex $st 2]
    set min [lindex $st 3]; set max [lindex $st 4]; set totval [lindex $st 5]
    if ![string is double $min] { set min 0 }
    if ![string is double $max] { set max 0 }
    if ![string is double $totval] { set totval 0 }
    if $verbose {
        if {[string is integer $nok] && ($nok > 0)} {
            mess "\"$crit\" is defined for $nok elements\n" blue
        } else {
            mess "Warning: \"$crit\" is not defined for any element\n" red
            set st ""
        }
    }
    ic_uns_subset_delete $name
    return $st
}
set dont_record_command(ic_uns_subset_metric) 1

## Returns the min value (max value in case of Volume change) of a quality metric (and "" in case of an error).  
## e.g. set worst [ic_uns_min_metric "SPECIFIED_METRIC" "SPECIFIED_PARTS" "SPECIFIED_TYPES"]
## Default for SPECIFIED_METRIC is "Quality"
## Default for SPECIFIED_PARTS is all existing parts
## Default for SPECIFIED_TYPES is all existing types (but skips NODE, LINE and BAR elements)
## Each of them can be empty

proc ic_uns_min_metric {{crit Quality} {parts ""} {types ""}} {
    global uns_cur
     
    if {$uns_cur == ""} { return "" }
    if {$crit == "Volume change"} {
        return [lindex [ic_uns_subset_metric $parts $types $crit 0] 4]
    } else {
        return [lindex [ic_uns_subset_metric $parts $types $crit 0] 3]
    }
}

proc ic_uns_subset_types_metric {{crit Quality} {verbose 0} {dim ""}} {
    global uns_cur
     
    if {$uns_cur == ""} { return "" }
    set pcrit $crit
    if {$crit == "Volume/Area/Length" && $dim == "2d"} {
        set pcrit Area
    }
    set parts [ic_uns_list_families]
    set types [ic_uns_list_types]
    set ret ""
    set total 0.0
    foreach type $types {
        if {[regexp NODE+ $type] || [regexp LINE_+ $type] || [regexp BAR_+ $type]} continue
        if {$dim == "2d"} {
            if {(![regexp TRI_+ $type]) && (![regexp QUAD_+ $type])} continue
        }
        set name [ic_uns_subset_create [ic_uns_subset_unused_name] 0]
        ic_uns_update_family_type $name $parts $type update 1
        set map [$uns_cur get_map $name]
        set st [eval $map compute_diagnostic \"$crit\" ""]
        set nok [lindex $st 0]; set nundef [lindex $st 1]; set nbad [lindex $st 2]
        set min [lindex $st 3]; set max [lindex $st 4]; set totval [lindex $st 5]
        if ![string is double $min] { set min 0 }
        if ![string is double $max] { set max 0 }
        if ![string is double $totval] { set totval 0 }
        if {$verbose == 1} {
            if {[string is integer $nok] && ($nok > 0)} {
                mess "Criterion \"$crit\" is defined for $nok elements of type \"$type\": min $min\n"
            } else {
                mess "Criterion \"$crit\" is not defined for any element of type \"$type\"\n"
            }
        } elseif {$verbose == 2} {
            if {[string is integer $nok] && ($nok > 0)} {
                mess "$pcrit of $nok $type is $totval\n" 
                set total [expr $total + $totval]
            }
        }
        lappend ret "$type $nok $nundef $min $max $totval"
        ic_uns_subset_delete $name
    }
    if {$verbose == 2} {
        mess "Total $pcrit is $total\n"
    }
    return $ret
}
set dont_record_command(ic_uns_subset_types_metric) 1

# -------------------------------------------------------------------------

## Create a temporary subset for selection.  This one will not show up in
## the subset list.  If <b>color_first_different</b> is 1 then the first node
## will get a special color.  All the other nodes and elements are drawn in
## the specified <b>color</b>.

proc ic_uns_create_selection_subset {color_first_different {color ""}} {
    global uns_cur batch_mode
    global tdv_default
    
    if {$uns_cur == ""} ic_uns_create_empty
    
    if {!$batch_mode && $color == ""} { set color [$tdv_default highlight_color] }

    # Note that ic_boco_set_for_objects expects to see this type of name.
    set name [ic_uns_subset_unused_name uns_sel_]
    set sel_map [uns_map -mesh $uns_cur -visible 1 -color $color -width 3 \
		     -draw_nodes_special 1 -name $name -editable 0 \
		     -color_first_different $color_first_different]
    if !$batch_mode { $tdv_default add_image $sel_map }
    return $name
}

## Create or delete a temporary edge list for selection (depending on whether
## <b>on</b> is 1 or 0.

proc ic_uns_create_selection_edgelist {on} {
    global uns_cur uns_current_edge_list batch_mode    
    global tdv_default

    if {$on && ![info exists uns_current_edge_list]} {
    if ($batch_mode) {
        set edges [uns_edge_list -mesh $uns_cur]
    } else {
        set edges [uns_edge_list -mesh $uns_cur \
               -color [$tdv_default highlight_color] \
               -visible 1 -width 3]
    }
	if !$batch_mode { $tdv_default add_image $edges }
	set uns_current_edge_list $edges
    } elseif {[info exists uns_current_edge_list]} {
	$uns_current_edge_list delete
	unset uns_current_edge_list
    }
}

## Add elements in a screen polygon area to the subset
## <b>what</b> can be one of edge, node, element, or a list of 
## one or more of 0d, 1d, 2d, 3d.

proc ic_uns_subset_add_pick_polygon {what name poly vect from_names \
					 partial convex {etype ""}} {
    global uns_cur uns_current_edge_list
    
    set map [$uns_cur get_map $name]
    
    array set changenames {
	0d 0d 1d 1d 2d 2d 3d 3d
	point 0d curve 1d surface 2d material 3d body 3d
    }
    
    set from_maps ""
    if {$from_names == "__all_visible__"} {
	foreach m [$uns_cur list_maps] {
	    if {[$m get -visible] && ([$m get -name] != $name)} { lappend from_maps $m }
	}
    } else {
	foreach from $from_names {
	    set m [$uns_cur get_map $from]
	    if {$m != ""} { lappend from_maps $m }
	}
    }
    
    set n 0
    foreach from_map $from_maps {
	set n2 ""
	switch [lindex $what 0] {
	    edge {
		set n2 [$map add_pick_polygon_edge $poly $vect $from_map \
			    $partial $convex $uns_current_edge_list]
	    }
	    node {
		set n2 [$map add_pick_polygon_node $poly $vect $from_map \
			    $partial $convex]
	    }
	    element {
		set n2 [$map add_pick_polygon_element $poly $vect $from_map \
			    $partial $convex]
	    }
	    0d - 1d - 2d - 3d -
	    point - curve - surface - material - body {
		set map2 [uns_map -mesh $uns_cur]
		foreach wh $what {
		    set wh $changenames($wh)
		    # better error checking would be nice
		    $map2 copy_only_dim $from_map [string index $wh 0]
		}
		set n2 [$map add_pick_polygon_element $poly $vect $map2 \
			    $partial $convex]
		$map2 delete
	    }
	}
	if {$n2 != ""} { incr n $n2 }
    }
    return $n
}

## Add elements in a screen circular area to the subset
## <b>what</b> can be one of edge, node, element, or a list of 
## one or more of 0d, 1d, 2d, 3d.

proc ic_uns_subset_add_pick_circle {what name vect cent radp from_names \
					partial {etype ""}} {
    global uns_cur uns_current_edge_list
    set map [$uns_cur get_map $name]
    
    array set changenames {
	0d 0d 1d 1d 2d 2d 3d 3d
	point 0d curve 1d surface 2d material 3d body 3d
    }
    set n 0
    if {[llength $what] > 1} { set what element }
    
    
    set from_maps ""
    if {$from_names == "__all_visible__"} {
	foreach m [$uns_cur list_maps] {
	    if {[$m get -visible] && ($m != $map)} { lappend from_maps $m }
	}
    } else {
	foreach from $from_names {
	    set m [$uns_cur get_map $from]
	    if {$m != ""} { lappend from_maps $m }
	}
    }
    
    foreach from_map $from_maps {
	set n2 ""
	switch [lindex $what 0] {
	    edge {
		set n2 [$map add_pick_polygon_edge [list $cent $radp] $vect $from_map \
			    $partial 1 $uns_current_edge_list]
	    }
	    node {
		set n2 [$map add_pick_polygon_node [list $cent $radp] $vect $from_map \
			    $partial 1]
	    }
	    element {
		set n2 [$map add_pick_polygon_element [list $cent $radp] $vect $from_map \
			    $partial 1]
	    }
	    0d - 1d - 2d - 3d -
	    point - curve - surface - material - body {
		set map2 [uns_map -mesh $uns_cur]
		foreach wh $what {
		    set wh $changenames($wh)
		    # better error checking would be nice
		    $map2 copy_only_dim $from_map [string index $wh 0]
		}
		set n2 [$map add_pick_polygon_element [list $cent $radp] $vect $map2 \
			    $partial 1]
		$map2 delete
	    }
	}
	if {$n2 != ""} { incr n $n2 }
    }
    return $n
}

## Add a picked element or whatever to the subset
## <b>what</b> can be one of edge, node, element, or a list of 
## one or more of 0d, 1d, 2d, 3d.
## Returns the element number that was picked, or "" if none was picked

proc ic_uns_subset_add_pick_single {what name pt vec from_names} {
    global uns_cur uns_current_edge_list tdv_default batch_mode
    
    set map [$uns_cur get_map $name]
    
    array set changenames {
	0d 0d 1d 1d 2d 2d 3d 3d
	point 0d curve 1d surface 2d material 3d body 3d
    }
    if {[llength $what] > 1} { set what element }
    
    set from_maps ""
    if {$from_names == "__all_visible__"} {
	# There is a problem here - we want to pick the nearest node from any of the maps
	# but this gives us the nearest one from the first map.  Must fix.  For now just
	# prefer Selected
	foreach m [$uns_cur list_maps] {
	    if {[$m get -visible] && ($m != $map)} {
		if {[$m get -name] == "Selected"} {
		    set from_maps [concat $m $from_maps]
		} else {
		    lappend from_maps $m
		}
	    }
	}
    } else {
	foreach from $from_names {
	    set m [$uns_cur get_map $from]
	    if {$m != ""} { lappend from_maps $m }
	}
    }

    foreach from_map $from_maps {
	switch [lindex $what 0] {
	    edge {
		set n [$map add_pick_single_edge $pt $vec $from_map \
			   $uns_current_edge_list]
	    }
	    element {
		# note that this won't allow bar selection in batch mode... --jka
		#set tol [$tdv_default pixels2dist 10]
		set tol [expr {$batch_mode ? 0 : [$tdv_default pixels2dist 10]}]
		set n [$map add_pick_single_element $pt $vec $from_map 0 $tol]
	    }
	    0d - 1d - 2d - 3d -
	    point - curve - surface - material - body {
		set map2 [uns_map -mesh $uns_cur -list_type 0]
		foreach wh $what {
		    set wh $changenames($wh)
		    # better error checking would be nice
		    $map2 copy_only_dim $from_map [string index $wh 0]
		}
		set tol [$tdv_default pixels2dist 10]
		set n [$map add_pick_single_element $pt $vec $map2 0 $tol]
		$map2 delete
	    }
	    default {
		set n [$map add_pick_single_$what $pt $vec $from_map 0]
	    }
	}
	if {$n != ""} { return $n }
    }
    return ""
}

## Add connected boundary edges to the subset

proc ic_uns_subset_add_flood {what name from} {
    global uns_cur uns_current_edge_list
    
    # from argument not used???
    
    if { $what != "edge" } { return }
    set map [$uns_cur get_map $name]
    if {$map == ""} { error "no map $name found" }
    set n [$map add_connected_single_edges $uns_current_edge_list]

    return $n
}

## Remove the last bunch of stuff added

proc ic_uns_subset_add_remove_last {name} {
    global uns_cur uns_current_edge_list
    set map [$uns_cur get_map $name]
    set nr [$map add_remove_last]
    if [info exists uns_current_edge_list] {
	$uns_current_edge_list delete_last_edges [expr $nr / 2]
    }
}

## Create a new vertex

proc ic_uns_create_vertex {name pt dim} {
    global uns_cur
    set map [$uns_cur get_map $name]
    $map create_vertex $pt $dim NULL
    $uns_cur configure -modified 1
}

## Make the current subset an all-subset

proc ic_uns_subset_make_all {name} {
    global uns_cur
    set map [$uns_cur get_map $name]
    $map clear
    $map configure -list_type 0
}

## Make the current subset a family subset

proc ic_uns_subset_make_families {name fams} {
    global uns_cur
    set map [$uns_cur get_map $name]
    $map clear
    $map configure -list_type 1
    $map add_family_type $fams MIXED 1
}

## Make the current subset have a certain set of families and types

proc ic_uns_subset_add_families_and_types {name fams types} {
    global uns_cur
    set map [$uns_cur get_map $name]
    $map clear
    $map add_family_type $fams $types 1
}

## Make new unstruct families, returning the number of which are new

proc ic_unstruct_make_families_exist {fams} {
    global uns_cur
 
    set n 0
    foreach f $fams {
	if [ic_uns_new_family $f] {
	    set n 1
	}
    }
    if $n {
	ic_uns_families_changed
	update_uns_available
	$uns_cur configure -modified 1
    }
    return $n
}

set dont_record_command(ic_unstruct_make_families_exist) 1

## Make sure that the stuff in this subset is unique

proc ic_uns_uniqify {name} {
    global uns_cur
    if {$uns_cur == ""} return
    set map [$uns_cur get_map $name]
    $map uniqify
}

## Push, pop, or clear node positions on the stack for undo in interactive move

proc ic_uns_node_position_stack {name what} {
    global uns_cur
    if {$what == "push"} {
	ic_newop
    }
    set map [$uns_cur get_map $name]
    return [$map ${what}_node_positions]
}

## Drag nodes interactively.  This projects to the surfaces, curves, etc as appropriate
## for the nodes, if fam_active is a list of families.  The strings all or none can also
## be given for fam_active.

proc ic_uns_node_position_drag {name startpt pt vec spl curvis allow_invert \
				    fam_active} {
    global uns_cur projlib
    set map [$uns_cur get_map $name]
    if {$curvis == ""} {
	set vismap NULL
    } else {
	set vismap [$uns_cur get_map $curvis]
    }
    set p $projlib
    switch $fam_active {
	all { set fam_active "" }
	none { set fam_active ""; set p "" }
    }
    $map drag_nodes $startpt $pt $vec $p $spl $vismap $allow_invert $fam_active
    $uns_cur configure -modified 1
}

## Bandwidth and profile reduction by the reverse Cuthill-McKee
## (RCM) algorithm.
## <ul>
## <li> <b>iters</b>: maximum number of renumbering steps
## <li> <b>type</b>: reduce profile if 0, reduce bandwidth if 1
## </ul>

proc ic_uns_bandwidth {name iters type} {
    global uns_cur
    set map [$uns_cur get_map $name]
    undo_on 0
    set res [$map bandwidth $iters $type]
    undo_on 1
    $uns_cur configure -modified 1
    return $res
}

## Reset external node numbers, starting with <b>start</b>

proc ic_uns_renumber_nodes {which start {skip_0 0} {dir "0 0 0"}} {
    global uns_cur

    if {$uns_cur == ""} return
    set map [$uns_cur get_map $which]
    set dest [ic_uns_subset_unused_name uns_sub_]
    set dmap [uns_map -mesh $uns_cur -name $dest -editable 0 -list_type 2]
    $dmap copy_from $map 0
    $dmap make_node_map
    if {$dir == "0 0 0"} {
	$dmap sort_by_extnum
    } else {
	$dmap sort_by_direction $dir
    }

    set nn [$dmap renumber_nodes $start $skip_0]

    $dmap delete

    incr nn -1
    $uns_cur configure -modified 1
    foreach im [$uns_cur list_maps] {
	$im signal_change 0
    }
    return $nn
}

## Reset external element numbers, starting with <b>start</b>

proc ic_uns_renumber_elements {which start {skip_0 0} {dir "0 0 0"}} {
    global uns_cur
    if {$uns_cur == ""} return

    set map [$uns_cur get_map $which]
    set dest [ic_uns_subset_unused_name uns_sub_]
    set dmap [uns_map -mesh $uns_cur -name $dest -editable 0 -list_type 2]
    $dmap copy_from $map 0
    if {$dir == "0 0 0"} {
	$dmap sort_by_extnum
    } else {
	$dmap sort_by_direction $dir
    }

    set nn [$dmap renumber_elements $start $skip_0]

    $dmap delete

    incr nn -1
    $uns_cur configure -modified 1
    foreach im [$uns_cur list_maps] {
	$im signal_change 0
    }
    return $nn
}

## Reset external node numbers for all elements, starting with <b>start</b>
## less memory usage compared to "ic_uns_renumber_nodes all" 
 
proc ic_uns_renumber_all_nodes {start {skip_0 0}} {
    global uns_cur

    if {$uns_cur == ""} return

    $uns_cur renumber_all_nodes $start $skip_0

    $uns_cur configure -modified 1
}

## Reset external element numbers for all elements, starting with <b>start</b>
## less memory usage compared to "ic_uns_renumber_elements all" 

proc ic_uns_renumber_all_elements {start {skip_0 0}} {
    global uns_cur
    
    if {$uns_cur == ""} return

    $uns_cur renumber_all_elements $start $skip_0

    $uns_cur configure -modified 1
}

## List external start and end node/element numbers

proc ic_uns_subset_elements_range {name} {
    global uns_cur

    set startn [ic_uns_subset_count_nodes all]; set endn 0
    set starte [ic_uns_subset_count_elements all]; set ende 0
    set map [$uns_cur get_map $name]
    set inf [$map get_number_range_elements $starte $ende 1]
    set starte [lindex $inf 0]
    set ende [lindex $inf 1]
    set inf [$map get_number_range_nodes $startn $endn 1]
    set startn [lindex $inf 0]
    set endn [lindex $inf 1]
    return [list $starte $ende $startn $endn]
}
set dont_record_command(ic_uns_subset_elements_range) 1

## Move elements in a subset from one part (oldpart) to another (newpart)
## Note that old part must exist, new part will be created if not existing

proc ic_uns_subset_move_part_elements {name oldpart newpart} {
    global uns_cur    
    if {$uns_cur == ""} return
    set map [$uns_cur get_map $name]
    if ![ic_uns_check_family $oldpart] { return 0 }    
    if ![ic_uns_check_family $newpart] { ic_uns_new_family $newpart }
    $map move_family $oldpart $newpart    
    $uns_cur configure -modified 1
    update_uns_visible
    return 1
}

## -------------------------------------------------------------------------

## Create a temporary subset for diagnostics

proc ic_uns_create_diagnostic_subset {{vis 1}} {
    global uns_cur batch_mode
    global tdv_default

    set name [ic_uns_subset_unused_name uns_diag_]
    set args "-mesh $uns_cur -visible $vis -width 2 -name $name"
    if !$batch_mode { append args " -color [$tdv_default highlight_color]" }
    set sel_map [eval uns_map $args]
    if !$batch_mode { $tdv_default add_image $sel_map }
    return $name
}

## Create a temporary edge list for diagnostics

proc ic_uns_create_diagnostic_edgelist {on} {
    global uns_cur uns_current_edge_list batch_mode
    global tdv_default

    if {$uns_cur == ""} { return }
    if {$on && ![info exists uns_current_edge_list]} {
	set edges [uns_edge_list -mesh $uns_cur \
		       -color red -visible 1 -width 3]
	if !$batch_mode { $tdv_default add_image $edges }
	set uns_current_edge_list $edges
    } elseif {[info exists uns_current_edge_list]} {
	$uns_current_edge_list delete
	unset uns_current_edge_list
    }
}

## Convert the current diagnostic edgelist to bar elements and put them
## in the named map.  They are given the specified family.

proc ic_uns_convert_edgelist_to_bars {name family} {
    global uns_cur uns_current_edge_list

    if ![info exists uns_current_edge_list] { error "no edge list exists" }
    set map [$uns_cur get_map $name]
    if {$map == ""} { error "no map exists with that name" }
    foreach {n1 n2} [$uns_current_edge_list list_vertices] {
	$map create_element_by_numbers BAR_2 $fam 0 $n1 $n2
    }
}

## Run diagnostics on the currently loaded unstructured mesh.
## The arguments come in keyword value pairs.  The possible options are:
## <ul>
## <li> <b>diag_type</b> <em>what</em> : the type of diagnostic.  This can be
## one or more of the following:
## <ul>
## <li> <b>duplicate</b> : check for duplicate elements
## <li> <b>single</b> : check for single-element edges
## <li> <b>single_2</b> : check for 2-single-edged elements
## <li> <b>multiple</b> : check for multiple-element edges
## <li> <b>single_multiple</b> : check for single/multiple edged elements
## <li> <b>uncovered</b> : check for uncovered volume faces
## <li> <b>missing_internal</b> : check for missing internal faces
## <li> <b>triangle_box</b> : check for triangle boxes
## <li> <b>nmanvert</b> : check for nonmanifold vertices
## <li> <b>vol_orient</b> : check for mis-oriented volume elements
## <li> <b>surf_orient</b> : check for mis-oriented surface elements
## <li> <b>disconnected_vert</b> : check for disconnected vertices
## <li> <b>3_surface_node_internal_faces</b> : check for spanning edges
## <li> <b>periodic_problem</b> : check for problems with periodicity
## <li> <b>overlap</b> : check for overlapping elements in the mesh
## <li> <b>delaunay</b> : check for Delaunay violations in the mesh
## <li> <b>standalone</b> : check for shells not connected to any volume
## <li> <b>metric</b> : apply one of the quality metrics
## <li> <b>all</b> : do all of the above
## </ul>
## <li> <b>type</b> <em>typename</em> : look at elements of this type, which
## can be TRI_3 or QUAD_4.  If no type name is given then all types
## are selected.
## <li> <b>family</b> <em>famname</em> : check elements of this family.  This
## argument can be given more than once for multiple families.
## If no family is given then all families are selected.
## <li> <b>fams</b> <em>famnames</em> : check elements of the named families.
## This is just like the family argument except you can give multiple families.
## If no family is given then all families are selected.
## <li> <b>fix</b> <em>on</em> : fix the elements that fail the check,
## if possible (default is 0)
## <li> <b>fix_fam</b> <em>family</em> : if fix is selected and new elements
## have to be created, put them in this family
## <li> <b>fix_project</b> <em>on</em> : if fix is selected and new nodes
## are created, project them to the geometry.  This is applicable only for
## for the <b>missing_internal</b> diagnostic type.
## <li> <b>minval</b> <em>val</em> : the minimum acceptable value for a
## quality check (default is 0)
## <li> <b>maxval</b> <em>val</em> : the maximum acceptable value for a
## quality check (default is to not check this)
## <li> <b>metric</b> <em>what</em> : which quality metric to use (default
## is Quality)
## <li> <b>disp_elems</b> <em>on</em> : if <em>on</em> is 1 then display
## the problem elements and wait for user confirmation before proceeding.
## If it's 2 then the elements will remain displayed until cleared using
## <b>ic_clear_diag_display</b>.  If <em>fix</em> was given then only those
## elements that could not be fixed will be displayed.
## The default is 0.
## </ul>
## The return value ***

proc ic_uns_diagnostic {args} {
    global uns_cur interrupt_disable batch_mode uns_current_edge_list

    set types ""
    set fams ""
    set subset ""
    set diag_type ""
    set fix 0
    set fix_fam FIX_FAM
    set fix_project 1
    set disp_subset ""
    set value_return 0
    set ret_low 0
    set ret_high 0
    set diag_verb ""
    set quiet 0
    set busy_off 0
    set skip 0

    foreach {n v} $args {
	    switch -- $n {
	        fix - fix_fam - fix_project - disp_elems - subset -
	        disp_subset - diag_type - diag_verb - fams - quiet -
            busy_off - skip {
		        set $n $v
	        }
	        type        { lappend types $v }
	        family      { lappend fams $v }
	        default     { error "unknown option $n $v" }
	    }
    }
    if {$diag_verb == ""} { set diag_verb $diag_type }
    set what_checking ""
    if {$subset != ""} {
	    set allmap [$uns_cur get_map $subset]
	    set del_map 0
	    set what_checking "subset \"$subset\""
    } elseif {($types == "") && ($fams == "")} {
	    set allmap [$uns_cur get_map All]
	    set del_map 0
	    set what_checking "all elements in mesh"
    } else {
	    set map [uns_map -mesh $uns_cur]
	    if {$fams == ""} { set fams all }
	    if {$types == ""} { set types MIXED }
        set allmap [uns_map -mesh $uns_cur]
	    $allmap add_family_type $fams $types 0
	    set del_map 1
	    set what_checking "part(s) {$fams} of type {$types} in mesh"
    }
    if {$disp_subset != ""} {
	    set map [$uns_cur get_map $disp_subset]
    } else {
	    set map [uns_map -mesh $uns_cur]
    }
    if {$allmap == ""} { error "Couldn't get source map" }
    if {$map == ""} { error "Couldn't get dest map" }

    # if it's 2D mesh, then try to think for user (Bugs #2316, #5371).
    if {2 == [ic_uns_dimension]} {
	    set prev_diag_verb $diag_verb
	    if ![string equal $diag_verb $prev_diag_verb] {
	        mess "Surface mesh loaded: running analogous $diag_verb instead of $prev_diag_verb!\n" red
	    }
    }

    if !$quiet {
	    mess "Running diagnostics for $diag_verb in $what_checking\n"
    }

    set interrupt_disable 1
    if !$busy_off {
        busy 1
    }

    set nch 0
    switch $diag_type {
	    bound_edge {
	        set nch [$map diagnostic_${diag_type} $allmap $uns_current_edge_list $fix_fam]
	    }
	    periodic_problem {
	        if ![ic_geo_is_loaded] {
		        busy 0
		        mess "Error: can't do check periodic: no geometry is loaded\n" red
		        return [list 0 0]
	        }
	        if {$fams == ""} {
		        busy 0
		        return [list 0 0]
	        }
	        if ![ic_uns_subset_nodes_are_periodic All] {
		        busy 0
		        mess "There is no periodicity defined in the mesh\n" red
		        return [list 0 0]
	        }
	        set probs [eval $allmap check_periodic $fams]
	        foreach line $probs {
		        if !$quiet { mess $line red }
		        if [regexp {^triangle ([0-9]*) } $line xx num] {
		            set badn_tri($num) 1
		        }
		        if [regexp {^quad ([0-9]*) } $line xx num] {
		            set badn_quad($num) 1
		        }
	        }
	        set nch 0
	        foreach n [array names badn_tri] {
		        $map add_with_number $n 2 TRI_3
	        }
	        foreach n [array names badn_quad] {
		        $map add_with_number $n 2 QUAD_4
	        }
	    }
	    vol_orient {
	        set ok [unstruct_check_vol_orient $subset $disp_subset 0]
	    }
	    surf_orient {
	        set ok [ic_uns_check_orientation $subset $disp_subset 0 $quiet]
	    }
	    disconnected_vert {
	        set ok [unstruct_disconnected_verts "" $skip]
	    }
	    default {
	        set new_edges 0
	        if ![info exists uns_current_edge_list] { set new_edges 1 }
	        if $new_edges { ic_uns_create_diagnostic_edgelist 1 }
	        set nch [$map diagnostic_$diag_type $allmap $uns_current_edge_list]
	        if $new_edges { ic_uns_create_diagnostic_edgelist 0 }
	    }
    }

    set interrupt_disable 0
    if !$busy_off {
        busy 0
    }

    set nprobs [lindex [$map count] 0]
    if !$quiet {
	    switch $diag_type {
	        disconnected_vert - surf_orient {
		        mess "$diag_verb [expr {("s" != [string index $diag_verb end]) ? "is" : "are"}]\
		            [expr {($ok == 0) ? "not" : ""}] OK\n" [expr {($ok == 0) ? "red" : "black"}]
	        }
	        uncovered {
		        mess "[expr {($nprobs == 0) ? "No" : $nprobs}] \
		            problem volume element[expr {($nprobs == 1) ? "" : "s"}] \
		            [expr {($nprobs == 1) ? "was" : "were"}] found for $diag_verb\n" \
		            [expr {($nprobs == 0) ? "black" : "red"}]
	        }
	        periodic_problem {
		        # no map, info printed out already
	        }
	        default {
                mess "[expr {($nprobs == 0) ? "No" : $nprobs}] \
		            problem[expr {($nprobs == 1) ? "" : "s"}] \
		            [expr {($nprobs == 1) ? "was" : "were"}] found for $diag_verb\n" \
		            [expr {($nprobs == 0) ? "black" : "red"}]
	        }
	    }
    }

    if $del_map { $allmap delete }
    return [list $nprobs $nch]
}

## Get the value for a particular <em>param</em> for a particular <em>diagnostic</em>

proc ic_uns_get_diagnotic_info {diagnostic param} {
    return [ic_uns_sub_get_diagnotic_info $diagnostic $param]
}

## Run diagnostics on the currently loaded unstructured mesh.
## There may be additional optional arguments:
## <ul>
## <li> <b>prism_warp_weight</b> <em>value</em> : a value between 0 and 1 that
## controls the relative weighting of warp and aspect ratio for prism quality
## </ul>
## Returns a list in the following order:
##    number of elements with this diagnostic,
##    number of elements for which this diagnostic is undefined,
##    not used,
##    worst element quality with this diagnostic,
##    best element quality with this diagnostic,
##    used to calculate the mean quality

proc ic_uns_metric {{name all} {type Quality} {args ""}} {
    global uns_cur batch_mode  current_metric  env
    
    set verbose 1
    if [info exists env(ICEM_TESTING)] {
        set verbose 0
    }
    set current_metric $type
    
    # for backward compatibility
    if {$type == "Qualitygls"} { set type Quality }
    set map [$uns_cur get_map $name]
    set st [eval $map compute_diagnostic \"$type\" $args]
    set nok [lindex $st 0]
    set nundef [lindex $st 1]
    set nbad [lindex $st 2]
    set min [lindex $st 3]
    set max [lindex $st 4]
    set totval [lindex $st 5]
    # In some wierd cases we can get underflow and tcl can't represent a
    # number that comes out.
    if ![string is double $min] { set min 0 }
    if ![string is double $max] { set max 0 }
    if ![string is double $totval] { set totval 0 }
    if {[string is integer $nok] && ($nok > 0)} {
        if {$verbose} {
            mess "Min = $min, max = $max"
            # make sure it's a number before dividing
            if {[string is double $totval] || [string is integer $totval]} {
                mess ", mean = [expr $totval / ($nok + 0.0)]"
            }
            mess "\n$nok elements with the \"$type\" diagnostic\n"
        }

        #mess "$nbad elements with this diagnostic in the invalid range\n"
        if {$name != "all" && $nundef > 0} {
            mess "$nundef elements for which this diagnostic is undefined\n"
        }
        if {($type == "Volume") || ($type == "Surface area") || ($type == "Volume/Area/Length")} {
            mess "Total = $totval\n"
        }
    } else {
        mess "Warning: $type is not defined for any elements: $nok\n" red
    }
    return $st
}
set dont_record_command(ic_uns_get_diagnotic_info) 1

## Get the number of elements in the given <em>fams</em> of the given
## <em>types</em> which fall between <em>to</em> and <em>from</em>
## when evaluated by the given metric <em>diag</em>

proc ic_uns_n_els_in_metric_range {fams types diag from to} {

    if {("" == $fams) || ("ALL" == $fams) || ("All" == $fams)} {
        set fams [ic_uns_list_families]
    }
    if {("" == $types) || ("ALL" == $types) || ("All" == $types)} {
        set types [ic_uns_list_types]
    }
    set map [ic_uns_subset_create]
    if {"" == $map} {
        mess "Error: could not create subset for diagnostics\n" red
        return -1
    }
    ic_uns_subset_add_families_and_types $map $fams $types
    set num [ic_uns_subset_n_els_in_metric_range $map "$diag" $from $to]
    ic_uns_subset_delete $map
    return $num
}

## Get the number of elements in the given <em>map</em> which fall between
## <em>to</em> and <em>from</em> when evaluated by the given
## metric <em>diag</em>

proc ic_uns_subset_n_els_in_metric_range {map diag from to} {
    if ![ic_uns_subset_exists $map] {
	mess "Error: subset \"$map\" does not exist\n" red
	return -1
    }

    set stuff [ic_uns_metric $map $diag]
    #puts "debug: stuff: $stuff"

    set nbars 1 ;# !changing this will break this proc!
    set info [ic_uns_histogram $map $from $to $nbars]
    #puts "debug: info: $info"

    # "info" should be a list of three vals, assuming nbars is 1
    # we want the index 1

    return [lindex $info 1]
}

## Set weights (min, ideal, max) for a given metric for eltype

proc ic_uns_set_metric_weight {metric eltype args} {
    # JKA: see mesh/diagnostic.C
    switch $metric {
	Angle {
	    foreach met {"Min angle" "Max angle"} {
		foreach {a v} $args {
		    eval diagnostic_set_weights name \{$met\} eltype $eltype $a $v
		}
	    }
	}
	default {
	    eval diagnostic_set_weights name \{$metric\} eltype $eltype $args
	}
    }
}

## Set weights for a list of metrics such that each element of the list matches
## the arguments to ic_uns_set_metric_weight, i.e. {{metric eltype weights} ...}

proc ic_uns_set_metric_weights {list {reset 1}} {

    if $reset { eval ic_uns_set_metric_weight reset_all QUAD_4 }
    foreach el $list { eval ic_uns_set_metric_weight $el }
}

## Get a list of the metric names that are understood

proc ic_uns_get_metric_names {} {
    set stat [catch {eval diagnostic_info} metric_info]
    set metric_name_list ""
    foreach mi $metric_info {
	set metric_name [lindex $mi 0]
	set metric_info [lindex $mi 1]
	lappend metric_name_list $metric_name
    }
    return $metric_name_list
}
set dont_record_command(ic_uns_get_metric_names) 1

## Return a list of the current custom metric defs, e.g:
##  { {{Skew} TRI_3 acc_min 0 des_min 0 ideal 0 des_max 45 acc_max 60} \
##    {{Skew} QUAD_4 acc_min 0 des_min 0 ideal 0 des_max 45 acc_max 60} \
##    ... \
##  }

proc ic_uns_get_metric_weights {metric} {
    set asdf [diagnostic_get_weights $metric]
    return $asdf
}
set dont_record_command(ic_uns_get_metric_weights) 1

## Print the key used for the coloring of elements in the display
# JKA: see mesh/diagnostic.C

proc ic_uns_print_diagnostic_quality_key {metric_name} {
    global quality_key_printed_ntimes

    if ![info exists quality_key_printed_ntimes] {
	set quality_key_printed_ntimes 0
    }
    # Just print it sometimes
    if ![expr $quality_key_printed_ntimes % 4] {
	# This string is compare to vals in mesh/diagnostic.C:DiagnosticInfoTable
	if {"Custom quality" == $metric_name} {
	    mess "Custom diagnostic weighted quality key:\n"
	    mess "\tvalues less than 1 are outside user-defined acceptable range\n" red
	} else {
	    mess "Diagnostic relative quality key:\n"
	}
	mess "\telements with undefined diagnostic values are colored gray\n"
	foreach k [diagnostic_quality_key] {
	    set range [lindex $k 0]
	    set color [lindex $k 1]
	    mess "\t$range\n" $color
	}
	mess "\n"
    }
    incr quality_key_printed_ntimes
}

proc ic_uns_diagnostic_keys {} {

    set diagnostic_keys {
        duplicate multiple triangle_box single_2 single_multiple \
        standalone single delaunay overlap 3_surface_node_internal_faces \
        uncovered missing_internal periodic_problem	\
        bound_edge nmanvert	disconnected_vert vol_orient \
        surf_orient hanging penetrating disconnbars \
    }
    return $diagnostic_keys
}

## Use the diagnostic data for a histogram

proc ic_uns_histogram {name min max nbars} {
    global uns_cur
    set map [$uns_cur get_map $name]
    return [$map diagnostic_histogram $min $max $nbars]
}

## Set the elements in a subset via histogram intervals

proc ic_uns_set_with_diagnostic {name from intervals} {
    global uns_cur 

    ic_uns_subset_create $name
    set map [uns_get_subset $name]
    ic_uns_subset_create $from
    if {"" == $map} {
	mess "cannot get map $name from uns\n"
	return 0
    }
    set fmap [$uns_cur get_map $from]
    $map clear
    set tot 0
    # the case of {0 0.2}
    if {[llength [lindex $intervals 0]] == 1} {
       set tot [$map add_with_diagnostic $fmap [lindex $intervals 0] \
                   [lindex $intervals 1] 1 1 0]
    } else {
    # the case of {{0 0.2} ...}
       foreach int $intervals {
	 set n [$map add_with_diagnostic $fmap [lindex $int 0] \
		   [lindex $int 1] 1 1 0]
	 incr tot $n
       }
    }
    return $tot
}

## Update the diagnostic values on the mesh, and return
## the number of elements on which the diagnostic was updated.
## If no diagnostic has been run, this procedure will return 0.

proc ic_uns_diagnostics_update {} {
    global uns_cur
    if ![ic_uns_is_loaded] { return 0 }
    return [$uns_cur update_diagnostics]
}

## If any diagnostic graphics are left on the screen after an
## <b>ic_uns_diagnostic</b> call with <b>disp_elems</b> set to 2, erase them.

proc ic_clear_diag_display {} {
    unstruct_clear_diag_display
}

## get the mesh distribution along a line in the mesh

proc ic_uns_mesh_distribution {p1 p2 {what 0}} {
    global uns_cur tdv_default batch_mode

    if {$uns_cur == ""} {return ""}
    set allmap [$uns_cur get_map All]
    if {$allmap == ""} {error "couldn't get source map"}
    set map [$uns_cur get_map diagnostic_distribution]
    if {$map == ""} {
        set color [$tdv_default highlight_color]
        set map [uns_map -mesh $uns_cur -name diagnostic_distribution \
            -color $color -width 2 -list_type 2]
        if {$map == ""} { error "couldn't get dest map" }
	if !$batch_mode {$tdv_default add_image $map}
    } else {
        $map clear
    }
    return [$map diagnostic_distribution $allmap $p1 $p2 $what]
}

## Display some unstructured elements selected or not

proc ic_uns_show_selected {type names on {color ""} {force_all_types 0}} {
    global unstruct_show_selected_map uns_cur batch_mode
    global tdv_default

    if {$uns_cur == ""} return

    if {$color == ""} { set color [$tdv_default highlight_color] }

    if ![info exists unstruct_show_selected_map] {
	set unstruct_show_selected_map [uns_map -mesh $uns_cur -color $color \
					    -width 2 -list_type 2]
	if !$batch_mode { $tdv_default add_image $unstruct_show_selected_map }
    }

    set types ""
    foreach t { BAR_2 NODE TRI_3 QUAD_4 BAR_3 TRI_6 QUAD_8 QUAD_9 LINE_2 LINE_3 } {
	if {$force_all_types || [get_uns_type_visible $t]} {
	    lappend types $t
	}
    }

    if $on {
        $unstruct_show_selected_map add_family_type $names $types 0
    } else {
        $unstruct_show_selected_map remove_family_type $names ""
    }
}
set dont_record_command(ic_uns_show_selected) 1

## Reset all selection display

proc ic_uns_reset_selected {} {
    global unstruct_show_selected_map
    if [info exists unstruct_show_selected_map] {
	$unstruct_show_selected_map delete
	unset unstruct_show_selected_map
    }
}
set dont_record_command(ic_uns_reset_selected) 1

## Make the nodes in a subset periodic

proc ic_uns_make_periodic {name} {
    global uns_cur
    set map [$uns_cur get_map $name]
    big_uns_op 1 {
        $map make_nodes_periodic
#       if [catch [$map make_nodes_periodic] res] {
#           mess $res\n red
#           return
#       }
    }
    $uns_cur configure -modified 1
}

## Make the nodes of two faces periodic from a given element pair

proc ic_uns_make_periodic_from_element_pair {e1 e2} {
    ic_uns_subset_delete uns_sel_0
    ic_uns_create_selection_subset 0
    ic_uns_subset_add_number uns_sel_0 "$e1 $e2" 2 MIXED
    ic_uns_make_periodic uns_sel_0
    ic_uns_subset_delete uns_sel_0
}

## Make the elements in a subset periodic

proc ic_uns_make_auto_periodic {src dest} {
    global uns_cur

    if {$uns_cur == ""} return
    if {"" == $src} {
	set map [$uns_cur get_map all]
    } else {
	set map [$uns_cur get_map $src]
    }
    set dmap [$uns_cur get_map $dest]
    $uns_cur configure -modified 1

    set nn 0
    big_uns_op 1 {
        set nn [$dmap make_elements_periodic $map]
    }
    $uns_cur configure -modified 1
    return $nn
}

## Make the nodes in a subset not periodic

proc ic_uns_remove_periodic {name} {
    global uns_cur
    set map [$uns_cur get_map $name]
    big_uns_op 1 {
      $map make_nodes_not_periodic
    }
    $uns_cur configure -modified 1
}

## Perform the flood-fill operation of cutter

proc ic_flood_fill { { args "" } {keep_orfn 0}} {
    global uns_cur

## med crashes if no proj model - Bruce
    if ![ic_geo_is_loaded] {
	ic_empty_tetin
    }

    busy 1
## This clashes with geom undo - Ganesan
    ic_undo_suspend
## If periodic with pentas or pyras, the surface mesh
## may be lost - Bruce
    array set perdata [ic_geo_get_periodic_data]
    if {$perdata(type) != "none"} {
      ic_geo_set_periodic_data {type none}
    }
    catch { eval $uns_cur flood_fill $args } path
    ic_uns_families_changed
    if {$perdata(type) != "none"} {
      ic_geo_set_periodic_data [array get perdata]
    }
    ic_undo_resume
    
    # Delete elements if some in ORFN
    if {[ic_uns_count_in_families ORFN] != [ic_uns_subset_count_elements all]} {
	set sub  [ic_uns_subset_create] 
	ic_uns_subset_make_families $sub ORFN
	if $keep_orfn {
	    set fam LIVE
	    $uns_cur create_family $fam -1
	    ic_uns_change_family $sub $fam
	    mess "Elements moved from ORFN to LIVE\n" red
	} else {	    
	    ic_delete_elements subset $sub
	}
	ic_uns_subset_delete $sub
    }
    $uns_cur configure -modified 1
    busy 0
    return $path
}

## flood fill a mesh. Volumes need to be enclosed by surface elements

proc ic_flood_fill_mesh {{keep_orfn 0} {only_mat 0}} {
    global uns_cur

    if {$uns_cur == ""} return
    set map [$uns_cur get_map all]
    mess "Performing a mesh flood fill...\n" blue
    if [catch { $map flood_fill_mesh $only_mat } msg] {
        mess $msg red
        return
    }
    mess $msg
    ic_uns_families_changed
    # Delete elements if some in ORFN
    if {[ic_uns_count_in_families ORFN] != [ic_uns_subset_count_elements all]} {
	    set sub  [ic_uns_subset_create]
	    ic_uns_subset_make_families $sub ORFN
	    if $keep_orfn {
	        set fam LIVE
	        $uns_cur create_family $fam -1
	        ic_uns_change_family $sub $fam
	        mess "Elements moved from ORFN to LIVE\n" red
	    } else {
	        ic_delete_elements subset $sub
	    }
	    ic_uns_subset_delete $sub
    }
    mess "Done mesh flood fill\n" blue
    $uns_cur configure -modified 1
}

## Automatically create orphan regions

proc ic_auto_orphan { } {
    global uns_cur
    $uns_cur auto_orphan
    $uns_cur configure -modified 1
}

## Run the quad mesher to fix holes, etc.

proc ic_uns_quad_remesh {map args} {

    set how 0
    set h -1
    set proj 0
    set iters -20
    set conver 0.025
    set b_smooth 0
    set merge_ends 0
    set merge_tol 0
    set element 0
    set complete_edges 0
    set surf 0
    set ele_tol 0
    set dev 0
    set make_consistent 0
    set debug 0
    set all_dim 0
    set quality 1
    set max_steps 0
    set offset 0
    set offset_h 1
    set simple_offset 0
    set angle 0
    set vertex -1
    set keep_fixed_nodes 0
    set inner 0
    set diagnostic ""
    set material ""
    set geo_id 0
    set w 0
    set improvement 1
    set n_threads 0
    set unique 0
    foreach {a v} $args {
        set $a $v
    }
    if [ic_geo_is_loaded] {
        set p $proj
    } else {
        set p 0
    }
    if {$h == -1} {
        if {$how == 0 && $offset > 0} {
            set h 0
        } elseif {$how == 1} {
            set h 4
        } else {
            set h 3
            if {$keep_fixed_nodes} {
                set h 0
            }
        }
    }
    if ($p) {
        set surf 0
    }
    set subset [uns_get_subset $map]
    if {($subset != "") && ([lindex [$subset count] 0] > 0)} {
        # If we only have nodes, don't do this because that will mess up
        # the bar loop
        $subset uniqify
    }
    set ret 0
    if {$how == 5} {
        ic_smooth_quad $map $p $iters $conver 0 $element $w $b_smooth $debug $n_threads \
            $unique $diagnostic
    } elseif {$how == 4 || $how == 3} {
        ic_remesh_edges $map $merge_tol $merge_ends 0 $debug
    } elseif {$how == 2 || $how == 6} {
        # return the internal number(s) of the (new) element(s)
        set ret [ic_quad_from_bars $map $element $p $iters $conver \
            $improvement $surf $complete_edges $ele_tol $dev $debug]
    } elseif {$how == 7} {
        # return the internal number(s) of the (new) element(s)
        set ret [ic_remesh_bad_elements $map $element $p $debug $all_dim $max_steps $quality \
            $angle $ele_tol $inner $diagnostic $material]
    } elseif {$how == 8} {
        # return the internal number(s) of the (new) element(s)
        set ret [ic_enforce_vertex $map $element $p $debug $all_dim $vertex $make_consistent]
    } else {
        # return the internal number(s) of the (new) element(s)
        set ret [ic_quad_from_elements $map $element $p $h 0 0 0.1 \
            $ele_tol $dev $debug 0 $offset $offset_h $keep_fixed_nodes $inner $material \
            $geo_id $simple_offset]
    }
    if $make_consistent {
        # don't add the caps just count the open faces.
        ic_uns_make_consistent all count_open
    }
    return $ret
}

## Make there exist a node at location in the subset subset_name
## by on of these methods: move,

proc ic_uns_force_node_loc {subset_name location {method "move"}} {
    
    set map [uns_get_subset $subset_name]
    if {"" == $map} { return }
    
    switch -- $method {
	move {
	    $map move_nearest_node_to_loc $location
	}
	default {}
    }
}

## Returns a list such that the first element is the number of
## disconnected nodes found in the current unstructuted mesh,
## and the second element is the subset containing those nodes

proc ic_get_disconnected_vertices {} {
    global uns_cur
    
    set nn 0
    set subset_name [ic_uns_create_diagnostic_subset 0]
    set map [$uns_cur get_map $subset_name]
    if {"" != $map} {
	$map diagnostic_disconnected_verts
	set nn [lindex [$map count] 1]
    }
    return [list $nn $subset_name]
}
set dont_record_command(ic_get_disconnected_vertices) 1

## Deletes the disconnected vertices in the given subset, or
## if the map is not give, in the current mesh,
## and returns the number of disconnected vertices deleted

proc ic_delete_disconnected_vertices {{quiet 0}} {
    global uns_cur
    
    set lkj [ic_get_disconnected_vertices]
    set nn [lindex $lkj 0]
    set subset_name [lindex $lkj 1]
    set map [$uns_cur get_map $subset_name]
    if {"" == $map} { return 0 }
    if $nn {
	$map delete_vertices
	if {!$quiet} {
	    mess "Deleted $nn disconnected vertices\n"
	}
	$uns_cur configure -modified 1
    }
    ic_uns_subset_delete $subset_name
    ic_uns_set_modified 1
    return $nn
}

## Build the topology information from the mesh subset given <b>which</b>.
## It's fairly analagous to ic_geo_build_topo. It will also do call:
## ic_uns_set_node_dimension all reset after running.
## Arguments <b>args</b> are:
## <ul>
## <li> <b>-angle</b> <i>angle</i> : the angle for extraction (degrees)
## <li> <b>-smart</b> : according to angle, choose options which seem best 
## <li> <b>-new_element_family</b> <i>family_name</i> : family name for new elements
## <li> <b>-uncovered_element_family</b> <i>family_name</i> : family name for any uncovered faces
## <li> <b>-save_old</b> : put removed elements in ORFN (else delete)
## <li> options:
## <li> <b>-remove_points (or -filter_points)</b> : try removing points at curve intersections,
##      the difference between tangeents of which is below specified angle
## <li> <b>-remove_bars (or -filter_bars)</b> : try removing bars
## <li> <b>-create_points</b> : try add points at bar intersections,
##      the difference between tangeents of which is below specified angle
## <li> <b>-create_bars_single_edges</b> : create bars on single edges in mesh
## <li> <b>-create_bars_multiple_edges</b> : create bars on multiple edges in mesh
## <li> <b>-create_bars_double_edges</b> : create bars on double edges in mesh (using -angle)
## </ul>

proc ic_uns_build_mesh_topo {which args} {
    global batch_mode

    #fix for bug - 10721
    if ![ic_geo_is_loaded] {
	ic_empty_tetin
    }
    set map [uns_get_subset $which]
    if {"" == $map} {
	mess "Error: could not find map $which in the mesh\n" red
	return 0
    }
    
    set found_shell 0
    set types [ic_uns_subset_list_types $which]
    foreach t "TRI_6 QUAD_8 QUAD_9" {
        if {[lsearch $types $t] >= 0} {
            set found_shell 1
            break
        }
    }
    if $found_shell {
    	mess "Error: supported for linear meshes only\n" red
    	return 0
    }
    big_uns_op 1 {
	#First see if there are uncovered faces and prompt to fix, this should probably get moved inside med.
	set fam ""
	set args2 ""
	foreach {i j} $args {
	    if {$i == "-uncovered_element_family"} {
                set fam $j
            } elseif {$i == "-create_bars_family_intersection"} {
                lappend args2 $i
            } else {
                lappend args2 $i $j
            }
	}
	if {$fam == ""} {set fam UNCOVERED_FACES}
#	ic_uns_diagnostic subset $map diag_type uncovered fix_fam $fam disp_subset uns_diag_0 diag_verb {Uncovered faces} fams {}
	if {[lsearch [ic_uns_list_families] $fam] == -1} {ic_uns_new_family $fam}
	ic_uns_fix_uncovered_faces $which $fam 
    	set ret [eval $map build_mesh_topo $args2]
	mess "$ret" blue
	mess "Build mesh topology completed\n"
    	ic_uns_set_node_dimension all reset
    }
    if !$batch_mode {
       display_update unstruct
    }
    ic_uns_set_modified 1
    return 1
}

proc ic_uns_offset {distance} {
    # this is for backward compatibility though i don't know of anyone who used it.
    return [ic_uns_offset_mesh map All dir normal dist $distance]
}

## Offset the mesh by distance. Right now it only works on the whole mesh.
## <li><b>dir</b> <em>direction</em> : elements should be offset in this direction.
## It can take any one of the following strings:
##     normal       - Normal to the current element normals
##     "$x $y $z"   - Arbitrary direction
##     [+|-][x|y|z] - e.g. +x: offset wrt the current element normal in the given +x direction.
## <li><b>dist</b> <em>distance</em> : elements should grow in this direction.
## Example:
##    ic_uns_offset_mesh map All dir +x dist 2

proc ic_uns_offset_mesh {args} {
        global uns_cur
    
    if ![ic_uns_is_loaded] {
	error "There is no current mesh: please load one\n"
    }
    
    set map ""
    set dir "0 0 0"
    set dist 0
    
    foreach {n v} $args {
	switch -- $n {
	    dir - map - dist {
		set $n $v
	    }
	    default { error "in offsetting, unknown option $n $v" }
	}
    }
    
    # just in case dir is not a vecor, rather a keyword
    
    switch -- $dir {
	+x - +X - x+ - X+ { set dir "\{1 0 0\}" }
	-x - -X - x- - X- { set dir "\{-1 0 0\}" }
	+y - +Y - y+ - Y+ { set dir "\{0 1 0\}" }
	-y - -Y - y- - Y- { set dir "\{0 -1 0\}" }
	+z - +Z - z+ - Z+ { set dir "\{0 0 1\}" }
	-z - -Z - z- - Z- { set dir "\{0 0 -1\}" }
	norm - normal     { set dir "normal" }
    }
    
    if {"" == $map} {
	set emap [$uns_cur get_map all]
    } else {
	set emap [$uns_cur get_map $map]
    }
    if {"" == $emap} {
	error "could not get the subset to offset $map"
    }
    
    set args "-direction $dir -distance $dist"
    ic_newop
    eval $emap offset $args

    display_update unstruct
}

## Returns a subset with internal wall elements

proc ic_uns_internal_wall_elements_get {} {
    set fams [ic_uns_internal_wall_families_get]
    if {$fams != ""} {
        set sub [ic_uns_subset_create]
        ic_uns_subset_add_by_neighbors $fams $sub 2
        return $sub
    } else {
        return ""
    }
}

## Returns a list of families with internal walls

proc ic_uns_internal_wall_families_get {} {
    
    set fams ""
    foreach f [ic_uns_list_families] {
        # if this family has no 2-sided elements, skip it
        set n2 [lindex [ic_uns_count_family_neighbors $f] 2]
        if !$n2 continue
        lappend fams $f
    }
    if {$fams == ""} {
        mess "There are no internal walls\n"
    } elseif {"" != [info commands "family_name_compare"]} {
        set fams [lsort -command "family_name_compare 2" $fams]
    }
    
    return $fams
}

## Reorients the internal walls of given families to have consistent normals.
## Returns the number of element orientations changed.

proc ic_uns_internal_wall_families_reorient {fams} {
    
    set nchanged 0
    
    foreach f $fams {	
	#
	# create a sourcemap of that family
	#
	set sourcemap [ic_uns_subset_create]
	set types "TRI_3 QUAD_4"
	ic_uns_subset_add_families_and_types $sourcemap $f $types
	#
	# while there are still elements left in that sourcemap...
	#
	while [ic_uns_subset_count_elements $sourcemap] {	    
	    #
	    # get the list of els left in sourcemap, then
	    # get the first element in that list, then
	    # get the element's type and number to use as a reference
	    #
	    set els [ic_uns_subset_list_elements $sourcemap]
	    if {"" == $els} { break }
	    set first_el [lindex $els 0]
	    if {"" == $first_el} { break }
	    set type [lindex $first_el 0]
	    set num  [lindex $first_el 1]
	    if {("" == $type) || ("" == $num)} { break }
	    #
	    # create a selection map of that single element
	    #
	    set selmap [ic_uns_subset_create]
	    ic_uns_subset_add_number $selmap $num 1 $type
	    #
	    # create a map for the flood fill
	    #
	    set floodmap [ic_uns_subset_create]
	    ic_uns_subset_add_number $floodmap $num 1 $type
	    #
	    # flood fill to single 1or multiple edges from selmap element
	    #
	    ic_uns_subset_add_attached $floodmap $sourcemap fam
	    #
	    # reorient consistent the floodmap on selmap
	    #
	    incr nchanged [ic_uns_reorient $floodmap consistent $selmap]
	    #
	    # removing the floodmap from the sourcemap
	    #
	    ic_uns_subset_subtract_from $sourcemap $floodmap
	    #
	    # delete the flood map and selection map
	    #
	    ic_uns_subset_delete $floodmap
	    ic_uns_subset_delete $selmap
	    #
	    # and iterating until they are all gone..while...
	}
	ic_uns_subset_delete $sourcemap
    }
    
    return $nchanged
}

proc ic_uns_create_staircase_envelope {{fam ""}} {
    global uns_cur
    
    if {$fam == ""} {
	set fam ENVELOPE
    }
    
    ic_unstruct_make_families_exist $fam
    set map [$uns_cur get_map all]
    set status [$map create_staircase_envelope $fam]
    ic_delete_elements family CUTCELL
    ic_delete_disconnected_vertices
    display_update unstruct
}

proc ic_uns_smooth_staircase_envelope {lamda mu relax_factor niter type} {
    global uns_cur
        
    set map [$uns_cur get_map all]
    big_uns_op 1 {
	set status [$map smooth_staircase_envelope $lamda $mu $relax_factor $niter $type]
    }
    display_update unstruct
}

# split elements at vertex in Y grid fashion 
proc ic_uns_ysplit_hexas_at_vertex {name} {
    global uns_cur
    set map [$uns_cur get_map $name]

    ic_newop 
    busy 1

    set n [$map ysplit_hexas_at_vertex]
    mess "Num. of elements split = $n\n" blue

    busy 0
}

# split hexa into 2 prisms at the given verts and propagate
proc ic_uns_split_hexa_into_prisms_propagete {name} {
    global uns_cur
    set map [$uns_cur get_map $name]

    ic_newop
    busy 1

    set n [$map split_hexa_into_prisms_propagate]
    mess "Num. of elements split = $n\n" blue

    busy 0
}

## Calculate spectral edges

proc ic_uns_spectral_elements {name file order law} {
	global uns_cur projlib
        set map [$uns_cur get_map $name]
        $map spectral_edges $projlib $file $order $law
}

proc ic_uns_list_edgelist_vertices {edgelist} {
    if {$edgelist != ""} {
	$edgelist list_vertices
    }
}
set dont_record_command(ic_uns_list_edgelist_vertices) 1

## Validate the match between pids in proj and uns.  For debugging.

proc ic_validate_families {} {
    global uns_cur
    
    if {$uns_cur != ""} {
 	set res [$uns_cur validate_families]
 	if {$res != ""} {
 	    error $res
 	}
    }
}

## Create a temporary mesh.

proc ic_uns_load_temporary {file {params "-color white"}} {
    global uns_tempmesh tdv_default
    
    set uns [uns_mesh -filename $file]
    ic_undo_suspend
    $uns load_domain $file 3 "" 0 0
    ic_undo_resume

    set map [eval uns_map -mesh $uns -list_type 0 -visible 1 $params]
    $tdv_default add_image $map
    
    for {set i 0} {[info exists uns_tempmesh(temp$i)]} {incr i} {}
    set uns_tempmesh(temp$i) $uns
    return temp$i
}

## Delete a temporary mesh.

proc ic_uns_unload_temporary {name} {
    global uns_tempmesh
    
    $uns_tempmesh($name) delete
    unset uns_tempmesh($name)
}

## Get the thickness associated with an element.  This returns a list of lists,
## for each element: num thick1 thick2 thick3 [thick4]

proc ic_uns_get_thickness {name} {
    global uns_cur
    set elvals ""
    set map [$uns_cur get_map $name]
    busy 1
    if [catch {
        set elvals [$map get_thickness]
    } res] {
        user_error "$res"
	return ""
    }
    busy 0
    return $elvals
}
set dont_record_command(ic_uns_get_thickness) 1

## Calculate target families based on proximity factor
## Returns a list of maps for the contact locations

proc ic_uns_contact_sets {dist {contactpartlist ""} {debug 0}} {
    global batch_mode uns_cur

    set pair_names ""
    if {$contactpartlist == ""} { 
        set map [$uns_cur get_map all] 
    } else { 
        set fam_list ""
        foreach p $contactpartlist {
            set fam_list [concat $fam_list [ic_geo_list_families_in_part $p]]
        }
        if {$fam_list == ""} {
            ic_mess "No families found in selected parts\n" red
        }
        set mapn [ic_uns_subset_create_family_type $fam_list {QUAD_4 TRI_3} 1 0 1]
        if {$mapn == ""} {
            ic_mess "No surface elements found in selected parts\n" red
        }
        set map [$uns_cur get_map $mapn]
    }
    busy 1
    big_uns_op 1 {
        if [catch {
            set maps [$map contact_elements $dist $debug]
            foreach {fam1 map1 fam2 map2} $maps {
		$map1 configure -name [ic_uns_subset_unused_name uns_sub_]
		$map2 configure -name [ic_uns_subset_unused_name uns_sub_]
                lappend pair_names $fam1 [$map1 get -name] $fam2 [$map2 get -name]
            }
        } res] {
            ic_mess "$res\n" red
        }
        if !$batch_mode {
            update_uns_available
        }
    }
    $uns_cur configure -modified 1
    if $debug {
        ic_mess "$pair_names\n"
    }
    busy 0
    return $pair_names
}

## Set an element(s) as immutable

proc ic_uns_immutable {name what} {
    global uns_cur
    set map [$uns_cur get_map $name]
    switch $what {
    create {
        $map set_immutable
    }
    clear {
        $map clear_immutable
    }
    }
    $uns_cur configure -modified 1
}

## Check if element(s) is/are immutable

proc ic_uns_isimmutable {name} {
    global uns_cur
    set map [$uns_cur get_map $name]
    if [catch {
        set ret [$map is_immutable]
    } res] {
        user_error "$res"
        return ""
    }
    return $ret
}


## Gradient smoothing

proc ic_unstruct_grad_smooth {iter_sf iter_vl alpha_sf alpha_vl \
			      {crit_avr_cha_sf 0.0001} \
			      {crit_avr_cha_vl 0.0001} \
		              {n_fix_layer 0} {sfit 0} {fams_attr ""} \
		              {rebunch_edges 0} \
			      {family_edges ""} {edges ""} {families "all"} \
			      {update_mesh_step "0"}} {
    global batch_mode uns_cur
    
    set types MIXED
    set fams $families
    set map [uns_map -mesh $uns_cur]
    $map add_family_type "$fams" $types 0
    mess "Starting gradient smoothing ...\n" blue
    set global_init "1"
    set batch "0"
    if { $update_mesh_step } {
      set cur_step "0"
      big_uns_op 1 {
        busy reset
	    set fin 0
        for {set i 0} {$i < $iter_sf && !$fin} {incr i} {
          set fin [$map unstruct_gradient_smooth $batch $cur_step $global_init \
				$iter_sf $iter_vl $alpha_sf $alpha_vl \
				$crit_avr_cha_sf $crit_avr_cha_vl \
				$n_fix_layer $sfit $fams_attr $rebunch_edges \
				$edges $family_edges]
          if { $global_init } {
            set global_init "0"
          }
          $uns_cur configure -modified 1
          incr cur_step
	}
        set cur_step "0"
        set iter_sf2 "0"
	    set fin 0
        for {set i 0} {$i < $iter_vl && !$fin} {incr i} {
          set fin [$map unstruct_gradient_smooth $batch $cur_step $global_init \
				$iter_sf2 $iter_vl $alpha_sf $alpha_vl \
				$crit_avr_cha_sf $crit_avr_cha_vl \
				$n_fix_layer $sfit $fams_attr $rebunch_edges \
				$edges $family_edges]
          if { $global_init } {
            set global_init "0"
          }
          $uns_cur configure -modified 1
          incr cur_step
        }
      } 0 1
    } else {
      big_uns_op 1 {
        busy reset
        set cur_step "-1"
        set fin [$map unstruct_gradient_smooth $batch $cur_step $global_init \
				$iter_sf $iter_vl $alpha_sf $alpha_vl \
				$crit_avr_cha_sf $crit_avr_cha_vl \
				$n_fix_layer $sfit $fams_attr $rebunch_edges \
				$edges $family_edges]
      }
      $uns_cur configure -modified 1
    }
    $map delete
#   $uns_cur renumber_all_nodes 0 0

    mess "Done gradient smoothing.\n"
}


## Elliptical smoothing

proc ic_unstruct_elliptical_smooth {iter_sf iter_vl gexpr_sf gexpr_vl \
                          stabilize_sf stabilize_vl ortho_distance_sf \
                          ortho_distance_vl stype fix n_fix_layer \
                          fams_attr rebunch_edges sfit family_edges \
                          {edges ""} {families "all"} {treat_unstruct 0} \
                          {kpg 0} {niter_post 0} {limit_post 0.2}} {
    global batch_mode uns_cur
    
    set types MIXED
    set fams $families
    set map [uns_map -mesh $uns_cur]
    $map add_family_type "$fams" $types 0
    mess "Starting elliptical smoothing ...\n" blue
    big_uns_op 1 {
      busy reset
      $map unstruct_elliptical_smooth $iter_sf $iter_vl $gexpr_sf $gexpr_vl \
                                      $stabilize_sf $stabilize_vl \
                                      $ortho_distance_sf $ortho_distance_vl $sfit \
                                      $stype $fix $n_fix_layer \
                                      $fams_attr $rebunch_edges $treat_unstruct $edges \
                                      $family_edges $kpg $niter_post $limit_post
    }
    $map delete
    $uns_cur configure -modified 1
#   $uns_cur renumber_all_nodes 0 0

    mess "Done elliptical smoothing.\n" blue
}

## Check if thickness is stored in the mesh

proc ic_uns_thickness_exists_mesh {} {
    global uns_cur
    set map [$uns_cur get_map all]
    set res [$map check_thickness_exists_mesh]
    return $res
}

## Get the thickness associated with an element-node.  This returns a list of lists,
## for each element-node: num thick

proc ic_uns_get_thickness_node {name} {
    global uns_cur
    set elvals ""
    set map [$uns_cur get_map $name]
    busy 1
    if [catch {
        set elvals [$map get_thickness_node]
    } res] {
        user_error "$res"
	return ""
    }
    busy 0
    return $elvals
}

##  Volume of surface elements for a part
##  sum of surface area of element * averaged thickness

proc ic_uns_surface_volume {name} {
    global uns_cur
    set junk1 [ic_uns_subset_create] 
    ic_uns_subset_make_families $junk1 $name
    set junk2 [ic_uns_subset_create]
    ic_uns_subset_add_families_and_types $junk2 $name {TRI_3 QUAD_4}
    ic_uns_subset_add_from $junk1 $junk2
    ic_uns_subset_delete $junk2
    set map [$uns_cur get_map $junk1]
    busy 1
    set area_vol [eval $map uns_area_volume]
    busy 0
    ic_uns_subset_delete $junk2
    return $area_vol
}

# -------------------------------------------------------------------------

## Define a new bcfield, or change the default value for the field

proc ic_uns_bcfield_define {name def} {
    global uns_cur
    if {$def == ""} { set def 0 }
    $uns_cur define_bcfield $name $def
}

## Check if a bcfield exists

proc ic_uns_bcfield_exists {name} {
    global uns_cur
    return [lmember [$uns_cur list_bcfields] $name]
}

## List the available bcfields

proc ic_uns_bcfield_list {} {
    global uns_cur
    return [$uns_cur list_bcfields]
}

## Get bcfield values 

proc ic_uns_bcfield_get {name mapn def_ok} {
    global uns_cur
    set map [$uns_cur get_map $mapn]
    return [$map get_bcfield_value $name $def_ok]
}

## Get or set bcfield default value

proc ic_uns_bcfield_default {name {val ""}} {
    global uns_cur
    if {$val == ""} {
        return [$uns_cur get_bcfield_default $name]
    } else {
        $uns_cur define_bcfield $name $val
    }
}

## Set bcfield values 

proc ic_uns_bcfield_set {name mapn val} {
    global uns_cur
    set map [$uns_cur get_map $mapn]
    return [$map set_bcfield_value $name $val]
}

## Rename a bcfield

proc ic_uns_bcfield_rename {name newname} {
    global uns_cur
    return [$uns_cur rename_bcfield $name $newname]
}

## Set up a color map for this subset that's appropriate to the given bcfield
## Actually there has to be just one of these visible at a time

proc ic_uns_subset_update_bcfield_color_map {bcfield subset} {
    global uns_cur uns_cur_color_map tdv_default
    
    if {$bcfield == "" || $subset == ""} return
    if ![info exists uns_cur_color_map] {
        # note that this goes to the gui interp because in the batch interp you can't
        # do configure -viewer $tdv_default, because objectify needs the clientdata from
        # the command and it's been aliased so it can't get it
        set uns_cur_color_map [cmap_create $tdv_default]
    }
    set mm [$uns_cur bcfield_minmax $bcfield]
    if {$mm != ""} {
        cmap_adjust $tdv_default $uns_cur_color_map [lindex $mm 0] [lindex $mm 1]
    }
    set map [$uns_cur get_map $subset]
    $map configure -color_map $uns_cur_color_map
    return $mm
}

# -------------------------------------------------------------------------

## Set bar orientations on a given set of parts

proc ic_uns_set_part_bar_orientations {parts args} {
    global uns_cur
    if {$uns_cur == ""} return
    set map [$uns_cur get_map all]
    # This is not an elegant way to do this but otherwise it would be way too slow
    foreach p $parts {
	foreach f [ic_geo_list_families_in_part $p] {
	    eval $uns_cur set_bar_orientation_on_family $f $args
	}
    }
}

## Make sure the bars in a specific map are all oriented such that no
## node has more than one bar pointing into it, if possible.  Return
## value is the number of nodes that are still violating the
## constraint.

proc ic_uns_enforce_bar_direction {name} {
    global uns_cur
    if {$uns_cur == ""} { return 0 }
    set map [$uns_cur get_map $name]
    return [$map enforce_bar_direction]
}

## Check out or give back a mesher license appropriate to the current mesh
## Returns an error string if there was a problem

proc ic_uns_mesher_license {get} {
    global uns_cur
    if {$uns_cur == ""} { return "" }
    if $get {
	return [$uns_cur grab_appropriate_mesher_license]
    } else {
	$uns_cur give_back_mesher_license
	return ""
    }
}
set dont_record_command(ic_uns_mesher_license) 1

## para mesh

proc ic_uns_associate_geometry {} {
    global uns_cur

    eval $uns_cur associate_geometry
}

proc ic_uns_update_paramesh {{delta_move ""}} {
    global uns_cur

    ic_newop
    set map [$uns_cur get_map All]
    if {$delta_move == ""} {
        set delta_move [$map min_edge_length]
    }

    #puts "eval $uns_cur update_paramesh $delta_move"
    eval $uns_cur update_paramesh $delta_move
    update_uns_visible
    $uns_cur configure -modified 1
}

## Split edges in subset and propagate

proc ic_uns_split_edges_propagate {which {par 0.5}} {
    global uns_cur
    ic_newop
    foreach {n1 n2} [ic_uns_subset_list_elements $which] {
	    set p1 [lindex $n1 1]
	    set p2 [lindex $n2 1]
	    ic_uns_split $p1 $p2 $par
    }
    update_uns_visible
    $uns_cur configure -modified 1
}

## Split an edge in the mesh

proc ic_uns_split {p0 p1 {args .5}} {
    global uns_cur
    
    if {$uns_cur == ""} {
	mess "No mesh\n" red
	return ""
    }

    busy 1
    set cmd [list $uns_cur split_edge $p0 $p1 $args]
    mess "$cmd\n"
    if [catch $cmd res] {
        mess $res\n red
        busy 0
        return ""
    }
    busy 0
    return $uns_cur
}

proc ic_uns_splitoutline {p0 p1 {args .5}} {
    global uns_cur
    
    if {$uns_cur == ""} {
	mess "No mesh\n" red
	return ""
    }
    
    busy 1
    set cmd [list $uns_cur split_outline $p0 $p1 $args]
    mess "$cmd\n"
    if [catch $cmd res] {
        mess $res\n red
        busy 0
        return ""
    }
    busy 0
    return $res
}

## convert tetra volume mesh to Hexa-core mesh
proc ic_uns_convert_tet2_hexcore {{fams ""} {fill_holes 0} {refinement 1} {bbox ""} {csys global} {conformal 0} {use_tg_tri2tet 0}} {
    global uns_cur

    if [ic_wb2_input_parameter_mode] {
        ic_wb2_update_while_input_parameter_mode
        if {$fams != "" && [llength $fams] == 1 && ![ic_uns_family_match_type $fams TETRA_*]} {
            set vfams [ic_uns_list_families 3]
            if {[llength $vfams] == 1} {
                set fams $vfams
            }
        }
    }

    set stat 0	
    if {$fams == ""} {
        set fams [ic_uns_list_families 3]
    }

    ic_uns_mesher_license 0
    foreach fam $fams {
        set size [ic_geo_get_family_param $fam emax]
        if {$size == ""} {
            set size 0
        }
        set args "-minsize $size -tet2hex $fam -hexcore -cleanup"
        if {$csys != "global"} {
            append args " -csys $csys"
        }
        if {$refinement < 2} { 
            # no hanging_nodes
            append args " -uniform"
        }
        if {$refinement > 1} {
            append args " -tratio $refinement"
            append args " -lay 1"
            if $conformal {
                append args " -conformal"
            }
            if {$bbox != ""} {
                append args " -aspect_ratio 1 1 1"
            }
        }
        if {$bbox != ""} {
            append args " -bbox $bbox"
            append args " -type 3"
#           append args " -fill_holes"
        } else {
            append args " -type 2"
        }
        
        if $fill_holes {
            append args " -fill_holes"
        }
        
        if $use_tg_tri2tet {
            append args " -use_tg_tri2tet"
        }
        mess "Converting tetra volume mesh to Hexa-core mesh\n"
        if [catch {eval $uns_cur convert_tet2_hexcore $args} res] {
            mess "Error: Hexa-core mesh failed for $fam\n" red
            set stat 1
        }
    }
    ic_uns_mesher_license 1
    update_uns_visible
    $uns_cur configure -modified 1
    return $stat
}

## Write out the nodes of a subset in a simple format

proc ic_uns_write_node_list {map file {scale 1}} {
    global uns_cur

    [$uns_cur get_map $map] write_node_list $file $scale
}

## Write out the elements of a subset in a simple format

proc ic_uns_write_elem_list {map file} {
    global uns_cur

    [$uns_cur get_map $map] write_elem_list $file
}

## Read in per-element or per-node result domain data.
## The file contains 2 or more columns.  The first is the element or
## node number, and colnum selects which of the following ones gets
## loaded, starting with 1.  The name is something like Nastran:OR:X1
## and will be available as a distributed attribute in med.  If the attribute
## did not already exist it will be greated and given the specified
## default value.  If on_nodes is 1 then the numbers in the file are external
## vertex numbers and the bc values will be attached to the NODE elements on
## those vertices.  If a vertex is referenced that does not have a NODE element
## it will be skipped (for now)

proc ic_uns_import_bcfield {name file on_nodes colnum defval} {
    global uns_cur
    $uns_cur import_bcfield $name $file $on_nodes $colnum $defval
}

## Export bc values in the same format.  If on_nodes is given then the
## nodes of the given elements are written out with the values for
## those elements, and duplicated nodes are written more than once
## (possibly with different values).

proc ic_uns_export_bcfield {name file on_nodes} {
    global uns_cur
    $uns_cur export_bcfield $name $file $on_nodes
}

## Returns the volume parts 

proc ic_list_volume_families {} {
    set gfams [ic_geo_list_families 1]
    set mfams [ic_uns_list_families 3]
    set bfams [ic_hex_list_block_families]

    catch {unset fam_added} 
    set vfams ""
    foreach fam [concat $gfams $mfams $bfams] {
	if ![info exists fam_added($fam)] {
	    lappend vfams $fam
	    set  fam_added($fam) 1
	}
    }

    return $vfams
}
set dont_record_command(ic_list_volume_families) 1

## Count the number of nodes in each family.

proc ic_uns_count_nodes_in_families {fams} {
    global uns_cur
    if {$uns_cur == ""} { return 0 }
    if {$fams == ""} { return 0 }
    set sel [ic_uns_subset_create]
    ic_uns_subset_make_families $sel $fams
    ic_uns_subset_copy_verts $sel $sel
    set count [ic_uns_subset_count_nodes $sel]
    ic_uns_subset_delete $sel
    return $count
}

## Mark elements enclosed by surfaces with the material points

proc ic_uns_mark_enclosed_elements {name surfs matlpnts {only_vol 0}} {
    global uns_cur batch_mode

    if {$surfs == ""} {
        mess "Warning: selecting all surfaces for marking\n"
        set surfs [ic_geo_get_objects surface]
    }
    if {$matlpnts == ""} {
        mess "Warning: selecting all material points for marking\n"
        set matlpnts [ic_geo_get_objects material]
    }
    ic_newop
    set map [$uns_cur get_map $name]    
    set matsurfList [concat $matlpnts $surfs]
    set nmatlpnts [llength $matlpnts]
    if $only_vol {
        set ret [eval $map mark_enclosed_volume_elements $nmatlpnts $matsurfList]
    } else {
        set ret [eval $map mark_enclosed_elements $nmatlpnts $matsurfList]
    }
    mess "$ret\n"
    if !$batch_mode {
        aie_create_initial_assemblies
    }
}

proc ic_uns_mesh_to_bars { name { all_elem 1} { inherit_part 1 } { part "" }} {
    global uns_cur
    ic_newop
    if $all_elem {
        set map [$uns_cur get_map all]
    } else {
        set map [$uns_cur get_map $name]
    }
    if { !$inherit_part && ($part == "") } {
        set inherit_p 1
    } else {
        set inherit_p 0
    }
    if { $inherit_p } {
        set p "dummy"
    } else {
        set p $part
    }
    set ret [$map mesh_to_bars $inherit_p $p]
    if !$all_elem { $map delete }
    $uns_cur configure -modified 1
    update_uns_visible
    mess "$ret bar elements created\n"
}

## Returns the bounding box of the mesh
proc ic_uns_bounding_box {} {
    global uns_cur

    if {$uns_cur == ""}  {
        return ""
    }
    return [eval $uns_cur get_bbox]    
}

## Counts elements in families
proc ic_uns_count_elements_in_family {fams} {
    global uns_cur

    if ![ic_uns_is_loaded] { return 0 }
    set count 0
    foreach {f c} [$uns_cur count_in_family] {
        if {([lsearch $fams $f] > -1)} {
            incr count $c
        }
    }
    return $count
}

proc ic_uns_diag_set_degen_min {diag_name minv} {
    global uns_cur

    if {$uns_cur == ""} {return}
    set map [uns_map -mesh $uns_cur]
    $map diagnostic_set_degen_min $diag_name $minv
}

proc ic_uns_diag_set_degen_max {diag_name maxv} {
    global uns_cur

    if {$uns_cur == ""} {return}
    set map [uns_map -mesh $uns_cur]
    $map diagnostic_set_degen_max $diag_name $maxv
}

proc ic_uns_diag_reset_degen_min_max {} {
    global uns_cur

    if {$uns_cur == ""} {return}
    set map [uns_map -mesh $uns_cur]
    $map diagnostic_set_degen_max "" -1
}

proc ic_uns_move_lcs_lcs {from to name} {
    set nfrom [llength $from]
    set nto [llength $to]
    if {($nfrom != 1 && $nfrom != 3) || ($nto != 1 && $nto != 3)} {
        mess "Error: LCS -> LCS incorrect data\n" red
        return
    }
    
    set was_csys [ic_csystem_get_current]
    ic_csystem_set_current global
    
    if {$nfrom == 1} {
        if {[ic_csystem_get $from] == ""} {
            mess "Error: not defined LCS \"from\"\n" red
            ic_csystem_set_current $was_csys
            return
        }
        set p00 [ic_coords_into_global "0 0 0" $from]
        set p01 [ic_coords_into_global "1 0 0" $from]
        set p02 [ic_coords_into_global "0 1 0" $from]
    } else {
        foreach "p00 p01 p02" $from ""
    }
    if {$nto == 1} {
        if {[ic_csystem_get $to] == ""} {
            mess "Error: not defined LCS \"to\"\n" red
            ic_csystem_set_current $was_csys
            return
        }
        set p10 [ic_coords_into_global "0 0 0" $to]
        set p11 [ic_coords_into_global "1 0 0" $to]
        set p12 [ic_coords_into_global "0 1 0" $to]
    } else {
        foreach "p10 p11 p12" $to ""
    }

    # first move to origin, then rotate, finally move to target
    set translate1 [ic_vcalc diff $p00 {0 0 0}]
    set translate2 $p10
    set p01 [ic_vcalc diff $p00 $p01]
    set p02 [ic_vcalc diff $p00 $p02]
    set p00 "0 0 0"
    set p11 [ic_vcalc diff $p10 $p11]
    set p12 [ic_vcalc diff $p10 $p12]
    set p10 "0 0 0"

    set vecx1 [ic_vcalc dir $p00 $p01]
    set vecx2 [ic_vcalc dir $p10 $p11]
    set vecy1 [ic_vcalc dir $p00 $p02]
    set vecy2 [ic_vcalc dir $p10 $p12]

    set v [ic_vcalc product $vecx1 $vecy1]
    set vv [ic_vcalc product $vecx2 $vecy2]
    if {$v == "" || $vv == ""} {
        ic_mess "data error in ic_uns_move_lcs_lcs\n" red
        ic_csystem_set_current $was_csys
        return
    }

    set axs1 [ic_vcalc product $vecx2 $vecx1]
    if {$axs1 == "0 0 0"} {
        set axs1 [ic_vcalc vec_norm $vecx1]
    }
    set ang1 [ic_vcalc angle_normal $axs1 $vecx1 $vecx2]
    set xyz [ic_vcalc sum $p10 $vecy1]
    ic_delete_geometry point names tmp_pnt 0
    ic_geo_cre_pnt TMP tmp_pnt $xyz
    if {$ang1 != 0 && $ang1 != ""} {
        ic_move_geometry point names tmp_pnt rotate $ang1 cent $p10 rotate_axis $axs1
    }
    set xyz [ic_geo_get_point_location tmp_pnt]
    ic_delete_geometry point names tmp_pnt 0
    set vecx [ic_vcalc dir $p10 $xyz]
    set ang2 [ic_vcalc angle_normal $vecx2 $vecx $vecy2]
    ic_uns_move_elements $name translate $translate1
    if {$ang1 != 0} {
        ic_uns_move_elements $name rotate $ang1 rotate_axis $axs1 cent $p10
    }
    if {$ang2 != 0} {
        ic_uns_move_elements $name rotate $ang2 rotate_axis $vecx2 cent $p10
    }
    ic_uns_move_elements $name translate $translate2
    
    ic_csystem_set_current $was_csys
}

# just do lazy printing to file
proc ic_uns_print_node_locs { out_file } {
    set name [ic_uns_subset_create]
    set node_map [uns_get_subset $name]
    set extern 0

    set min_num 0
    set max_num [ic_count_nodes]

    $node_map add_nodes_by_number $min_num-$max_num $extern

    set fp [open $out_file "w"]
    foreach inf [$node_map element_info] {
        set num [lindex $inf 0]
        set pos [lindex $inf 3]
        puts $fp "$num $pos"
    }
    ic_uns_subset_delete $name
    close $fp
}

# subset name
# extern : 1 if external numbers, 0 otherwise
# out_file: if !" "" then print to file
proc ic_uns_subset_list_element_numbers {name {extern 0} {out_file ""}} {
    global uns_cur

    set map [$uns_cur get_map $name]
    if {$map == ""} { error "no such subset $name" }
    set nums [$map element_numbers $extern]
    if {$out_file != ""} {
        set fp [open $out_file "w"]
        puts $fp "$nums"
        close $fp
    }
    return $nums
}
set dont_record_command(ic_uns_subset_list_element_numbers) 1

## Creates a subset from part names.  
## verts: sdds also the vertices to the subset if true

proc ic_uns_subset_from_part {parts {verts 0}} {
    global uns_cur
    
    if {$uns_cur == ""} { return "" }
    if {$parts == ""} { return "" }
    set sub [ic_uns_create_selection_subset 0]
    ic_uns_create_selection_edgelist 1
    ic_uns_subset_configure $sub -draw_nodes 1
    ic_uns_subset_visible uns_sel_0 0
    ic_uns_subset_make_families $sub $parts
    if $verts { ic_uns_subset_copy_verts $sub $sub }
    ic_uns_uniqify $sub
    ic_uns_subset_visible $sub 0
    ic_uns_create_selection_edgelist 0
    set sub2 [ic_uns_subset_create]
    ic_uns_subset_visible $sub2 0
    ic_uns_subset_add_families_and_types $sub2 $parts [ic_uns_subset_list_types $sub]
    ic_uns_subset_add_from $sub $sub2
    ic_uns_subset_delete $sub2
    return $sub
}

## Returns the periodic parts.  Returns nothing in case that no periodic parts exist.

proc ic_uns_get_periodic_parts {} {
    global uns_cur
    
    if ![ic_uns_subset_nodes_are_periodic All] { return "" }
    set parts ""
    set volume [ic_uns_list_families 3]
    foreach p [ic_uns_list_families 2] {
        if {[lsearch $volume $p] >= 0} continue
        set sub [ic_uns_subset_from_part $p 1]
        if {$sub == ""} continue
        if [ic_uns_subset_nodes_are_periodic $sub] {
            set nums [ic_uns_count_periodic_nodes $sub]
            if {[ic_uns_count_nodes_in_families $p] == $nums} {
                lappend parts $p
            }
        }
        ic_uns_subset_delete $sub
    }
    return $parts
}
set dont_record_command(ic_uns_get_periodic_parts) 1

## Counts the periodic nodes 

proc ic_uns_count_periodic_nodes {name} {
    global uns_cur

    set map [$uns_cur get_map $name]
    if {$map == ""} { return 0 }
    set nums [$map count_periodic_nodes]
    return $nums
}
set dont_record_command(ic_uns_count_periodic_nodes) 1



