
# Grid-related commands.
#
# Copyright (c) 1993, 1994 Pacific Marketing and Consulting
# Author:  Wayne A. Christopher, wayne@pmac.com
#          Pacific Marketing and Consulting, Berkeley, California
#
# The grid stuff is kept in the following variables.
#    full_unstruct               The unstructured mesh object.
#    full_nodeset                The nodeset.
#    grid_connectivity           The connectivity object (if required).
#    full_element_set(type)      The type can be bar, quad, or hexa.
#    full_element_map(type)      The map that contains all of the elements.
#    full_group(name) Secondary domains found in the file (emaps).
#    full_element_map_image(map) Images for all the maps.
#    grid_display                1 if stuff should be displayed.
#    grid_dtype(type)            1 if the specified type should be displayed.
#    grid_nodenums               1 if node numbers should be displayed.
#    grid_elemnums               1 if element numbers should be displayed.

proc edit_grid {has_mesher has_tetra has_global has_hexa has_iceboard} {
    global tdv_default
    global grid_qual grid_type want_facealign_calculation grid_histof
    global grid_display grid_qtype grid_dtype grid_nodenums grid_elemnums
    global grid_display_solid grid_display_wire grid_use_full
    global grid_exists grid_license_found
    global use_display_edges mesh_quality_explanation small_screen_hack
    global use_nonconformal_meshing grid_nb grid_exists want_grid_export_tab
    global grid_type_specific grid_mesher_params

    if [info exists grid_qual] {
	switch $grid_qual {
	    determinant { set grid_qual det_aspect }
	    aspect { set grid_qual det_aspect }
	}
    }

    if {$grid_type == ""} {
	if $has_mesher {
	    set grid_type auto
	} elseif $has_tetra {
	    set grid_type tetra
	} elseif $has_global {
	    set grid_type global
	} elseif $has_hexa {
	    set grid_type hexa
	} elseif $has_iceboard {
	    set grid_type iceboard
	}
    }
    switch $grid_type {
	auto {
	    if $grid_mesher_params(cartesian) {
		set grid_type_specific hexa_cart
	    } else {
		set grid_type_specific hexa_uns
	    }
	}
	tetra {
	    set grid_type_specific tetra
	}
	global {
	    set grid_type_specific global
	}
	hexa {
	    set grid_type_specific hexa_pipe
	}
	hexa {
	    set grid_type_specific iceboard
	}
    }

    set_planecut_units 0
    
    if {[info command app_special_grid_setup] != ""} {
	app_special_grid_setup
    }
    
    set d [form_init .grid "Mesh control" "" {{Close grid_form_done} help} \
	       {grid_generate full}]

    if {$d != ""} {
	foreach v {
	    grid_display grid_qtype grid_dtype grid_nodenums grid_elemnums
	    grid_display_solid grid_display_wire grid_use_full
	} {
	    trace variable $v w "grid_update_images 0; list"
	}
	foreach v {bar quad hexa tri penta quality} {
	    trace variable grid_dtype($v) w "grid_update_images 0; list"
	}

	form_frame $d.top flat 0 {0 0 -sticky ew}

	form_label $d.top.totl "Num elements:" {1 0}
	form_label $d.top.tot "" {1 1 -sticky ew}
	$d.top.tot configure -textvariable grid_elemcount -width 10

	form_label $d.top.totnl "Num nodes:" {1 2}
	form_label $d.top.totn "" {1 3 -sticky ew}
	$d.top.totn configure -textvariable grid_nodecount -width 10

	set pagedata {
	    { generate Generate }
	    { display Display }
	    { quality Quality }
	}
	if [info exists want_grid_export_tab] {
	    lappend pagedata { export Export }
	}

	set grid_nb $d.nb
	set pages [form_notebook $d.nb $pagedata {2 0}]

	if $grid_exists { set state normal } else { set state disabled }
	$grid_nb itemconfigure display -state $state
	$grid_nb itemconfigure quality -state $state
	if [info exists want_grid_export_tab] {
	    $grid_nb itemconfigure export -state $state
	}

#	form_frame $d.sub ridge 2 {2 0}

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

	set ds [lindex $pages 0]
#	set ds $d.sub.gen
#	form_choiceframe $ds

	form_frame $ds.b flat 0 {0 0}
	form_button $ds.b.load "Load mesh" {grid_reload 1 __current__ full 0} {0 0}
	form_button $ds.b.doit "Generate mesh" "grid_generate full" {0 1}
	form_button $ds.b.stop "Terminate mesher" "grid_stop_mesher" {0 2}

	form_frame $ds.typef flat 0 {1 0}
	grid_mesh_type_form $ds.typef {1 0} {1 1}

	form_label $ds.typef.ul "Mesh units" {1 2}
	futil_unitmenu $ds.typef.u "unit_get_choices length" {1 3} \
	    meshing_units "" "set_planecut_units 0; convert_grid_meshing_units_params" perobject_form_done_cmd

	form_rowheight $ds.typef 0 4
	form_rowheight $ds.typef 2 4

	form_frame $ds.genf flat 0 {2 0}

	if $has_mesher {
	    form_choiceframe $ds.genf.auto
	    if {[info command app_special_grid_form] != ""} {
		app_special_grid_form auto $ds.genf.auto
	    } else {
		edit_grid_auto $ds.genf.auto
	    }
	}
	if $has_tetra {
	    form_choiceframe $ds.genf.tetra
	    if {[info command app_special_grid_form] != ""} {
		app_special_grid_form tetra $ds.genf.tetra
	    } else {
		edit_grid_tetra $ds.genf.tetra
	    }
	}
	if $has_global {
	    form_choiceframe $ds.genf.global
	    if {[info command app_special_grid_form] != ""} {
		app_special_grid_form global $ds.genf.global
	    } else {
		edit_grid_global $ds.genf.global
	    }
	}
	if $has_hexa {
	    form_choiceframe $ds.genf.hexa
	    if {[info command app_special_grid_form] != ""} {
		app_special_grid_form hexa $ds.genf.hexa
	    } else {
		edit_grid_hexa $ds.genf.hexa
	    }
	}
	if $has_iceboard {
	    form_choiceframe $ds.genf.iceboard
	    if {[info command app_special_grid_form] != ""} {
		app_special_grid_form iceboard $ds.genf.iceboard
	    } else {
		edit_grid_iceboard $ds.genf.iceboard
	    }
	}
	futil_setup_switch $ds.genf grid_type

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

	set ds [lindex $pages 1]
#	set ds $d.sub.disp
#	form_choiceframe $ds

	set act {{grid_exists 1}}
	form_checkbutton $ds.on "Display mesh" grid_display {3 0 -cols -} $act
	form_frame $ds.how flat 0 {4 1 -cols -}
	set r -1
	if [info exists use_display_edges] {
	    form_checkbutton $ds.how.bar "Edge elements" grid_dtype(bar) \
		"[incr r] 0" $act
	}
	form_checkbutton $ds.how.quad "Surface" grid_dtype(quad) \
	    "[incr r] 0" $act
	form_checkbutton $ds.how.hexa "Volume" grid_dtype(hexa) \
	    "[incr r] 0" $act
	form_checkbutton $ds.how.wire "Wire" grid_display_wire \
	    "[incr r] 0 -cols -" $act
	form_checkbutton $ds.how.solid "Solid" grid_display_solid \
	    "[incr r] 0 -cols -" $act
	form_radiobutton $ds.how.quad1 "All objects" grid_qtype all \
	    {0 1} $act
	form_radiobutton $ds.how.quad2 "Current type" grid_qtype type \
	    {1 1} $act
	form_radiobutton $ds.how.quad3 "Selected objects" grid_qtype object \
	    {2 1} $act
	form_radiobutton $ds.how.quad4 "Selected shape" grid_qtype shape \
	    {3 1} $act

	if [info exists use_nonconformal_meshing] {
	    form_label $ds.how.ncl "Non-conformal:" {0 2 -cols 2}
	    form_checkbutton $ds.how.coup0 "Inner" grid_dtype(coup0) \
		{1 2} $act
	    form_checkbutton $ds.how.coup1 "Outer" grid_dtype(coup1) \
		{1 3} $act
	    form_checkbutton $ds.how.coupi "Between assemblies" grid_dtype(coupi) \
		{2 2 -cols 2} $act
	}

	# form_checkbutton $ds.usefull "Show non-reduced groups" grid_use_full {11 1 -cols -} $act

	form_colwidth $ds 0 2 M
	form_colwidth $ds 1 3 M

	set act3 {{grid_exists 1} {grid_cut_on 1}}
	form_checkbutton $ds.cut_on "Cut plane" grid_cut_on {19 0 -cols -} $act
	$ds.cut_on configure -command "grid_update_images 1"
	if 0 {
	    form_button $ds.cut.plus " ++ " \
		"grid_cutplane_move 1; grid_update_cutplane" {0 2} $act3
	    form_button $ds.cut.minus " -- " \
		"grid_cutplane_move -1; grid_update_cutplane" {0 3} $act3
	    form_label $ds.cut.pctl "Pct" {0 4} $act3
	    form_entry $ds.cut.pct grid_cut_incrpct float {0 5} $act3
	    bind $ds.cut.pct <Return> ""
	}

	foreach xx {
	    {spectype normz} {px 0} {py 0} {pz 0} {nx 0} {ny 0} {nz 1}
	    {a 1} {b 0} {c 0} {d 0} {color white}
	} {
	    set v temp_planecut_[lindex $xx 0]
	    global $v
	    if ![info exists $v] { set $v [lindex $xx 1] }
	}
	if ![info exists temp_planecut_pz] {
	    set bb [$tdv_default bbox interesting]
	    if {$bb != ""} {
		set temp_planecut_pz [expr {([lindex [lindex $bb 1] 2] - \
						 [lindex [lindex $bb 0] 2]) / 2.0}]
	    }
	}
	grid_form_planecut $ds.cut_edit {20 0 -cols -} $act3 \
	    "grid_update_images 1" temp_planecut_color

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

	if {$has_mesher || $has_tetra || $has_hexa} {
	    set ds [lindex $pages 2]
#	    set ds $d.sub.diag
#	    form_choiceframe $ds

	    form_frame $ds.typef flat 0 {0 0}
	    form_radiobutton $ds.typef.squl "Face alignment" grid_qual \
		facealign {0 0}
	    form_radiobutton $ds.typef.detl "Quality" grid_qual \
		det_aspect {0 1}
	    form_radiobutton $ds.typef.voll "Volume" grid_qual \
		volume {0 2}
	    $ds.typef.detl configure -command "grid_compute_quality det_aspect 1"
	    $ds.typef.squl configure -command "grid_compute_quality facealign 1"
	    $ds.typef.voll configure -command "grid_compute_quality volume 1"

	    form_label $ds.exp "" {1 0}
	    $ds.exp configure -textvariable mesh_quality_explanation
	    set mesh_quality_explanation ""
	    form_frame $ds.histof flat 0 {2 0}
	    if $small_screen_hack {
		$ds.histof configure -bg black -width 260 -height 240
	    } else {
		$ds.histof configure -bg black -width 360 -height 320
	    }
	    set grid_histof $ds.histof
	}

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

	if [info exists want_grid_export_tab] {
	    set ds [lindex $pages 3]
	    set act {{grid_exists 1}}
	    form_button $ds.exp "Export as IDEAS neutral file" \
		"grid_export_ideas" {0 0 -sticky ew -pady 4} $act
	    form_button $ds.ansys "Export as Ansys grid file" \
		"grid_export_ansys" {1 0 -sticky ew -pady 4} $act
	}

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

	form_notebook_finish $d.nb

	form_finish bot
    }
    if {[grid_set_type_$grid_type] && $has_tetra} {
        set grid_type_specific tetra
        grid_update_type_specific
    }
    #if !$grid_exists { grid_reload 0 "" }
}

proc grid_mesh_type_form {w c1 c2} {
    global mesher_path tetra_path cutter_path global_path hexa_path
    global grid_mesher_params grid_type_specific grid_type
    global want_cartesian_auto_mesher iceboard_meshing_path

    switch $grid_type {
	auto {
	    if $grid_mesher_params(cartesian) {
		set grid_type_specific hexa_cart
	    } else {
		set grid_type_specific hexa_uns
	    }
	}
	tetra {
	    set grid_type_specific tetra
	}
	global {
	    set grid_type_specific global
	}
	hexa {
	    set grid_type_specific hexa_pipe
	}
	iceboard {
	    set grid_type_specific iceboard
	}
    }

    set has_auto [expr {$mesher_path != "not_found"}]
    set has_tetra [expr {$tetra_path != "not_found"}]
    set has_global [expr {$global_path != "not_found"}]
    set has_hexa [expr {$hexa_path != "not_found"}]
    set has_iceboard [expr {$iceboard_meshing_path != "not_found"}]

    set type_opts list
    if $has_auto {
	lappend type_opts [list hexa_uns "Hexa unstructured"]
	if [info exists want_cartesian_auto_mesher] {
	    lappend type_opts [list hexa_cart "Hexa cartesian"]
	}
    }
    if $has_tetra {
	lappend type_opts [list tetra "Tetra"]
    }
    if $has_global {
	lappend type_opts [list global "Cartesian"]
    }
    if $has_hexa {
	lappend type_opts [list hexa_pipe "Hexa pipe"]
    }
    if $has_iceboard {
	lappend type_opts [list iceboard "Board"]
    }

    form_label $w.meshtl "Mesh type:" $c1
    if {[llength $type_opts] > 2} {
	futil_menuentry_labels $w.mesht grid_type_specific \
	    $type_opts $c2 "" grid_update_type_specific 16
    } else {
	form_label $w.mesht [lindex [lindex $type_opts 1] 1] $c2
    }
}

proc grid_update_type_specific {} {
    global grid_type grid_type_specific grid_mesher_params

    switch $grid_type_specific {
	hexa_cart {
	    set grid_type auto
	    set grid_mesher_params(cartesian) 1
	}
	hexa_uns {
	    set grid_type auto
	    set grid_mesher_params(cartesian) 0
	}
	tetra {
	    set grid_type tetra
	}
	global {
	    set grid_type global
	}
	hexa_pipe {
	    set grid_type hexa
	}
	iceboard {
	    set grid_type iceboard
	}
    }
    # This form needs to be recreated for the new mesh type
    form_kill .perobject_params
}

proc edit_grid_check_meshers {} {
    global mesher_path tetra_path cutter_path global_path hexa_path
    global iceboard_meshing_path

    set has_auto [expr {$mesher_path != "not_found"}]
    set has_tetra [expr {$tetra_path != "not_found"}]
    set has_global [expr {$global_path != "not_found"}]
    set has_hexa [expr {$hexa_path != "not_found"}]
    set has_iceboard [expr {$iceboard_meshing_path != "not_found"}]
    set grid_set_default_sizes 0
    grid_set_default_sizes
    edit_grid $has_auto $has_tetra $has_global $has_hexa $has_iceboard
}

proc grid_generate {{prefix full} {type ""}} {
    global grid_mapping grid_mapcount grid_total
    global grid_exists grid_display env
    global grid_mindim grid_type grid_qual want_grid_cutouts
    global grid_dtype geocheck_invalid want_facealign_calculation
    global full_unstruct mesher_path tetra_path global_path hexa_path
    global grid_save_before_generating grid_convert_multi
    global mesher_is_running tetin_do_offset_scale
    global mesher_was_terminated no_exit_job writing_ff_grid
    global errorInfo bad_face_align grid_histof grid_mesh_parts_separate
    global dont_pause_on_warnings grid_mesh_parts_separate
    global iceboard_meshing_path is_iceboard
    
    if [info exists mesher_is_running] {
	mess "Mesher already running - not starting another one.\n"
	return
    }

    catch {unset mesher_was_terminated}

    part_switch_model top

    if {$type != ""} { set grid_type $type }

    if {$grid_type == ""} {
	if {$mesher_path != "not_found"} {
	    set grid_type auto
	} elseif {$tetra_path != "not_found"} {
	    set grid_type tetra
	} elseif {$global_path != "not_found"} {
	    set grid_type global
	} elseif {$hexa_path != "not_found"} {
	    set grid_type hexa
	} elseif {$iceboard_meshing_path != "not_found"} {
	    set grid_type iceboard
	}
    }

    if {[info command app_special_grid_setup] != ""} {
	if ![app_special_grid_setup] return
    }

    if {(($grid_type == "auto") || ($grid_type == "iceboard")) && [has_non_standard_shapes 0 ""]} {
	user_error "You can't use the auto or board mesher for this model, since there are some CAD-based shapes that require either the tetra or Cartesian meshers."
	return
    }
    
#    if {($grid_type != "auto") && $grid_mesh_parts_separate && !$is_iceboard} {
#	#mess "Warning: disabling \"Mesh separately\" for $grid_type meshing.\n" red
#	set grid_mesh_parts_separate 0
#    }

    interrupt begin "Generating grid" "Saving mesh" 1.0 grid_stop_mesher

    if [info exists grid_save_before_generating] { file_save 0 }
    
    #file_auto_save
    
    busy 1
    
    if [interrupt update 0.1 "Checking model"] { busy 0; return 0 }
    
    if [model_check 0 1] {
	if ![info exists dont_pause_on_warnings] {
	    if ![tk_dialog .check_problems Problems "Some problems were found - see the message window below.  It is recommended that you cancel meshing and fix them before continuing." "" -1 \
		     "Don't mesh" "Go ahead anyway"] {
			 busy 0
			 interrupt finish
			 return 0
		     }
	}
    }
    
    # First, get rid of the old stuff.
    if [info exists grid_display] {
	set odisp $grid_display
    } else {
	set odisp 0
    }
    
    grid_clear $prefix
    
    set mdir [directory mesh]
    set ddir [directory mesh]
    
    if ![file exists $ddir] { cmd_mkdir $ddir }
    
    # This is just so that we don't get confused when we load the
    # thing in again.
    cmd_rm $mdir/grid_mapping
    cmd_rm $mdir/mesh_timestamp
    
    set gfile $mdir/grid_input
    set mfile $ddir/grid_output
    set pfile $mdir/grid_params
    set efile $mdir/grid_errors
    set mapfile $mdir/grid_mapping
    
    set del_parts 0
    
    if {$prefix == "full"} {
	set xx [grid_which_mesh_separate]
	set mesh_sep [lindex $xx 0]
	set suffices [lindex $xx 1]
	set inc_others [lindex $xx 2]
	if {[lindex $xx 3] != ""} { set del_parts 1 }
    } else {
	set mesh_sep ""
	set suffices ""
	set inc_others ""
    }
    
    grid_set_default_sizes
    
    # Note that this has to be done before the cutouts are created
    foreach p [concat {""} $mesh_sep] {
	foreach dir {x y z} {
	    if ![grid_warn_roundoff $p $dir] { return 0 }
	}
    }
    
    if [info exists want_grid_cutouts] { grid_locate_cutouts }
    busy 0
    
    if {$mesh_sep != ""} { set mm "main mesh" } else { set mm mesh }
    if [interrupt update 0.2 "Creating $mm"] { return 0 }
    
    mess "Computing mesh\n"
    #grid_reset_params
    set mesher_is_running 1
    
    if ![grid_runonce $grid_type $gfile $mfile $efile $pfile $mapfile "" "" 0] {
	return 0
    }
    
    if {$mesh_sep != ""} {
	set nms [llength $mesh_sep]
	set n 0
	foreach ms $mesh_sep suff $suffices inc_o $inc_others {
	    set pct [expr 0.4 + 0.1 * $n / ($nms + 0.0)]
	    if [interrupt update $pct "Meshing part [$ms getval name]"] {
		return 0
	    }
	    if ![grid_runonce $grid_type $gfile $mfile $efile $pfile \
		     $mapfile $ms $suff $inc_o] {
			 return 0
		     }
	    incr n
	}
	
    }
    
    if [interrupt update 0.6 "Loading mesh file"] {
	catch {unset mesher_is_running}
	catch {unset tetin_do_offset_scale}
	return 0
    }
    
    if [info exists tetin_do_offset_scale] {
	# Just do this so that it can be loaded in correctly the next time
	set fp [open $mfile.matrix w]
	puts $fp $tetin_do_offset_scale
	close $fp
	unset tetin_do_offset_scale
    } else {
	cmd_rm $mfile.matrix
    }
    
    busy 1
    if ![grid_reload 1 "" $prefix] {
	catch {unset mesher_is_running}
	interrupt finish
	busy 0
	return 0
    }
    set fp [open [directory mesh]/mesh_timestamp w]
    puts $fp [abs_time_string]
    close $fp
    
    interrupt finish
    set grid_display $odisp
    busy 0
    
    if $del_parts {
	foreach p $mesh_sep {
	    $p delete
	}
    }
    
    if {![info exists writing_ff_grid] && 
	[info command app_after_grid_generate] != ""} {
	app_after_grid_generate
    }
    
    if {($grid_type == "auto") && $grid_convert_multi} {
	grid_convert_multiblock
    }
    
    mess "Done.\n"
    
    catch {unset mesher_is_running }
    return 1
}

proc grid_runonce {grid_type gfile mfile efile pfile mapfile \
		       do_part suff inc_others} {
    global mesher_is_running errorInfo tetin_do_offset_scale grid_mesher_params
    global grid_different_subgrid
    
    if {$do_part != ""} {
	foreach i {g m e p map} { append ${i}file $suff }
	
	if $grid_different_subgrid {
	    set gt [$do_part getval grid_type]
	    if {$gt != ""} { set grid_type $gt }
	}
    }
    switch $grid_type {
	hexa_cart {
	    set grid_type auto
	    set grid_mesher_params(cartesian) 1
	}
	hexa_uns {
	    set grid_type auto
	    set grid_mesher_params(cartesian) 0
	}
    }
    set cmd [list grid_runonce_$grid_type $gfile $mfile $efile \
		 $pfile $mapfile $do_part $suff $inc_others]
    if [catch $cmd res] {
	set ei $errorInfo
	catch {unset mesher_is_running}
	catch {unset tetin_do_offset_scale}
	error $ei
    }
    if !$res {
	catch {unset mesher_is_running}
	catch {unset tetin_do_offset_scale}
	interrupt finish
	return 0
    }
    return 1
}

proc grid_which_mesh_separate {} {
    global grid_mesh_parts_separate writing_ff_grid is_iceboard
    global warned_grid_mesh_parts_separate grid_type
    
    # Figure out what the subparts are that we need to mesh.  This should give
    # us the parts in order from outer to inner which is important when we
    # are merging the meshes back together.
    set mesh_sep ""; set suffices ""; set use_o ""
    if ![info exists writing_ff_grid] {
	foreach p [db_list_all part [part_get_root]] {
	    if {[$p getval mesh_separate] && [part_num_active_objects $p]} {
		lappend mesh_sep $p
		lappend suffices .sub_[$p getval name]
		lappend use_o 1 ;# always want [$p getval mesh_sep_others]
	    }
	}
    }
    if {$grid_type == "iceboard"} {
	return {"" "" ""}
	
    } elseif {!$grid_mesh_parts_separate && [llength $mesh_sep]} {
	if ![info exists warned_grid_mesh_parts_separate] {
	    mess "Mesh assemblies separately is NOT selected in Mesh control panel. The options to mesh individual assemblies separately have been overriden by this choice.\n" red
	    set warned_grid_mesh_parts_separate 1
	}
	return {"" "" ""}
    } else {
	return [list $mesh_sep $suffices $use_o]
    }
}

proc grid_get_sizes {do_part} {
    global grid_mesher_params meshing_units
    global grid_size_h grid_usesize_h
    
    if $grid_mesher_params(ignore_globals) { return {0 0 0 0} }
    
    foreach i {sx sy sz sh} { set $i 0 }
    if $grid_usesize_h { set sh $grid_size_h }  ;# not worth making this one per-part
    
    foreach i {x y z} {
	for {set part $do_part} {$part != ""} {set part [$part get -model_container]} {
	    if {[$part getval obtype] != "part"} break
	    if ![$part getval mesh_separate] continue
	    if ![$part getval grid_usesize_$i] continue
	    set s$i [$part si_value grid_size_$i]
	    if [set s$i] break
	}
	
	global grid_size_$i grid_usesize_$i
	if {![set s$i] && [set grid_usesize_$i]} {
	    set s$i [set grid_size_$i]
	}
    }
    set ret ""
    foreach s [list $sx $sy $sz $sh] {
	lappend ret [unit_convert $s $meshing_units 0]
    }
    return $ret
}

# This routine figures out what's inside a part, what's outside, and what should be
# treated as a "flat hollow" shape.  It's called by both the auto and the tetra
# meshers.

proc grid_get_objects_inside_and_outside {for_auto_mesher do_part inc_others use_sep} {
    set objects [grid_get_object_list $for_auto_mesher $do_part $inc_others $use_sep]
    
    set outside_hollow ""
    set outside_flat ""
    set outside_otherparts ""
    set outside_otherpart_sides ""
    set side_quads ""

    if {$do_part != ""} {
	set ttol [grid_get_ttol]
	set domsh [db_get_shape $do_part]
	
	set nobjects ""
	foreach obj $objects {
	    if [part_is_ancestor $do_part $obj] {
		lappend nobjects $obj 1

	    } else {
		set sh [db_shapes $obj 0]
		# If the shape is hollow and volumetric and touches just on
		# one side (0 means it's not near at all, more than 1 means 
		# it's partially inside) then we consider it an "outside
		# hollow" object.
		# 
		# If this is another mesh-separate part then treat it similarly
		#
		# If this is a flat object then just add it to the mesh before the
		# NC walls
		if {($sh != "") && ([$sh get_volume] > 0) && \
			![catch {$sh getval volume_flag} vol] && \
			($vol == 0) && ([llength [$domsh touches_shape $sh $ttol]] == 1)} {
		    lappend outside_hollow $obj
		} elseif {([$obj getval obtype] == "part") && [$obj getval mesh_separate]} {
		    set tsh [$domsh touches_shape $sh $ttol]
		    if {[llength $tsh] == 1} {
			lappend outside_otherparts $obj
			lappend outside_otherpart_sides [expr $tsh + 1]
		    }
		} elseif {([$sh get -shtype] == "quad") && ![$sh get -thickness]} {
		    if [$domsh check_outside $sh 0] {
			lappend outside_flat $obj
		    }
		} else {
		    lappend nobjects $obj 0
		}
	    }
	}
	set objects $nobjects
	
	foreach i {0 1 2} {
	    foreach up {0 1} {
		set start [$domsh getval min]
		set end [$domsh getval max]
		
		# Also, if there is a flat object right on the
		# boundary such as a fan we could consider it outside hollow.
		# However we deal with these in a different way.  If a nc interface 
		# wall is exactly on a domain boundary then it will not be touching
		# anything on the other side so we leave it out of this list.

		if $up {
		    # *** should do this
		    # if {($real_end != "") && (abs([lindex $real_end $i] - [lindex $end $i]) < $ttol)} continue
		    set start [lreplace $start $i $i [lindex $end $i]]
		} else {
		    # *** should do this
		    # if {($real_start != "") && (abs([lindex $real_start $i] - [lindex $start $i]) < $ttol)} continue
		    set end [lreplace $end $i $i [lindex $start $i]]
		}
		set pl [lindex {yz xz xy} $i]
		set side [expr $i * 2 + $up + 1]
		
		lappend side_quads [list "[lindex {min max} $up][lindex {x y z} $i] side" \
					$pl $start $end $side]
	    }
	}
    } else {
	set nobjects ""
	foreach obj $objects { lappend nobjects $obj 1 }
	set objects $nobjects
    }
    
    return [list $objects $outside_hollow $outside_flat $outside_otherparts \
		$outside_otherpart_sides $side_quads]
}

# This routine makes the coupling information based on the mesh groups we have from the
# mesher.
# 
# For 4.1, in the whole grid, we define two zones: "inner NC interface"
# and "outer NC interface".  It's reasonably straightforward that way
# because you are guaranteed that faces from one will match with faces
# from the other.  
# 
# Say I have two assemblies touching.  For 4.2 we need to change this a
# bit since there is no inner and outer.  One way to do this would be to
# make another zone for "assembly 1 near assembly 2" and then one for
# "assembly 2 near assembly 1".  That way every pair of touching
# assemblies would get a separate pair of zones, different from the
# default inner/outer ones and different from every other pair of
# touching asms.  
#
# Also every side of every NC asm needs to have a separate inner/outer zone.  That's
# because the fluent code for building the interfaces wants them to be planar.
#
# The way the coupling stuff works is that this routine grabs the inner and outer
# zones for every NC block and moves the mesh information into a list called
# full_couplings.  This has the quads and tris written as lists of nodes, which is a 
# bit odd but it was done that way to support the possibility, which may never happen,
# of couplings being taken directly from the domain file.  Then the routine
# grid_make_coupling_data transforms this into actual grid maps again and puts them
# in full_element_map(coup0_XXX) where the XXX is different for every side of every
# block.  The corresponding outside elements are in full_element_map(coup1_XXX)

proc grid_make_couplings_from_separate_meshes {outer_numbers} {
    global grid_mapping full_group full_couplings full_nodeset
    global grid_coupling_otherpart_group
    
    foreach g [array names grid_coupling_otherpart_group] {
	set otherpart_group($grid_coupling_otherpart_group($g)) 1
    }
    
    set verbose 0
    
    set maxnode [$full_nodeset get -numnodes]

    array set outer_number $outer_numbers
    
    set msep [grid_which_mesh_separate]
    foreach part [lindex $msep 0] suff [lindex $msep 1] {
	if {![info exists grid_mapping($part)] || \
		![info exists outer_number($suff)]} {
	    error "missing something: suff is $suff outer_numbers are $outer_numbers"
	}
	set in_num $grid_mapping($part)
	set out_num $outer_number($suff)
	
	if $verbose {
	    puts "in_num $in_num out_num $out_num"
	    if [info exists full_group] { parray full_group }
	}
	
	set some_left 0
	foreach side {1 2 3 4 5 6} {  ;# for now assume it's a hexa
	    if $verbose {
		puts "info exists \"full_group($out_num $side)\""
		puts "info exists \"full_group($in_num $side)\""
	    }
	    if {[info exists "full_group($out_num $side)"] && \
		    [info exists "full_group($in_num $side)"]} {
		set outm [set "full_group($out_num $side)"]
		set inm [set "full_group($in_num $side)"]
		if {[info exists otherpart_group($inm)] ||
		    [info exists otherpart_group($outm)]} {
		    continue
		}
		#puts "INM $inm [$inm count] full_group($in_num $side)"
		#puts "OUTM $outm [$outm count] full_group($out_num $side)"
		set side1 [$outm list_element_nodes]
		set side2 [$inm list_element_nodes]
		
		lappend full_couplings [list $part $in_num $out_num $side $side1 $side2]
		
		$inm delete; $outm delete
		unset "full_group($out_num $side)"
		unset "full_group($in_num $side)"
		if $verbose { puts "ok $side" }
		
	    } elseif {[info exists "full_group($out_num $side)"]} {
		# these are on the boundary ...
		set "full_group($in_num $side)" [set "full_group($out_num $side)"]
		set some_left 1
		if $verbose {
		    puts "only_out $side"
		    puts "part 2 : shifted full_group($out_num $side) to full_group($in_num $side)"
		}
		
	    } elseif {[info exists "full_group($in_num $side)"]} {
		# these are on the boundary ...
		set "full_group($out_num $side)" [set "full_group($in_num $side)"]
		set some_left 1
		if $verbose {
		    puts "only_in $side"
		    puts "part 3 : shifted full_group($in_num $side) to full_group($out_num $side)"
		} 
	    }
	}
	if !$some_left {
	    unset grid_mapping($part)
	} else {
	    set grid_mapping($out_num) $part
	}
    }
}

proc grid_stop_mesher {} {
    global run_background_pid mesher_was_terminated mesher_is_running
    
    set mesher_was_terminated 1
    if [info exists run_background_pid] {
	cmd_kill $run_background_pid
    }
    catch {unset mesher_is_running}
}

proc grid_write_mapping {mapfile suff} {
    global grid_mapping grid_coupling_walls grid_coupling_cutouts grid_coupling_otherparts
    
    #puts [list grid_write_mapping $mapfile $suff]
    
    if ![info exists grid_mapping] return
    
    set fp [open $mapfile w]
    
    foreach xx [array names grid_mapping] {
	if {([llength $xx] == 1) || ([lindex $xx 1] == "junk")} continue
	set obj [lindex $xx 0]
	set part [lrange $xx 1 end]
	if {$obj != ""} {
	    puts $fp "[$obj getval obtype] \{[$obj getval name]\} \{$part\}\
		$grid_mapping($xx)"
	} else {
	    puts $fp "cutout cutout cutout $grid_mapping($xx)"
	}
    }
    if [info exists grid_coupling_walls($suff)] {
	puts $fp "coupling_walls $grid_coupling_walls($suff)"
    }
    if [info exists grid_coupling_cutouts($suff)] {
	puts $fp "coupling_cutouts $grid_coupling_cutouts($suff)"
    }
    if [info exists grid_coupling_otherparts($suff)] {
	puts $fp "coupling_otherparts $grid_coupling_otherparts($suff)"
    }
    close $fp
}

proc grid_object_description {num} {
    global grid_mapping type_name domain
    
    if ![info exists grid_mapping($num)] {
	return "object unknown"
    } else {
	set obj [lindex $grid_mapping($num) 0]
	if {$obj == $domain} {
	    return $type_name(domain)
	} else {
	    return "[$obj getval obtype] \"[$obj getval name]\""
	}
    }
}

proc grid_warn_roundoff {part dir} {
    global warn_if_roundoff_more_than already_warned_tol
    global domain smallest_feature smallest_feature_desc
    global dont_pause_on_warnings batch_mode grid_sep_x_units
    global grid_accept_all_minval_changes
    
    set warn_if_roundoff_more_than($part,$dir) -1

    if ![info exists smallest_feature($part,$dir)] { return 1 }
    
    set ttol [grid_get_ttol $part $dir]
    set ttolu [grid_get_ttol_units $part $dir]
    set ttol_with_u "[unit_convert $ttol $ttolu 1] $ttolu"
    
    if ![info exists already_warned_tol($part,$dir)] {
	set short [[$domain getval body_shape] getval shortest]

	if {$part != ""} {
	    set inmodel "in \"[$part getval name]\""
	} else {
	    set inmodel "in the model"
	}
	
	set feat_mess ""; set allow_go 1
	set smfu [unit_convert $smallest_feature($part,$dir) $ttolu 1]
	if {($smallest_feature($part,$dir) > 0) && ($ttol > $smallest_feature($part,$dir) / 2.0)} {
	    set feat_mess "Your minimum gap in $dir\
		($ttol_with_u) is\
		more than half the smallest size object $inmodel\
		($smallest_feature_desc($part,$dir), $smfu $ttolu).  This will cause a bad mesh to be\
		generated.  Please decrease the separation\
 		value (on the Generate mesh form) or select \"Change value and mesh\"."
	    set allow_go 0
	    
	} elseif {($smallest_feature($part,$dir) > 0) &&
		      ($ttol > $smallest_feature($part,$dir) / 10.0)} {
	    set feat_mess "Warning: your minimum gap in $dir\
		($ttol_with_u) is\
		more than 10% of the smallest size object $inmodel\
		($smallest_feature_desc($part,$dir), $smfu $ttolu).  This may cause the volume mesh of\
                certain objects to be significantly different from\
                their geometry - please\
		verify that this is okay, or decrease the separation\
 		value (on the Generate mesh form) or select \"Change value and mesh\"."
	    
	} elseif {$ttol < $short / 1000000.0} {
	    set feat_mess "Your minimum object separation value \
		($ttol $ttolu) is too small.  It is\
		recommended that you make it larger."
	}
	
	if {$feat_mess != ""} {
	    if $grid_accept_all_minval_changes {
		mess $feat_mess\n
		mess "(Automatically selecting \"Change value and mesh\").\n"
		set res 1
	    } elseif {[info exists dont_pause_on_warnings] || $batch_mode} {
		mess "$feat_mess\nGoing ahead anyway without changing any values since trials are being run.\n" red
		if $allow_go {
		    set res 2
		} else {
		    set res 1
		}
	    } else {
		set dt "Minimum separation in $dir"
		if {$part != ""} {
		    append dt " for assembly \"[$part getval name]\""
		}
		if $allow_go {
		    set res [tk_dialog .too_small $dt $feat_mess \
				 "" -1 "Don't mesh" "Change value and mesh" \
				 "Continue, don't change"]
		} else {
		    set res [tk_dialog .too_small $dt $feat_mess \
				 "" -1 "Don't mesh" "Change value and mesh"]
		}
	    }
	    switch $res {
		0 { return 0 }
		1 {
		    # deal with roundoff error here ...
		    set ttol [expr $smallest_feature($part,$dir) / 10.0]
		    set sepvals [grid_get_sepvals $part]
		    set ind [lsearch {x y z} $dir]
		    set val [lindex $sepvals $ind]
		    set valpart [lindex $sepvals [expr $ind + 3]]
		    if {$val > $ttol} {
			if {$valpart == ""} {
			    global grid_sep_$dir grid_sep_${dir}_units
			    set u [set grid_sep_${dir}_units]
			    set grid_sep_$dir [unit_convert $ttol $u 1]
			    mess "Set $dir minimum object separation to $ttol $u\n"
			} else {
			    $valpart setval grid_sep_$dir $ttol
			    mess "Set $dir minimum object separation for \"[$part getval name]\" to [$part get_value_with_units grid_sep_$dir]\n"
			}
		    }
		    db_dirty model_no_invalidate ;# would cause problems
		}
		2 {
		    set already_warned_tol($part,$dir) 1
		    set warn_if_roundoff_more_than($part,$dir) [expr $smallest_feature($part,$dir) / 10.01]
		}
	    }
	}
    }
    return 1
}

proc grid_reload {{force 0} {prefix ""} {full full} {check_qual 1}} {
    global grid_mapping grid_exists grid_type
    global ${full}_unstruct grid_mapcount ${full}_nodeset
    global ${full}_element_set
    global ${full}_group grid_current_prefix bad_face_align grid_histof
    global grid_elemcount grid_nodecount reduced_group okay_if_no_mesh_exists

    if {$prefix == "__current__"} {
	global solve_id fpp
	if {[info exists fpp] && ($solve_id != "")} {
	    set prefix $solve_id.
	} else {
	    set prefix ""
	}
    }
    
    set mesh [directory mesh]/${prefix}grid_output
    set mapping [directory mesh]/${prefix}grid_mapping
    set pfile [directory mesh]/${prefix}grid_params
    set times [directory mesh]/mesh_timestamp
    
    if {[file exists $times] && ![should_reload_grid]} {
	if $force {
	    mess "Warning: the model has been modified since the grid was\
		generated -- loading anyway\n" red
	} else {
	    mess "Warning: the model has been modified since the grid was\
		generated -- not reloading\n" red
	    return 0
	}
    }
    
    if [file exists $mesh.gz] {
	mess "Please wait: uncompressing mesh data ...\n"
	busy 1
	cmd_gzip -d $mesh.gz
	busy 0
    }
    
    if [file exists $mapping.gz] {
	mess "Please wait: uncompressing mesh mapping data ...\n"
	busy 1
	cmd_gzip -d $mapping.gz
	busy 0
    }
    
    if {![file exists $mesh] && ![file exists $mapping]} {
	puts "Neither $mesh nor $mapping was found"
	return 0
    }
    if {![file exists $mesh] || ![file exists $mapping]} {
	mess "Warning: only partial mesh data available -- not reloading\n" red
	return 0
    }
    
    vmess "Loading mesh information ...\n"
    
    grid_clear ${full}
    
    set grid_current_prefix $prefix
    
    if {($prefix == "") && ($full == "full")} {
	# This is the initial grid generation step so we need to load all the
	# submeshes
	set xx [grid_which_mesh_separate]
	set mesh_sep [lindex $xx 0]
	set suffices [lindex $xx 1]
    } else {
	# This is loading in a grid that was written out before postprocessing
	# and all the submeshes have already been combined
	set mesh_sep ""; set suffices ""
    }
    
    catch {unset grid_mapping}
    set grid_mapcount 0
    set map_to [list [grid_load_mapping $mapping 0 ""]]
    foreach suff $suffices {
	incr grid_mapcount
	if ![file exists $mapping$suff] {
	    mess "Warning: only partial mesh data available -- not reloading\n" red
	    return 0
	}
	lappend map_to [grid_load_mapping $mapping$suff $grid_mapcount $suff]
    }
    
    #parray grid_mapping
    #puts "grid_load_domain $mesh $full \{$suffices\} \{$map_to\}"
    
    #set fp [open MAPTO w]
    #puts $fp $map_to
    #close $fp
    
    set aa [tdv_active 0]
    set stat [grid_load_domain $mesh $full $suffices $map_to]
    tdv_active $aa
    if !$stat { return 0 }
    
    vmess "Done.\n"    
    
    if {$full == "full"} {
	if {$grid_type == "auto"} {
	    foreach s [concat [list ""] $suffices] mapt $map_to {
		if [file exists $pfile$s] {
		    grid_load_params $pfile$s 0 $mapt
		}
	    }
	}
	
	if 0 {
	    # Just do a check here .....  Group 0 0 is the fluid and it might be
	    # getting thrown out because we have a non-meshed domain, so don't 
	    # complain.
	    foreach group [array names ${full}_group] {
		set gg [lindex $group 0]
		if {([scan $gg %d foo] == 1) && ![info exists grid_mapping($gg)] &&
		    ($gg != "0 0")} {
		    mess "Internal warning: group $group found in mesh file,\
		but not in mapping!\n" red
		}
	    }
	}
	
	if ![reduce_mesh_groups full reduced] {
	    mess "Error: the model has problems which will not allow the\
			solver to run - please correct them.\n" red 
	    grid_clear full
	    return 0
	}
	
	# This makes all the surfaces point inward towards the fluid (or
	# otherwise consistently
	ensure_correct_surface_orientation
	
	set grid_elemcount 0
	foreach t {hexa tetra pyra penta} {
	    if [info exists full_element_set($t)] {
		incr grid_elemcount [$full_element_set($t) get -num]
	    }
	}
	set grid_nodecount [$full_nodeset get -numnodes]
	
	[set ${full}_unstruct] fix_inverted_elements
	
	if {$check_qual && ($prefix == "") && ($grid_type != "global")} {
	    # Check the determinants...
	    
	    set grid_qual facealign
	    set qual [grid_compute_quality facealign 1]
	    if {$qual < $bad_face_align} {
		mess "Warning: the worst face alignment in this mesh is $qual.  The bad elements are shown on the screen.  This may cause problems for the solver - please try to fix the mesh if possible before running a solution.\n"
		set odisp 1
		if {[info exists grid_histof] && [winfo exists $grid_histof]} {
		    grid_qualmap 1
		    histo_click_on_range $grid_histof -1 $bad_face_align
		}
	    }
	}
	
	# Finally check all the 2-d elements and warn about those which don't
	# have any mesh.
	# Also warn about 3d objects that have no mesh.
	foreach rg [array names reduced_group] {
	    set foundg([lindex $rg 0]) 1
	}
	foreach sh [array names grid_mapping] {
	    if ![string match shape_* $sh] continue
	    if {[$sh get -shtype] == "none"} continue
	    if {[$sh get_volume] && ![catch {$sh get -volume_flag} vf] && !$vf} continue
	    set obj [$sh get -object]
	    if {[$obj getval obtype] == "part"} continue
	    
	    set ok 0
	    foreach num $grid_mapping($sh) {
		if [info exists foundg($num)] { set ok 1 }
	    }
	    if !$ok {
		if ![info exists okay_if_no_mesh_exists([$obj getval obtype],[$sh get -name])] {
		    mess "Warning: no mesh exists for [$obj getval name] [$sh get -name]\n" red
		}
	    }
	}
    }
    return 1
}

proc grid_load_mapping {mapping offset suff} {
    global grid_mapping grid_mapcount grid_coupling_walls grid_coupling_cutouts
    global grid_coupling_otherparts
    
    set map_to ""

    set fp [open $mapping r]
    while {![eof $fp]} {
	set line [gets $fp]

	set type [lindex $line 0]
	set name [lindex $line 1]
	set part [lindex $line 2]
	set nums [lrange $line 3 end]
	
	switch $type {
	    cutout {
		foreach num $nums {
		    set num2 [expr $num + $offset]
		    lappend map_to $num $num2
		    set grid_mapping($num2) ""
		    if {$num2 > $grid_mapcount} { set grid_mapcount $num2 }
		}
		continue
	    }
	    coupling_walls {
		set grid_coupling_walls($suff) [lrange $line 1 end]
		foreach {n1 n2 n3} $grid_coupling_walls($suff) {
		    #lappend map_to $n2 $n2
		}
		continue
	    }
	
	    coupling_cutouts {
		set grid_coupling_cutouts($suff) [lrange $line 1 end]
		continue
	    }
	    
	    coupling_otherparts {
		set grid_coupling_otherparts($suff) [lrange $line 1 end]
		continue
	    }
	}
	
	if {[llength $line] < 4} continue
	
	set obj [db_get_name $name]
	
	if {$obj == ""} {
	    mess "Warning: mesh information seems to be out of date --\
		can't find $type with name \"$name\" -- skipping.\n"
	    continue
	}
	
	set sh [$obj getval ${part}_shape]
	
	set key "$obj $part"
	if ![info exists grid_mapping($key)] {
	    set grid_mapping($key) ""
	}
	
	foreach num $nums {
	    # **** if we take out the domain check then this will include the
	    # **** boundaries of the NC interface, where they touch the borders,
	    # **** with the overall domain.  This should be done.
	    if {([$obj getval obtype] != "domain") && ($sh != "") &&
		[info exists grid_mapping($sh)]} {
		# This means that we already loaded up this shape from a
		# previous run and we had better share the mapping since
		# we have an intersecting sub-mesh
		set num2 [lindex $grid_mapping($sh) 0]
		set add 0
		#puts "already have [$obj getval name], setting num2 = $num2"
	    } else {
		set num2 [expr $num + $offset]
		set add 1
		#puts "don't have [$obj getval name], setting num2 = $num2"
	    }
	    lappend map_to $num $num2
	    set grid_mapping($num2) $key
	    if $add {
		lappend grid_mapping($obj) $num2
		lappend grid_mapping($sh) $num2
		lappend grid_mapping($key) $num2
	    }
	    
	    if {$num2 > $grid_mapcount} { set grid_mapcount $num2 }
	}
    }
    close $fp
    #puts "map_to $map_to"
    return $map_to
}

proc grid_load_domain {file prefix suffices map_tos} {
    global grid_exists ${prefix}_element_set ${prefix}_element_map
    global grid_elemcount grid_nodecount ${prefix}_unstruct ${prefix}_group
    global grid_mapping grid_type grid_conformal_changes
    global domain domain_family_pid full_couplings tetin_all_shapes
    
    set noisy 1
    
    catch {unset grid_conformal_changes}
    grid_invalidate_connectivity
    set outer_numbers "" ;# the mapping between suffices and the outer objects for them
    foreach suff [concat [list ""] $suffices] map_to $map_tos {
	if {$suff != ""} {
	    mess "    sub-mesh [string range $suff 1 end]\n"
	}
	
	# This is needed so that we can classify the created materials
	# appropriately 
	if {$suff == ""} {
	    set tetin_all_shapes [lindex [write_tetin_find_objects 1 "" 0 "" 1] 0]
	    
	} else {
	    set this_part [db_get_name [string range $suff 5 end]]
	    set tetin_all_shapes [lindex [write_tetin_find_objects 1 $this_part 1 $suff 1] 0] ;# should inc_others be 1??
	}
	
	if ![load_domain $file$suff $prefix $suff $map_to] { return 0 }
	
	if 0 {
	if {$suff != ""} {
	    set cont [db_get_name [string range $suff 5 end]]
	    lappend outer_numbers $suff $grid_mapping([$cont getval body_shape])
	}
	}
	if 1 {
	foreach {n1 n2} $map_to {
	    if 0 {
	    if [info exists grid_mapping($n2)] {
		set mm $grid_mapping($n2)
		if {([llength $mm] == 2) && \
			([[lindex $mm 0] getval obtype] == "domain")} {
		    lappend outer_numbers $suff $n2
		}
	    }
	    }
	    if !$n1 { lappend outer_numbers $suff $n2 }
	}
	}
	#puts "OUTER NUMBERS = $outer_numbers"
	#puts "MAP_TO = $map_tos"
    }
    
    set domtype [[db_get_shape $domain] get -shtype]
    
    switch $grid_type {
	tetra - global - iceboard {
	    if 0 {
		this is no longer needed becuase we don't write ORFN regions like that
	    # Now make this domain look like a regular autohex mesh.  First
	    # delete all the volume elements with pid 0.
	    foreach t {hexa pyra penta tetra} {
		if [info exists ${prefix}_element_set($t)] {
		    set n [[set ${prefix}_element_set($t)] delete_with_pid 0 -1]
		    if $n { puts "$n ${t}s with 0 pid deleted" }
		}
	    }
	}
	}
	iceboard__unused {
	    # Now make this domain look like a regular autohex mesh.  First
	    # delete all the volume elements with pid 0.
	    foreach t {hexa pyra penta tetra} {
		if [info exists ${prefix}_element_set($t)] {
		    set n [[set ${prefix}_element_set($t)] delete_with_pid 0 -1]
		    if $n { puts "$n ${t}s with 0 pid deleted" }
		}
	    }
	    set maxobj 0
	    foreach name [array names domain_family_pid] {
		set pid $domain_family_pid($name)
		
		if {[string index $name 0] != "_"} continue
		if ![string compare $name __JUNK__] continue
		
		set xx [split $name _]
		set obnum [lindex $xx 1]
		set sidenum [lindex $xx 2]
		set map [element_map -mesh [set ${prefix}_unstruct]]
		$map add_pid $pid NULL
		$map convert_ranges_to_lists
		set "step1($obnum $sidenum)" $map
		if {$maxobj < $obnum} { set maxobj $obnum }
	    }
	    for xx in [array names step1] {
		set n [expr $maxnum - [lindex $xx 0] + 1]
		set "${prefix}_group($n [lindex $xx 1])" $step1($xx)
	    }
	}
	hexa {
	    set map [element_map -mesh [set ${prefix}_unstruct]]
	    $map add_pid 1 NULL
	    $map convert_ranges_to_lists
	    set "${prefix}_group(1 0)" $map
	    
	    set map [element_map -mesh [set ${prefix}_unstruct]]
	    $map add_pid 4 NULL
	    $map convert_ranges_to_lists
	    set "${prefix}_group(1 1)" $map
	    
	    catch {unset grid_mapping}
	    set pobj [lindex [db_list_objects pipe] 0]
	    set grid_mapping(0) "$domain body"
	    set grid_mapping(1) "$pobj body"
	    set "grid_mapping($domain)" 0
	    set "grid_mapping($domain body)" 0
	    set "grid_mapping($pobj)" 1
	    set "grid_mapping($pobj body)" 1
	}
	auto { }
    }
    
    # Now make up coupling records for the outer boundaries of the 
    # separately meshed parts.

    if {$suffices != ""} {
	#puts [list grid_make_couplings_from_separate_meshes $outer_numbers]
	grid_make_couplings_from_separate_meshes $outer_numbers
    }
    
    # This is for iceboard
    if [info exists domain_family_pid(PCB_MIDPLANE_SIDE_NEG)] {
	set mapn [element_map -mesh [set ${prefix}_unstruct]]
	$mapn add_pid $domain_family_pid(PCB_MIDPLANE_SIDE_NEG) NULL
	$mapn convert_ranges_to_lists
	
	set mapp [element_map -mesh [set ${prefix}_unstruct]]
	$mapp add_pid $domain_family_pid(PCB_MIDPLANE_SIDE_POS) NULL
	$mapp convert_ranges_to_lists
	
	mess "Non-conformal interfaces: [$mapn count] bottom,  [$mapp count] top\n"
	
	set side1 [$mapn list_element_nodes]
	set side2 [$mapp list_element_nodes]
	set full_couplings [list [list "" 0 0 0 $side1 $side2]]
	$mapn delete
	$mapp delete
    }
        
    if {$domtype == "none"} {
	foreach key [array names full_group] {
	    if ![lindex $key 0] {
		$full_group($key) delete_elements
		$full_group($key) clear
		#$full_group($key) delete
		#unset full_group($key)
	    }
	}
	if 0 {
	    # If we are loading a tetra mesh we need to delete the ORFN regions
	    # Note that when reading auto_mesher domains we reset all 0 pids to 1
	    # so they won't be seen here
	    foreach t {hexa pyra penta tetra} {
		if [info exists ${prefix}_element_set($t)] {
		    set n [[set ${prefix}_element_set($t)] delete_with_pid 0 -1]
		}
	    }
	}
    }
    
    set maps ""
    foreach i [array names ${prefix}_element_map] {
	lappend maps [set ${prefix}_element_map($i)]
    }
    foreach t {quad tri} {
	if [info exists ${prefix}_element_set($t)] {
	    set n [eval [set ${prefix}_element_set($t)] merge_duplicates $maps]
	}
    }
    if [info exists ${prefix}_element_set(bar)] {
	set n [[set ${prefix}_element_set(bar)] delete_with_pid 0 -1]
    }
    
    # We set the start number of each volume element set to be what it is
    # inside of fidap, for post-processing.  Thus startno begins at 1.
    set n 1
    foreach vol {hexa penta tetra} {
	if [info exists ${prefix}_element_set($vol)] {
	    set s [set ${prefix}_element_set($vol)]
	    $s configure -startno $n
	    incr n [$s get -num]
	}
    }
    
    if {$prefix == "full"} {
	grid_set_exists 1
	db_dirty off_mesh
    }
    
    return 1
}

proc grid_set_exists {on} {
    global grid_exists grid_nb want_grid_export_tab
    
    set grid_exists $on
    if $on { set state normal } else { set state disabled }
    if {[info exists grid_nb] && [winfo exists $grid_nb]} {
	$grid_nb itemconfigure display -state $state
	$grid_nb itemconfigure quality -state $state
	if [info exists want_grid_export_tab] {
	    $grid_nb itemconfigure export -state $state
	}
	if !$on { $grid_nb raise generate }
    }
}

proc en_comp_function {en1 en2} {
    if {[string match EN* $en1] && [string match EN* $en2]} {
	return [expr {[string range $en1 2 end] - [string range $en2 2 end]}]
    } else {
	return [string compare $en1 $en2]
    }
}

proc edit_grid_debug {} {
    global tdv_default
    global grid_solver_group grid_solver_group_image grid_solver_group_on
    global entity_to_map full_element_map full_element_map_image
    global full_unstruct env
    global grid_elemnums grid_nodenums
    
    set d [form_init .grid_debug "Debugging functions" "mesh sub"]
    if {$d != ""} {
	if [info exists env(ICEPAK_PMAC_DEBUG)] {
	    form_checkbutton $d.useg "Use mesher graphics" grid_usegraphics \
		{0 0 -cols 2}
	    form_checkbutton $d.editf "Edit grid input" grid_editinput \
		{1 0 -cols 2}
	}
	form_checkbutton $d.remtemp "Don't remove old temp files" \
	    grid_dont_remove_temp {9 0 -cols 2}
	
	form_checkbutton $d.nodenums "Show node numbers" grid_nodenums \
	    {10 0 -cols 2} grid_exists
	form_checkbutton $d.elnums "Show element numbers" grid_elemnums \
	    {11 0 -cols 2} grid_exists
	form_checkbutton $d.usefull "Show full groups" grid_use_full \
	    {12 0 -cols 2} grid_exists
	
	form_button $d.oneelem "Show numbered elements" grid_one_element \
	    {20 0} grid_exists
	form_entry $d.onenum grid_one_element_number string {20 1} grid_exists
	bind $d.onenum <Return> grid_one_element
	
	form_button $d.advance "Show adjacent elements" grid_adj_elements \
	    {21 0 -cols 1} grid_exists
	form_button $d.clear "Clear" grid_clear_elements \
	    {22 0 -cols 1} grid_exists
	
	form_label $d.glabel "Fidap entities:" {0 3}
	form_frame $d.glist flat 0 {1 3 -rows 30}
    }
    
    set opts ""
    foreach en [lsort -command en_comp_function [array names entity_to_map]] {
	set map $entity_to_map($en)
	set im [element_map_im -image_client $map -color cyan -visible 0 -use_symmat 1]
	set grid_solver_group_image($en) $im
	$tdv_default add_image $im
	
	lappend opts $en
	
	if ![info exists grid_solver_group_on($en)] {
	    set grid_solver_group_on($en) 0
	} else {
	    grid_solver_group_toggle grid_solver_group_on $en w
	}
    }
    
    check_box .grid_debug.main.glist $opts 5 grid_solver_group_on 1
    .grid_debug.main.glist.list configure -width 6
    
    if {$d != ""} {
	form_finish bot
	trace variable grid_solver_group_on w grid_solver_group_toggle
	
	if [info exists full_unstruct] {
	    foreach type {selected adjacent} {
		if ![info exists full_element_map($type)] {
		    set map [element_map -mesh $full_unstruct]
		    set full_element_map($type) $map
		    set full_element_map_image($map) \
			[element_map_im -image_client $map -color green \
			     -elemnums $grid_elemnums -elemnum_offset 1 \
			     -nodenums $grid_nodenums -nodenum_offset 1 \
			     -nncolor white -encolor green -only_flag 1 -use_symmat 1]
		    $tdv_default add_image $full_element_map_image($map)
		    set grid_dtype($type) 1
		}
	    }
	}
    }
    
    form_wait .grid_debug
    foreach en [array names grid_solver_group_image] {
	$grid_solver_group_image($en) delete
    }
    catch {unset grid_solver_group_image}
}

proc grid_solver_group_toggle {var en op} {
    global grid_solver_group_image grid_solver_group_on
    global grid_elemnums grid_nodenums
    
    set on [set ${var}($en)]
    $grid_solver_group_image($en) configure -visible $on \
	-elemnums $grid_elemnums -elemnum_offset 1 \
	-nodenums $grid_nodenums -nodenum_offset 1
}

proc grid_cutplane_move {dir} {
    global temp_planecut_nx temp_planecut_ny temp_planecut_nz
    global temp_planecut_px temp_planecut_py temp_planecut_pz
    global temp_planecut_a temp_planecut_b temp_planecut_c temp_planecut_d
    global temp_planecut_spectype domain grid_cut_incrpct meshing_units
    set un $meshing_units
    
    set pt ""; set norm ""
    foreach i {x y z} {
	lappend pt [set temp_planecut_p$i]
	lappend norm [expr abs([set temp_planecut_n$i])]
    }
    
    set vec [lindex [[db_shapes $domain 0] clip_vector $pt $norm] 1]
    set dist [expr {$grid_cut_incrpct * $dir / 100.0}]

    foreach i {0 1 2} {
	set vv [unit_convert [lindex $vec $i] $un 1]
	set temp_planecut_p[lindex {x y z} $i] \
	    [expr {[lindex $pt $i] + $vv * $dist}]
    }
    set temp_planecut_spectype normx
    planecut_coeffs_from_ptnorm
    planecut_pct_from_ptnorm
}

proc grid_one_element {} {
    global full_element_map grid_one_element_number full_element_set
    
    if {![info exists full_element_map(selected)] ||
	($grid_one_element_number == "")} return
    
    #$full_element_map(selected) clear
    
    foreach nn $grid_one_element_number {
	$full_element_map(selected) add_list $full_element_set(hexa) \
	    [expr {$nn - 1}]
    }
}

proc grid_adj_elements {} {
    global full_element_map grid_one_element_number full_element_set
    
    if {![info exists full_element_map(selected)] ||
	![$full_element_map(selected) count]} return
    
    $full_element_map(selected) add_other_contents $full_element_map(adjacent)
    
    $full_element_map(adjacent) clear
    set conn [grid_connectivity]
    $conn near_emap $full_element_map(selected) $full_element_map(adjacent) NULL
}

proc grid_clear_elements {} {
    global full_element_map
    
    $full_element_map(selected) clear
    $full_element_map(adjacent) clear
}

proc should_reload_grid {} {
    if [db_check_dirty mesh] { return 0 }
    
    if {![file exists [directory model]/grid_mapping] ||
	![file exists [directory model]/grid_output]} { return 0 }
    
    set t1 [directory model]/model_timestamp
    set t2 [directory mesh]/mesh_timestamp
    
    if ![file exists $t1] {
	return [file exists $t2]
    }
    if [file exists $t2] {
	set fp [open $t1]; set time1 [gets $fp]; close $fp
	set fp [open $t2]; set time2 [gets $fp]; close $fp
	if {$time1 < $time2} { return 1 }
    }
    return 0
}

proc grid_clear {pref {keep_mapping 0}} {
    global grid_mapping grid_total
    global grid_exists grid_display
    global ${pref}_unstruct ${pref}_nodeset ${pref}_element_set
    global ${pref}_element_map ${pref}_element_map_image
    global ${pref}_group ${pref}_node_map 
    global grid_mindim grid_solver_group_image
    global grid_objects_highlighted group_maps group_map_images grid_cut_exists
    global grid_current_prefix entity_to_map reduced_group_extras
    global grid_quality_limits grid_plot_limits grid_elemcount grid_nodecount
    global domain_family_pid domain_pid_family coupling_inter_data
    global grid_coupling_walls grid_coupling_cutouts grid_coupling_otherparts
    global subtract_maps_from_couplings grid_coupling_otherpart_group
    global error_if_grid_unload
    
    if [info exists error_if_grid_unload] error
    
    set grid_display 0
    catch {unset grid_current_prefix}
    
    foreach i [array names group_maps] {
	set map $group_maps($i)
	if [info exists group_map_images($map)] {
	    $group_map_images($map) delete
	}
	$map delete
    }
    catch {unset group_maps}
    
    foreach dom [array names ${pref}_group] {
	# Some of these may have been deleted above...
	catch {[set ${pref}_group($dom)] delete}
    }
    catch {unset ${pref}_group}

    switch $pref {
	full { set prefg reduced }
	null { set prefg nullr }
	default { set prefg "" }
    }
    
    if {$pref != ""} {
	global ${prefg}_group
	
	foreach dom [array names ${prefg}_group] {
	    catch {[set ${prefg}_group($dom)] delete}
	}
	catch {unset ${prefg}_group}
    }
    
    foreach map [array names ${pref}_element_map_image] {
	[set ${pref}_element_map_image($map)] delete
    }
    catch {unset ${pref}_element_map_image}
    
    foreach map [array names ${pref}_element_map] {
	set em [set ${pref}_element_map($map)]
	$em clear
	$em delete
    }
    catch {unset ${pref}_element_map}
    
    foreach map [array names ${pref}_node_map] {
	set em [set ${pref}_node_map($map)]
	$em delete
    }
    catch {unset ${pref}_node_map}
    
    foreach set [array names ${pref}_element_set] {
	[set ${pref}_element_set($set)] delete
    }
    catch {unset ${pref}_element_set}
    
    grid_invalidate_connectivity $pref
    foreach i {unstruct nodeset} {
	if [info exists ${pref}_$i] {
	    [set ${pref}_$i] delete; unset ${pref}_$i
	}
    }
    
    foreach map [array names grid_solver_group_image] {
	$grid_solver_group_image($map) delete
    }
    catch {unset grid_solver_group_image}
    
    if !$keep_mapping {
	catch {unset grid_mapping}
	catch {unset grid_quality_limits}
	catch {unset grid_plot_limits}
    }
    
    if {$pref == "full"} {
	catch {unset grid_mindim}
	
	if [info exists grid_objects_highlighted] {
	    foreach obj $grid_objects_highlighted {
		graph_highlight $obj 0
	    }
	}
	set grid_objects_highlighted ""
	
	grid_set_exists 0
	#catch {unset grid_cut_exists}
	grid_update_cutplane
	
	catch {unset entity_to_map}
    }
    
    catch {unset reduced_group_extras}
    catch {unset domain_family_pid}
    catch {unset domain_pid_family}
    catch {unset coupling_inter_data}
    catch {unset grid_coupling_walls}
    catch {unset grid_coupling_cutouts}
    catch {unset grid_coupling_otherparts}
    catch {unset grid_coupling_otherpart_group}
    
    set subtract_maps_from_couplings ""
    
    set grid_elemcount "not loaded"
    set grid_nodecount "not loaded"
}

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

proc grid_update_cutplane {{on 1}} {
    global tdv_default
    global temp_planecut_spectype
    global temp_planecut_px temp_planecut_py temp_planecut_pz
    global temp_planecut_nx temp_planecut_ny temp_planecut_nz
    global temp_planecut_a temp_planecut_b temp_planecut_c temp_planecut_d
    global grid_cut_on grid_planecut full_unstruct grid_display
    global temp_planecut_color meshing_units
    global grid_cut_pct_selected
    
    set un $meshing_units

    if [info exists grid_planecut] {
	$grid_planecut delete
	unset grid_planecut
    }
    
    #if {$on && !$grid_display} { set grid_display 1 }
    
    if {!$on || ![info exists grid_cut_on] || !$grid_cut_on ||
	!$grid_display || ![info exists full_unstruct]} return
    
    set pt ""
    foreach i {x y z} {
	lappend pt [unit_convert [set temp_planecut_p$i] $un 0]
    }
    set norm [list $temp_planecut_nx $temp_planecut_ny \
		  $temp_planecut_nz]
    
    set stuff [$full_unstruct cut_surface 1e-6 $pt $norm]
    
    set grid_planecut [surface_im -shade wire]
    if [catch {$grid_planecut configure -grid_color $temp_planecut_color}] {
	user_error "Bad color \"$temp_planecut_color\""
    }
    
    $tdv_default add_image $grid_planecut
    
    eval $grid_planecut set_polys_presorted $stuff
}

proc grid_form_done {} {
    grid_qualmap 0
    form_done .grid
}

proc grid_showmap {m} {
    global tdv_default grid_showmap
    if [info exists grid_showmap($m)] {
	catch {$grid_showmap($m) delete}
	unset grid_showmap($m)
	puts deleted
    } else {
	set grid_showmap($m) [element_map_im -image_client $m -color green \
				  -elemnums 1 -elemnum_offset 1 \
				  -nodenums 1 -nodenum_offset 1 \
				  -nncolor white -encolor green -only_flag 1]
	$tdv_default add_image $grid_showmap($m)
	puts "[$m count] elements"
    }
}

proc grid_update_images {do_cut {err 1}} {
    global errorInfo grid_display in_grid_update_images shape_mesh_is_visible
    
    set shape_mesh_is_visible 0 ;# set it below if per-object mesh is being drawn
    
    if ![info exists grid_display] return
    
    if [info exists in_grid_update_images] return
    set in_grid_update_images 1
    if [catch "grid_update_images_proc $do_cut" res] {
	if $err { puts stderr "Error: $errorInfo" }
    }
    unset in_grid_update_images
}

proc grid_update_images_proc {do_cut} {
    global tdv_default
    global grid_display grid_dtype full_element_set full_element_map
    global full_element_map_image full_group reduced_group graph_color
    global grid_qtype grid_htype current_object grid_mapping
    global grid_objects_displayed grid_object_type_displayed
    global grid_exists grid_nodenums grid_elemnums graph_action_var
    global grid_planecut full_unstruct grid_use_full graph_width
    global grid_qual grid_last_qual grid_display_solid grid_display_wire
    global dont_show_mesh_on_sections full_couplings full_nodeset
    global grid_other_objects_displayed current_shape
    global full_element_map shape_mesh_is_visible
    #full_node_map
    
    if ![info exists full_unstruct] return
    
    # Just kill everything.
    foreach map [array names full_element_map_image] {
	if {$map != "quality"} {
	    $full_element_map_image($map) delete
	    unset full_element_map_image($map)
	}
    }

    foreach obj [array names grid_objects_displayed] {
	foreach map $grid_objects_displayed($obj) { $map delete }
	unset grid_objects_displayed($obj)
    }
    if [info exists grid_other_objects_displayed] {
	foreach obj $grid_other_objects_displayed { $obj delete }
	unset grid_other_objects_displayed
    }
    
    if {$do_cut || !$grid_display} {
	grid_update_cutplane 0
    }
    
    if !$grid_display {
	catch {$full_element_map(adjacent) clear}
	catch {$full_element_map(selected) clear}
	return
    }

    if $graph_action_var {
	set graph_action_var 0
	mess "Turning off action since grid is being displayed\n"
    }
    
    switch "$grid_display_wire $grid_display_solid" {
	"1 1" { set shtype flat_wire }
	"1 0" { set shtype wire }
	"0 1" { set shtype flat }
	"0 0" { set shtype none }
    }
    
    if $grid_use_full { set gtype full_group } else { set gtype reduced_group }
    
    if {$do_cut || ![info exists grid_planecut]} {
	grid_update_cutplane
    }
    
    # ------------------------------
    
    if {$grid_dtype(coup0) && [info exists full_element_map(coup0)]} {
	set emi0 [element_map_im -image_client $full_element_map(coup0) \
		      -color cyan -elemnums $grid_dtype(coupn) \
		      -encolor cyan -width 1 -shade $shtype]
	$tdv_default add_image $emi0
	lappend grid_other_objects_displayed $emi0
	mess "[$full_element_map(coup0) count] faces on the inside\n"
    }
    if {$grid_dtype(coup1) && [info exists full_element_map(coup1)]} {
	set emi1 [element_map_im -image_client $full_element_map(coup1) \
		      -color yellow -elemnums $grid_dtype(coupn) \
		      -encolor pink -width 1 -shade $shtype]
	$tdv_default add_image $emi1
	lappend grid_other_objects_displayed $emi1
	mess "[$full_element_map(coup1) count] faces on the outside\n"
    }
    if {$grid_dtype(coupi) && [info exists full_element_map(coupi)]} {
	set emii [element_map_im -image_client $full_element_map(coupi) \
		      -color \#88ff88 -elemnums $grid_dtype(coupn) \
		      -encolor pink -width 1 -shade $shtype]
	$tdv_default add_image $emii
	lappend grid_other_objects_displayed $emii
	mess "[$full_element_map(coupi) count] faces between assemblies\n"
    }
    
    # ------------------------------
    
    set objects ""
    set only_shape ""
    switch $grid_qtype {
	all {
	    foreach ob [array names grid_mapping] {
		if {![catch {$ob getval obtype} obtype] && \
			($obtype != "domain") && ($obtype != "part")} {
		    lappend objects $ob
		}
	    }
	}
	type {
	    set mtype none
	    if {$current_object != ""} {
		set mtype [$current_object getval obtype]
	    }
	    if {$mtype == "part"} {
		set objs ""
		foreach o [db_list_objects part] {
		    if [$o getval mesh_separate] {
			lappend objects $o
		    } else {
			foreach o2 [db_list_objects_recursive "" $o] {
			    lappend objects $o2
			}
		    }
		}
	    } else {
		set objects [db_list_objects $mtype]
	    }
	}
	object {
	    foreach obj [tree_list_selected] {
		if {[$obj getval obtype] == "part"} {
		    if [$obj getval mesh_separate] {
			lappend objects $obj
		    } else {
			foreach o2 [db_list_objects_recursive "" $obj] {
			    lappend objects $o2
			}
		    }
		} else {
		    lappend objects $obj
		}
	    }
	}
	shape {
	    if {$current_shape != ""} {
		lappend objects $current_object
		set only_shape $current_shape
	    }
	}
    }
    
    set bcolor [set "graph_color(mesh bar)"]
    set bwidth [set "graph_width(mesh bar)"]
    set qcolor [set "graph_color(mesh quad)"]
    set hcolor [set "graph_color(mesh hexa)"]
    
#puts "OBJECTS $objects"
    
    foreach ob $objects {
	if ![$ob si_value active] continue
	if ![info exists grid_mapping($ob)] continue ;# could be a part
	foreach num $grid_mapping($ob) {
	    set obtype [$ob getval obtype]
	    set sect [lindex $grid_mapping($num) 1]
	    if [string match cutout* $sect] continue
	    if {[info exists dont_show_mesh_on_sections($obtype)] &&
		[lmember $dont_show_mesh_on_sections($obtype) $sect]} continue
	    
	    if {($only_shape != "") && ([$ob getval ${sect}_shape] != $only_shape)} continue
	    
	    if $grid_dtype(bar) {
		set key "$num 1"
		if ![info exists ${gtype}($key)] continue
		set map [set ${gtype}($key)]
		if {[$map get_element_types] == "BAR_2"} {
		    set ee [element_map_im -image_client $map \
				-color $bcolor -nncolor white -width $bwidth \
				-elemnums $grid_elemnums -elemnum_offset 1\
				-nodenums $grid_nodenums -nodenum_offset 1\
				-encolor green -only_flag 1 \
				-shade $shtype -use_symmat 1 \
				-nodesize [expr $bwidth / 2 + 1]]
		    $tdv_default add_image $ee
		    lappend grid_objects_displayed($ob) $ee
		}
	    }
	    if $grid_dtype(quad) {
		set keys ""
		foreach kk [array names $gtype] {
		    #puts "num $num kk $kk"
		    if {[string compare [lindex $kk 1] OPEN] && \
			    [lindex $kk 1] && ([lindex $kk 0] == $num)} {
			lappend keys $kk
		    }
		}
#puts "KEYS $keys"
		foreach key $keys {
		    if ![info exists ${gtype}($key)] continue
		    set map [set ${gtype}($key)]
		    #puts "map $map"
		    if {[$map get_element_types] == "BAR_2"} continue
		    set ee [element_map_im -image_client $map \
				-color $qcolor -nncolor white \
				-elemnums $grid_elemnums -elemnum_offset 1\
				-nodenums $grid_nodenums -nodenum_offset 1\
				-encolor green -only_flag 1 \
				-shade $shtype -use_symmat 1]
		    $tdv_default add_image $ee
		    lappend grid_objects_displayed($ob) $ee
		}
		if {($grid_qtype == "object") || ($grid_qtype == "shape")} {
		    set shape_mesh_is_visible 1
		}
	    }
	    if $grid_dtype(hexa) {
		set key "$num 0"
		if ![info exists ${gtype}($key)] continue
		set map [set ${gtype}($key)]
		set ee [element_map_im -image_client $map \
			    -color $hcolor -nncolor white \
			    -elemnums $grid_elemnums -elemnum_offset 1\
			    -nodenums $grid_nodenums -nodenum_offset 1\
			    -encolor green -only_flag 1 \
			    -shade $shtype -use_symmat 1]
		$tdv_default add_image $ee
		lappend grid_objects_displayed($ob) $ee
	    }
	}
    }
}

proc grid_special {{name ""}} {
    global tdv_default
    global group_maps group_map_images
    
    if {$name == ""} { puts [array names group_maps]; return }
    
    set map $group_maps($name)
    if [info exists group_map_images($map)] {
	$group_map_images($map) delete
	unset group_map_images($map)
    } else {
	set group_map_images($map) [element_map_im -image_client $map \
		-color cyan -elemnums 0 -encolor yellow -nodenums 0 \
		-nncolor pink -use_symmat 1]
	$tdv_default add_image $group_map_images($map)
    }
}

proc grid_showelems {args} {
    global tdv_default
    global grid_show_map grid_show_map_image full_unstruct full_element_set
    
    if [info exists grid_show_map] {
	$grid_show_map_image delete
	unset grid_show_map_image
	$grid_show_map delete
	unset grid_show_map
    }
    set grid_show_map [element_map -mesh $full_unstruct]
    eval $grid_show_map add_list $full_element_set(hexa) $args
    set grid_show_map_image [element_map_im -image_client $grid_show_map \
	    -color red -elemnums 0 -encolor white]
    $tdv_default add_image $grid_show_map_image
}

# This returns the worst quality on a scale of 0 to 1, with 0 being bad.

proc grid_get_worst {{how depends}} {
    global grid_quality_limits grid_type
    
    if {$how == "depends"} { set how facealign }
    
    if ![info exists grid_quality_limits($how)] {
	grid_compute_quality $how 0
    }
    return [lindex $grid_quality_limits($how) 0]
}

proc grid_warn_bad_mesh {} {
    global bad_face_align bad_det_aspect bad_volume
    
    set asp [grid_get_worst det_aspect]
    set aln [grid_get_worst facealign]
    set vol [grid_get_worst volume]
    if {$asp < 0} {
	mess "Warning: worst aspect ratio in grid is $asp\n" red
    } elseif {$asp < $bad_det_aspect} {
	mess "Warning: worst aspect ratio in grid is $asp\n" blue
    }
    if {$aln < $bad_face_align} {
	mess "Warning: worst face alignment in grid is $aln\n" red
    }
    if {$vol < $bad_volume} {
	mess "Warning: smallest volume in grid is $vol\n" red
    }
}

proc grid_compute_quality {how noisy} {
    global full_element_map full_element_set full_unstruct grid_last_qual
    global grid_quality_limits grid_plot_limits grid_histof
    global histo_width histo_height grid_qual_highv
    global histo_minv_limit histo_maxv_limit
    
    if ![info exists full_unstruct] {
	mess "No grid exists yet.\n" red
	return
    }
    
    switch $how {
	determinant { set how det_aspect }
	squish { set how facealign }
	aspect { set how det_aspect }
    }
    switch $how {
	det_aspect { set title "Quality" }
	facealign { set title "Face alignment" }
	volume { set title "Volume" }
    }
    
    set grid_last_qual $how
    grid_qualmap 0
    
    busy 1
    set conn ""
    if ![$full_unstruct get -already_computed_$how] {
	if $noisy {
	    mess "Computing element quality ([string tolower $title]) ...\n"
	}
	if {$how == "facealign"} { set conn [grid_connectivity] }
    }
    set lims [$full_unstruct compute_diag $how $conn $noisy]
    busy 0
    if {[lindex $lims 2] < [lindex $lims 3]} {
	set p [expr {[lindex $lims 2] * 100 / [lindex $lims 3]}]
	mess "Warning: only [format %d $p] % completed\n" red
    }
    set grid_quality_limits($how) [lrange $lims 0 1]
    
    if $noisy {
	mess "\trange: [lindex $lims 0] -> [lindex $lims 1]\n"
    }
    
    if {$how == "volume"} {
	set minv [lindex $lims 0]
	set maxv [lindex $lims 1]
    } else {
	if {[lindex $lims 0] < 0} {
	    set minv -1
	    set maxv 1
	} else {
	    set minv 0
	    set maxv 1
	}
    }
    set histo_minv_limit $minv
    set histo_maxv_limit $maxv
    grid_plot_histo $title 20 $minv $maxv 0 $how
    update
    return [lindex $lims 0]
}

proc grid_plot_histo {title bars minv maxv maxh how} {
    global full_element_map full_element_set full_unstruct grid_last_qual
    global grid_plot_limits grid_histof
    global histo_width histo_height grid_qual_highv
    global histo_minv histo_maxv histo_solid mesh_quality_explanation
    global small_screen_hack bad_face_align bad_det_aspect
    global form_label_text
    
    set histo_minv $minv
    set histo_maxv $maxv
    
    set grid_plot_limits($how) [list $minv $maxv]
    
    if {[info exists grid_histof] && [winfo exists $grid_histof]} {
	grid_qualmap 1
	
	# First figure out the buckets.
	set xvals ""
	set yvals ""
	set diff [expr {($maxv - $minv) / ($bars + 0.0)}]
	for {set i 0} {$i < $bars} {incr i} {
	    set low [expr {$minv + $i * $diff}]
	    set high [expr {$minv + ($i + 1) * $diff}]
	    set grab 0
	    if {$i == $bars - 1} { set high $maxv; set grab 1 }
	    set num [$full_element_map(quality) grab_diag_elements $low $high \
			 $how 1 $grab]
	    lappend xvals $low
	    lappend yvals $num
	}
	lappend xvals $maxv
	
	if $small_screen_hack {
	    set histo_width 260; set histo_height 240
	} else {
	    set histo_width 360; set histo_height 320
	    
	}
	#set histo_solid 0
	if {$how == "volume"} { set nlab 3 } else { set nlab 5 }
	make_histogram $grid_histof $title $xvals $yvals \
	    $maxh "" grid_plot_histo grid_highlight_cmd $how "" 1 \
	    12 $nlab 1 1 1 0 1 -1
	
	switch $how {
	    volume {
		set mesh_quality_explanation ""
	    }
	    facealign {
		set mesh_quality_explanation "Elements less than $bad_face_align are severely distorted."
	    }
	    det_aspect {
		set mesh_quality_explanation "Elements less than $bad_det_aspect are severely distorted."
	    }
	}
	if [info exists form_label_text($mesh_quality_explanation)] {
	    set mesh_quality_explanation $form_label_text($mesh_quality_explanation)
	}
	# Sometimes it can get resized to 1x1 pixels.  It's not clear why
	if $small_screen_hack {
	    $grid_histof configure -bg black -width 260 -height 240
	} else {
	    $grid_histof configure -bg black -width 360 -height 320
	}
    }
}

proc grid_highlight_cmd {w ints arguments solid} {
    global full_element_map full_element_map_image
    global grid_last_qual grid_quality_limits
    
    if ![info exists full_element_map_image(quality)] return

    grid_qualmap 1
    
    if $solid {
	$full_element_map_image(quality) configure -shade flat_wire
    } else {
	$full_element_map_image(quality) configure -shade wire
    }
    
    $full_element_map(quality) clear
    foreach int $ints {
	set low [lindex $int 0]; set high [lindex $int 1]
	set highv [lindex $grid_quality_limits($grid_last_qual) 1]
	set gm [expr $high == $highv]
	$full_element_map(quality) grab_diag_elements $low $high \
	    $grid_last_qual 0 $gm
    }
}

proc grid_qualmap {create} {
    global tdv_default
    global full_element_map full_unstruct full_element_map_image
    
    if $create {
	if ![info exists full_element_map(quality)] {
	    if ![info exists full_unstruct] return
	    
	    set map [element_map -mesh $full_unstruct]
	    set full_element_map(quality) $map
	    set im [element_map_im -image_client $map -color \#ffffa0 -use_symmat 1]
	    set full_element_map_image(quality) $im
	    $tdv_default add_image $im
	}
	
    } else {
	if [info exists full_element_map_image(quality)] {
	    $full_element_map_image(quality) delete
	    unset full_element_map_image(quality)
	}
	if [info exists full_element_map(quality)] {
	    $full_element_map(quality) delete
	    unset full_element_map(quality)
	}
    }
}

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

proc set_planecut_units {post} {
    global planecut_length_units post_units meshing_units
    
    if [info exists planecut_length_units] {
	set ounits $planecut_length_units
    } else {
	set ounits ""
    }
    if $post {
	set planecut_length_units $post_units(length)
    } else {
	set planecut_length_units $meshing_units
    }
    if {($ounits != "") && ($ounits != $planecut_length_units)} {
	foreach i {px py pz clip_minx clip_miny clip_minz clip_maxx clip_maxy clip_maxz} {
	    global temp_planecut_$i
	    if ![info exists temp_planecut_$i] continue
	    global temp_planecut_${i}_units
	    set oval [unit_convert [set temp_planecut_$i] $ounits 0]
	    if ![info exists temp_planecut_${i}_units] {		
		set temp_planecut_$i [unit_convert $oval $planecut_length_units 1]
	    }
	}
    }
}

proc grid_form_planecut {d geo act set_func color_var} {
    global grid_cut_pct_selected
    set postup ""    
    set do_grid_update 1
    
    set cc [form_label_frame $d "Plane location" $geo]
    
    set opts {list \
		  {normx  {X plane through center}} \
		  {normy  {Y plane through center}} \
		  {normz  {Z plane through center}} \
		  {ptnorm {Point and normal}} \
		  {coeffs {Coeffs (Ax + By + Cz = D)}} \
		  {horiz  {Horizontal - screen select}} \
		  {vert   {Vertical - screen select}} \
		  {3pts   {3 points - screen select}}}
    
    set update_func "planecut_coeffs_from_ptnorm; planecut_pct_from_ptnorm; $set_func"
    set update_button_func [list grid_form_planecut_settype $set_func]
    form_label $cc.crel "Set position" {0 0} $act
    futil_menuentry_labels $cc.cre temp_planecut_spectype $opts {0 1} $act \
	[list grid_form_planecut_settype $set_func]
    form_button $cc.upd Update $update_button_func {0 2} $act
    form_frame $cc.vals flat 0 {1 0 -cols 3}
    set act1 [concat $act {{temp_planecut_spectype ptnorm}}]
    set act2 [concat $act {{temp_planecut_spectype coeffs}}]
    form_label $cc.vals.xl "PX" {0 0 -padx 0} $act1
    form_label $cc.vals.yl "PY" {0 2 -padx 0} $act1
    form_label $cc.vals.zl "PZ" {0 4 -padx 0} $act1
    form_entry $cc.vals.x temp_planecut_px float {0 1} $act1 4
    form_entry $cc.vals.y temp_planecut_py float {0 3} $act1 4
    form_entry $cc.vals.z temp_planecut_pz float {0 5} $act1 4
    form_label $cc.vals.nxl "NX" {1 0 -padx 0} $act1
    form_label $cc.vals.nyl "NY" {1 2 -padx 0} $act1
    form_label $cc.vals.nzl "NZ" {1 4 -padx 0} $act1
    form_entry $cc.vals.nx temp_planecut_nx float {1 1} $act1 4
    form_entry $cc.vals.ny temp_planecut_ny float {1 3} $act1 4
    form_entry $cc.vals.nz temp_planecut_nz float {1 5} $act1 4
    form_label $cc.vals.al "A" {0 6 -padx 0} $act2
    form_label $cc.vals.bl "B" {0 8 -padx 0} $act2
    form_label $cc.vals.cl "C" {1 6 -padx 0} $act2
    form_label $cc.vals.dl "D" {1 8 -padx 0} $act2
    form_entry $cc.vals.a temp_planecut_a float {0 7} $act2 4
    form_entry $cc.vals.b temp_planecut_b float {0 9} $act2 4
    form_entry $cc.vals.c temp_planecut_c float {1 7} $act2 4
    form_entry $cc.vals.d temp_planecut_d float {1 9} $act2 4
    
    foreach i {x y z nx ny nz} {
	bind $cc.vals.$i <Return> $update_func
    }
    foreach i {a b c d} {
	$cc.vals.$i configure -width 4
	bind $cc.vals.$i <Return> "planecut_ptnorm_from_coeffs; planecut_pct_from_ptnorm; $set_func"
    }
    set cmd0 "planecut_update_from_pct 0; $set_func; list"
    set cmd1 "planecut_update_from_pct 1; $set_func; list"
    
    form_scale $cc.sc grid_cut_pct $cmd0 h 0 1 0.001 \
	{2 0 -cols 2 -fill x} $act
    bind $cc.sc <ButtonRelease-1> "catch {unset grid_planecut_quick}; $cmd1"
    bind $cc.sc <ButtonPress-1> "set grid_planecut_quick 1; $cmd0"
    if {$color_var != ""} {
	form_label $cc.coll "Mesh color" {3 0} $act
	futil_colorentry $cc.cole $color_var \
	    {3 1} $act "" "" $set_func
    }
}

proc grid_form_planecut_settype {set_func} {
    global tdv_default
    global temp_planecut_spectype temp_planecut_px temp_planecut_py temp_planecut_pz
    global temp_planecut_nx temp_planecut_ny temp_planecut_nz
    global temp_planecut_a temp_planecut_b temp_planecut_c temp_planecut_d
    global grid_cut planecut_length_units view_panes tdv_last_viewer_clicked
    global temp_planecut_clip_minx temp_planecut_clip_miny temp_planecut_clip_minz
    global temp_planecut_clip_maxx temp_planecut_clip_maxy temp_planecut_clip_maxz
    global temp_planecut_clip_minx_units temp_planecut_clip_miny_units
    global temp_planecut_clip_minz_units
    global temp_planecut_clip_maxx_units temp_planecut_clip_maxy_units
    global temp_planecut_clip_maxz_units
    
    set un $planecut_length_units
    set sptype $temp_planecut_spectype
    switch $sptype {
	horiz - vert {
	    banner "Please left-click to indicate the point on the plane"
	    set line [tdv_obtain_line $view_panes(all_viewers)]
	    banner ""
	    if {$line == ""} return
	    foreach i {0 1 2} {
		set v [unit_convert [lindex [lindex $line 0] $i] $un 1]
		set temp_planecut_[lindex {px py pz} $i] $v
	    }
	    set pt1 [lindex [$tdv_last_viewer_clicked screen2world 0 0] 0]
	    switch $sptype {
		horiz { set pt2 [lindex [$tdv_last_viewer_clicked screen2world 0 100] 0] }
		vert  { set pt2 [lindex [$tdv_last_viewer_clicked screen2world 100 0] 0] }
	    }
	    
	    foreach i {0 1 2} {
		set d [expr {[lindex $pt2 $i] - [lindex $pt1 $i]}]
		set temp_planecut_[lindex {nx ny nz} $i] $d
	    }
	    
	    # Just to be nice let's reverse the normal if the sum of the 
	    # components is negative.
	    if {$temp_planecut_nx + $temp_planecut_ny + \
		    $temp_planecut_nz < 0} {
		foreach i {x y z} {
		    set temp_planecut_n$i [expr [set temp_planecut_n$i] * -1]
		}
	    }
	}
	3pts {
	    set pts [get_3pts]
	    if {$pts == ""} return
	    set pl [eval plane_from_3pts $pts]
	    set pp [lindex $pl 0]; set pn [lindex $pl 1]
	    foreach i {0 1 2} {
		set temp_planecut_p[lindex {x y z} $i] [lindex $pp $i]
		set temp_planecut_n[lindex {x y z} $i] [lindex $pn $i]
	    }
	}
	normx - normy - normz {
	    set bb [$tdv_default bbox interesting]
	    if {$bb != ""} {
		foreach i {0 1 2} x {x y z} {
		    set v [expr ([lindex [lindex $bb 0] $i] + \
				     [lindex [lindex $bb 1] $i]) / 2.0]
		    set temp_planecut_p$x [unit_convert $v $un 1]
		    if {$temp_planecut_spectype == "norm$x"} {
			set temp_planecut_n$x 1
			if [info exists temp_planecut_clip_min$x] {
			    set temp_planecut_clip_min$x [format %g [unit_convert [lindex [lindex $bb 0] $i] [set temp_planecut_clip_min${x}_units] 1]]
			    set temp_planecut_clip_max$x [format %g [unit_convert [lindex [lindex $bb 1] $i] [set temp_planecut_clip_max${x}_units] 1]]
			}
		    } else {
			set temp_planecut_n$x 0
		    }
		}
	    }
	}
	coeffs {
	    planecut_ptnorm_from_coeffs
	}	    
    }
    planecut_coeffs_from_ptnorm
    planecut_pct_from_ptnorm
    eval $set_func
}

proc planecut_coeffs_from_ptnorm {} {
    global temp_planecut_px temp_planecut_py temp_planecut_pz
    global temp_planecut_nx temp_planecut_ny temp_planecut_nz
    global temp_planecut_a temp_planecut_b temp_planecut_c temp_planecut_d
    
    set dv 0
    foreach i {0 1 2} {
	set d [set temp_planecut_[lindex {nx ny nz} $i]]
	set p [set temp_planecut_[lindex {px py pz} $i]]
	set temp_planecut_[lindex {a b c} $i] $d
	set dv [expr {$dv + $p * $d}]
    }
    set temp_planecut_d $dv
}

proc planecut_ptnorm_from_coeffs {} {
    global temp_planecut_px temp_planecut_py temp_planecut_pz
    global temp_planecut_nx temp_planecut_ny temp_planecut_nz
    global temp_planecut_a temp_planecut_b temp_planecut_c temp_planecut_d
    
    set npt "0 0 0"
    foreach q {0 1 2} {
	set v [set temp_planecut_[lindex {a b c} $q]]
	if $v {
	    set npt [lreplace $npt $q $q [expr {$temp_planecut_d / $v}]]
	    break
	}
    }
    set norm [list $temp_planecut_a $temp_planecut_b $temp_planecut_c]
    foreach i {0 1 2} {
	set temp_planecut_n[lindex {x y z} $i] [lindex $norm $i]
	set temp_planecut_p[lindex {x y z} $i] [lindex $npt $i]
    }
}

proc planecut_pct_from_ptnorm {} {
    global tdv_default
    global temp_planecut_px temp_planecut_py temp_planecut_pz
    global temp_planecut_nx temp_planecut_ny temp_planecut_nz
    global grid_cut_pct planecut_length_units
    
    set bb [$tdv_default bbox interesting]
    if {$bb != ""} {
	set pt ""
	foreach i {x y z} {
	    lappend pt [unit_convert [set temp_planecut_p$i] \
			    $planecut_length_units 0]
	}
	set nm [list $temp_planecut_nx $temp_planecut_ny $temp_planecut_nz]
	set grid_cut_pct [scan_value_from_bbox $pt $nm [lindex $bb 0] [lindex $bb 1]]
    }
}

proc planecut_update_from_pct {reset_norm} {
    global tdv_default full_unstruct
    global temp_planecut_px temp_planecut_py temp_planecut_pz
    global temp_planecut_nx temp_planecut_ny temp_planecut_nz
    global grid_cut_pct planecut_length_units temp_planecut_spectype
    global grid_cut_pct_selected grid_planecut

    set un $planecut_length_units
    if {$grid_cut_pct <= 0.001} { set grid_cut_pct 0.001 }
    if {$grid_cut_pct >= 0.999} { set grid_cut_pct 0.999 }
    set bb [$tdv_default bbox interesting]
    if {$bb == ""} return
    
    set pt ""
    foreach i {x y z} {
	lappend pt [unit_convert [set temp_planecut_p$i] $un 0]
    }
    set nm [list $temp_planecut_nx $temp_planecut_ny $temp_planecut_nz]
    set np [clip_scan_to_box $pt $nm [lindex $bb 0] [lindex $bb 1] $grid_cut_pct]
    
    if {$reset_norm && [string match norm* $temp_planecut_spectype]} {
	set temp_planecut_spectype ptnorm
    }
	    
    if {$grid_cut_pct_selected} {
	foreach {i x} {0 x 1 y 2 z} {
	    set temp_planecut_p$x [unit_convert [lindex $np $i] $un 1]
	}
	
	planecut_coeffs_from_ptnorm
	grid_update_images 1 
    } else {
	if [info exists grid_planecut] {
	    $grid_planecut delete
	    unset grid_planecut
	}
	#instead of a full planecut
	#update some outline image, using these vals of nm and np
	
	set stuff [$full_unstruct cut_surface 1e-6 $np $nm]
	set grid_planecut [surface_im -shade solid]
	$tdv_default add_image $grid_planecut
	
	eval $grid_planecut set_polys_presorted $stuff
    }    
}

proc planecut_animate {} {
    global tdv_default
    auto_animation_form .cut_anim "Plane cut animation" \
	"Starting pct" 0.0 "Ending pct" 1.0 grid_cut_pct \
	"planecut_update_from_pct 0; update; post_accept; $tdv_default redraw" "" 0 16 planecut
}

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

proc grid_area_fraction {obj section side {pref reduced}} {
    global ${pref}_group grid_mapping
    
    set m [set "grid_mapping($obj $section)"]
    set tot_area 0
    set side_area 0
    foreach i [array names ${pref}_group] {
	if {([lindex $i 0] != $m) || ![lindex $i 1]} continue
	set a [[set ${pref}_group($i)] get_area]
	set tot_area [expr $tot_area + $a]
	if {[lindex $i 1] == $side} { set side_area $a }
    }
    #puts "obj $obj side $side total $tot_area sidearea $side_area"
    if $tot_area {
	return [expr {$side_area / ($tot_area + 0.0)}]
    } else {
	return 0
    }
}

proc grid_area_object {obj section side {pref reduced}} {
    global ${pref}_group grid_mapping
    
    if {$section == "all"} {
	set tot 0
	foreach ss [$obj getval section_list] {
	    if [info exists "grid_mapping($obj $ss)"] {
		set a [grid_area_object $obj $ss $side $pref]
		set tot [expr $tot + $a]
	    }
	}
	return $tot
    }
    
    if ![info exists "grid_mapping($obj $section)"] { return 0.0 }
    
    set m [set "grid_mapping($obj $section)"]
    set tot_area 0
    foreach i [array names ${pref}_group] {
	if {([lindex $i 0] != $m) || ![lindex $i 1]} continue
	if {($side != "") && ([lindex $i 1] != $side)} continue
	set a [[set ${pref}_group($i)] get_area]
	set tot_area [expr $tot_area + $a]
    }
    return $tot_area
}

proc grid_connectivity {{which full}} {
    global grid_connectivity ${which}_unstruct
    
    if ![info exists grid_connectivity($which)] {
	set grid_connectivity($which) \
	    [connectivity -mesh [set ${which}_unstruct]]
    }
    return $grid_connectivity($which)
}

proc grid_invalidate_connectivity {{which full}} {
    global grid_connectivity

    if [info exists grid_connectivity($which)] {
	$grid_connectivity($which) delete
	unset grid_connectivity($which)
    }
}

proc unused__grid_conformalize {how} {
    global reduced_group full_element_set full_unstruct grid_conformal_changes
    global full_nodeset grid_mapping full_group dont_allow_pyramids
    
    set nf [$full_unstruct fix_inverted_elements]
    # no need to say this
    #if $nf { mess "$nf inverted elements fixed\n" }
    
    # First we have to handle the hexa/penta things here.
    set total_cells 0
    set ntypes 0
    foreach {t n ch} {
	hexa HEXA_8 1 penta PENTA_6 1 pyra PYRA_5 1 tetra TETRA_4 1 tri TRI_3 0
    } {
	if ![info exists full_element_set($t)] {
	    set full_element_set($t) \
		[element_set -mesh $full_unstruct -type $n]
	} else {
	    set nc [$full_element_set($t) get -num]
	    incr total_cells $nc
	    if {$nc && $ch} { incr ntypes }
	}
    }
    
    if {$ntypes < 2} { return $total_cells }
    
    if {[info exists full_element_set(pyra)] && \
	    [$full_element_set(pyra) get -num]} {
	#mess "Mesh has already been made conformal\n"
	return $total_cells
    }
    
    mess "Making hybrid grid conformal\n"
    set conn [grid_connectivity]
    set changes [$conn make_conformal $how]
    if {$changes != ""} {
	mess "Modified [llength $changes] cells to make the grid conformal\n"
	grid_invalidate_connectivity
	
	foreach ch $changes {
	    incr total_cells [expr {([llength $ch] - 4) / 2}]
	}
	
	# Now fix the emaps.
	foreach key [array names full_group] {
	    if [lindex $key 1] continue
	    foreach ch $changes {
		eval $full_group($key) add_elements_if_there $ch
	    }
	    $full_group($key) purge_deleted
	}
	set grid_conformal_changes 1
	
	foreach type {det_aspect facealign volume} {
	    $full_unstruct configure -already_computed_$type 0
	}
    }
    
    # Now fix up the start numbers ...  pyras don't get used for fidap.
    set n 1
    foreach vol {hexa penta tetra pyra} {
	if [info exists full_element_set($vol)] {
	    set s [set full_element_set($vol)]
	    $s configure -startno $n
	    incr n [$s get -num]
	}
    }
    
    if {[info exists dont_allow_pyramids] && \
	    [info exists full_element_set(pyra)] && \
	    [$full_element_set(pyra) get -num]} {
user_error "This mesh has pyramids in it.  Pyramid elements are not available with the solver and you must use the Tetra mesher instead."
	return -1
    }
    
    
    # Purge the unused nodes.
    $full_nodeset start_renumbering
    foreach s [$full_unstruct list_sets] {
	$s start_renumbering
	set em [element_map -mesh $full_unstruct]
	$em add_range $s 0 -1
	$em renumber_nodes
	$em delete
    }
    $full_nodeset purge_unused
    foreach s [$full_unstruct list_sets] {
	$s renumber_all
    }
    foreach m [$full_unstruct list_maps] {
	$m fix_element_numbers
    }
    foreach s [$full_unstruct list_sets] {
	$s finish_renumbering
    }
    $full_nodeset finish_renumbering
    
    grid_invalidate_connectivity
    
    set nf [$full_unstruct fix_inverted_elements]
    # no need to say this
    #if $nf { mess "$nf inverted elements fixed\n" }
    
    return $total_cells
}

proc grid_has_only_hexas {} {
    global full_element_set
    
    foreach t {penta pyra tetra} {
	if {[info exists full_element_set($t)] && \
		[$full_element_set($t) get -num]} {
	    return 0
	}
    }
    return 1
}

proc grid_split_faces {} {
    global full_element_set full_unstruct
    global full_nodeset grid_mapping full_group
    global app_has_should_split_nodes
    
    set printed_mess 0
    
    set nsplit 0; set nbound 0
    
    foreach dom [array names full_group] {
	set xx [grid_dom_to_object $dom]
	if {$xx == ""} continue
	foreach i {0 1 2 3} {
	    set [lindex {obj sh side map} $i] [lindex $xx $i]
	}
	if {$side != 1} continue
	
	set t [$obj getval obtype]
	
	if {[info exists app_has_should_split_nodes($t)] &&
	    [app_should_split_nodes_$t $obj $sh $side]} {
	    
	    foreach s [$full_unstruct list_sets] { $s set_flood_flags 0 }
	    
	    set dom2 "[lindex $dom 0] 2"
	    if ![info exists full_group($dom2)] {
		set full_group($dom2) [element_map -mesh $full_unstruct]
	    }
	    set map2 $full_group($dom2)
	    
	    # First let's make sure all the triangles are pointing in the
	    # same direction.
	    if [$map orient_in_direction "1 1 1"] {
		grid_invalidate_connectivity
	    }

	    # Every time through we need a new connectivity matrix because
	    # the previous time it may have been modified in a way we don't
	    # like.
	    set conn [grid_connectivity]
	    #puts "    [$obj getval name]"
	    $map set_all_flags 1
	    set nspl [$map split_nodes $conn $map2]
	    #puts "    $nspl"
	    incr nsplit [lindex $nspl 0]
	    incr nbound [lindex $nspl 1]
	    if [lindex $nspl 0] {
		if !$printed_mess {
		    mess "Splitting faces... "
		    set printed_mess 1
		}
		grid_invalidate_connectivity
	    }
	    $map set_all_flags 0
	    $map2 set_all_flags 0
	}
    }
    
    if $nsplit {
	mess "$nsplit nodes split ($nbound boundary nodes)\n"
    }
    
    if 0 {
    if {$to_update != ""} {
	set conn [grid_connectivity]
	
	foreach {map dom} $to_update {
	    set dom2 "[lindex $dom 0] 2"
	    if ![info exists full_group($dom2)] {
		set full_group($dom2) [element_map -mesh $full_unstruct]
	    }
	    set map2 $full_group($dom2)
	    set nm [$map move_positive_facing_elements $map2 $conn]
	    puts "    moved $nm for $dom2 out of [$map count]"
	}
	grid_invalidate_connectivity
    }
    }
}

# This returns a list: obj shape side map, or ""

proc grid_dom_to_object {dom} {
    global grid_mapping full_group

    if ![info exists grid_mapping([lindex $dom 0])] { return "" }
    set obj [lindex $grid_mapping([lindex $dom 0]) 0]
    if {$obj == ""} { return "" }
    set side [lindex $dom 1]
    if ![string compare $side 0] { return "" }
    
    set map $full_group($dom)
    if ![$map count] { return "" }
    set gridm $grid_mapping([lindex $dom 0])
    if [string match cutout* [lindex $gridm 1]] { return "" }
    set sh [$obj getval [lindex $gridm 1]_shape]
    if {$sh == ""} { set sh [$obj getval body_shape] }
    
    return [list $obj $sh $side $map]
}

# If for_auto_mesher is 1 then that means that higher priority objects get
# written later.  If it's 0 they are earlier and also flat things get written
# before faces (for tetra).  Iceboard is like tetra even though it writes 
# a grid_input file. 

proc grid_get_object_list {for_auto_mesher do_part inc_others use_sep} {
    global object_category writing_ff_grid type_not_in_ff
    global hollow_objects_always_higher_priority grid_mesh_parts_separate
    global grid_type app_has_grid_type

    #puts [list grid_get_object_list $for_auto_mesher $do_part $inc_others $use_sep]
    
    set sep [expr {$use_sep && $grid_mesh_parts_separate && ![info exists writing_ff_grid] && ($grid_type != "iceboard")}]
    
    # First get all objects from parts and toss them into a big table, and then
    # read them out again by type.
    set the_objects [db_list_all "" $do_part [list ""]]
    
    if {($do_part == "") && ($inc_others == 0) && !$sep} {
	while 1 {
	    # expand up the parts that are in the list "the objects"
	    # otherwise they don't get meshed in this case
	    set nobjects ""
	    
	    set exp_some 0
	    foreach obj $the_objects {
		if {[$obj getval obtype] == "part"} {
		    foreach ob [$obj list_contents] {
			if [$ob si_value active] {
			    lappend nobjects $ob   
			}
		    }
		    incr exp_some
		} else {
		    lappend nobjects $obj
		}
	    }
	    
	    set the_objects $nobjects
	    if !$exp_some break
	}
    }

    # If we're including intersecting objects in this part then add them
    # also.  But skip ones that are in "mesh separate" parts ***that are not
    # parents of this part*** and also ones
    # that are neither hexas nor quads, and check for those which can't
    # be intersected such as thin conducting plates.  Also check containers
    # that contain us.
    # In addition, return mesh separate parts that might touch us which are not
    # ancestors or descendants
    if $inc_others {
	# Figure out the ancestor parts of this one.
	set ancestors [list ""]
	for {set cc [$do_part get -model_container]} {$cc != ""} \
	    {set cc [$cc get -model_container]} {
		if [$cc getval mesh_separate 0] {
		    lappend ancestors $cc
		}
	    }
	
	set partbb [db_bbox_of_object $do_part]
	foreach obj $the_objects { set got($obj) 1 }
	#puts "db_list_all {} {} $ancestors"
	foreach obj [db_list_all "" "" $ancestors] {
	    #puts "check [$obj getval name]"
	    # Is this object actually a containing part of the one we're
	    # looking at?
	    set up_c 0
	    for {set cc $do_part} {$cc != ""} {set cc [$cc get -model_container]} {
		if {$cc == $obj} { set up_c 1 ; break }
	    }
	    if $up_c continue
	    
	    set over 0
	    set shape_mess ""
	    set obj_mess ""
	    foreach sh [db_shapes $obj] {
		set bb [$sh get_bbox]
		if {$bb == ""} continue
		
		#puts "check [$obj getval name]"
		#puts "object_bbox_check_overlap $partbb $bb 1"
		# Make this 1 so that we get flat objects *almost* sitting
		# on the boundary?
		set xxx [eval object_bbox_check_overlap $partbb $bb 1]
		#puts $xxx
		switch $xxx {
		    out { }
		    in {
			switch [$sh get -shtype] {
			    hexa - quad - cyl { set over 1 }
			    default {
				#puts "check $obj"
				#puts "object_bbox_check_overlap \{$partbb\} \{$bb\} 0"
				set shape_mess "[$obj getval obtype] \"[$obj getval name]\" has a shape ([$sh get -shtype]) which can't intersect an assembly"
			    }
			}
			set check [info command app_can_intersect_nc_[$obj getval obtype]]
		    }
		    overlap {
			switch [$sh get -shtype] {
			    hexa - quad - cyl { set over 1 }
			    default {
				#puts "check $obj"
				#puts "object_bbox_check_overlap \{$partbb\} \{$bb\} 0"
				set shape_mess "[$obj getval obtype] \"[$obj getval name]\" has a shape ([$sh get -shtype]) which can't intersect an assembly"
			    }
			}
			set check [info command app_can_intersect_nc_[$obj getval obtype]]
		    }
		    touch {
			switch [$sh get -shtype] {
			    container - quad {
				# Containers might touch because of asm/asm interfaces
				# Quads we can deal with by clipping them as long as they
				# are on the domain boundary
				set over 1
			    }
			    default {
				set shape_mess "[$obj getval obtype] \"[$obj getval name]\" is placed so that it improperly intersects an assembly"
				set check [info command app_can_touch_mesh_interface_[$obj getval obtype]]
				set over 1
			    }
			}
		    }
		}
	    }
	    if !$over {
		if {$shape_mess != ""} { user_error "$shape_mess ([$do_part getval name])." }
		continue
	    }
	    if {$check != ""} {
		set obj_mess [$check $obj]
		if {$obj_mess == ""} { set shape_mess "" }
	    }	    
	    if {$shape_mess != ""} {
		user_error "$shape_mess ([$do_part getval name]).  The intersecting region is being ignored."
	    } elseif {$obj_mess != ""} {
		user_error "$obj_mess ([$do_part getval name]).  The intersecting region is being ignored."
	    } else {
		lappend the_objects $obj
	    }
	}
    }

    # This is a HACK - it's really slow to determine whether plates are inside
    # openings or not, therefore we do this pre-processing step to assemble
    # the valid openings so the check goes faster.
    if {[info commands app_initialize_grid_type_hack] != ""} {
	app_initialize_grid_type_hack
    }
    foreach obj $the_objects {
	if {[info exists writing_ff_grid] && [$obj checkval ff_inactive]} continue
        set type [$obj getval obtype]
        if [info exists app_has_grid_type($type)] {
            set type [app_grid_type_$type $obj]
	} elseif [info exists hollow_objects_always_higher_priority] {
	    set sh [$obj getval body_shape]
	    if {![catch {$sh getval volume_flag} vol] && ($vol == 0)} {
		set type ${type}_hollow
	    }
	}
	if {($type == "part") && ![part_num_active_objects $obj]} continue
	
        lappend all_objects($type) $obj
	
        if !$for_auto_mesher {
            set vol 0
            foreach sh [db_shapes $obj] {
                set vol [expr $vol + [$sh get_volume]]
            }
            if {$vol > 0} {
                lappend volume_objects($type) $obj
            } else {
                lappend flat_objects($type) $obj
            }
        }
    }
    set objects ""
    if [info exists object_category(grid_priority)] {
	foreach cat $object_category(grid_priority) {
	    foreach suff {"" _hollow} {
		set cat2 ""
		foreach tt $cat { lappend cat2 $tt$suff }
		
		set these ""
		foreach tt $cat2 {
		    if {[info exists writing_ff_grid] && \
			    [info exists type_not_in_ff($tt)]} continue
		    
		    if [info exists all_objects($tt)] {
			set these [concat $these $all_objects($tt)]
		    }
		}
		foreach obj [lsort -command creation_order_cmp $these] {
		    if {[info exists writing_ff_grid] && 
			([ff_okay_for_object $obj 0] == 2)} continue
		    lappend objects $obj
		}
	    }
	}
    } else {
        set use_types ""
	foreach tt $object_category(grid) {
	    if {[info exists writing_ff_grid] && \
		    [info exists type_not_in_ff($tt)]} continue
	    lappend use_types $tt
        }

        if !$for_auto_mesher {
            # First the flat things (higher priority)
            foreach tt $use_types {
                if [info exists volume_objects($tt)] {
                    foreach obj [lsort -command creation_order_cmp \
                                     $volume_objects($tt)] {
                        lappend objects $obj
                    }
                }
            }
            # Then the volumetric things
            foreach tt $use_types {
                if [info exists flat_objects($tt)] {
                    foreach obj [lsort -command creation_order_cmp \
                                     $flat_objects($tt)] {
                        lappend objects $obj
                    }
                }
            }

	} else {
            foreach tt $use_types {
		if [info exists all_objects($tt)] {
		    foreach obj [lsort -command creation_order_cmp \
				     $all_objects($tt)] {
			if {[info exists writing_ff_grid] && 
			    ([ff_okay_for_object $obj 0] == 2)} continue
			lappend objects $obj
		    }
		}
	    }
	}
    }
    if !$for_auto_mesher {
	set rev ""
	foreach o $objects { set rev [linsert $rev 0 $o] }
	set objects $rev
    }
    if 0 {
	# This is not used and just slows things down
	set nbad 0
	foreach obj $objects {
	    set proc [info command app_okay_to_mesh_[$obj getval obtype]]
	    if {$proc != ""} {
		set nok [$proc $for_auto_mesher $obj]
		if {$nok != ""} {
		    mess $nok\n red
		    incr nbad
		}
	    }
	}
	if $nbad {
	    user_error "There were some problems with the objects (see the message window).  Your mesh may be incorrect."
	}
    }
    return $objects
}

proc adjacent_objects {obj} {
    global grid_mapping reduced_group
    
    set near ""
    foreach g [array names reduced_group] {
	set nobj [lindex $grid_mapping([lindex $g 0]) 0]
	set map $reduced_group($g)
	set obj_for($map) $nobj
	if {$obj == $nobj} { lappend near $map }
    }
    if {$map == ""} { return "" }
    set conn [grid_connectivity]
    set adj [$conn list_adjacent_to_emaps $near [array names obj_for]]
    foreach a $adj {
	set got($obj_for($a)) 1
    }
    return [array names got]
}

proc set_flood_flags_for_shape {shapes which_group {reset 1} {value 1}} {
    global grid_mapping ${which_group}_group full_unstruct
    
    if $reset {
	foreach set [$full_unstruct list_sets] {
	    $set reset_flood_flags
	}
    }
    
    set tot 0
    foreach sh $shapes {
	set var "grid_mapping([$sh get -object] [$sh get -name])"
	if ![info exists $var] continue
	set num [set $var]
	if [info exists "${which_group}_group($num 0)"] {
	    set map [set "${which_group}_group($num 0)"]
	    $map set_all_flags $value
	    incr tot [$map count]
	}
    }
    return $tot
}

proc set_flood_flags_for_shape_faces {shapes which_group {reset 1} {value 1}} {
    global grid_mapping ${which_group}_group full_unstruct
    
    if $reset {
	foreach set [$full_unstruct list_sets] {
	    $set reset_flood_flags
	}
    }
    
    set tot 0
    foreach sh_num $shapes {
	set sh [lindex $sh_num 0]
	set var "grid_mapping([$sh get -object] [$sh get -name])"
	if ![info exists $var] continue
	set num [set $var]
	if {[llength $sh_num] > 1} {
	    lappend use($num) [lindex $sh_num 1]
	} else {
	    set use($num) 0
	}
    }
    foreach dom [array names ${which_group}_group] {
	set dnum [lindex $dom 0]
	if [info exists use($dnum)] {
	    if {[string compare $use($dnum) 0] && ([lsearch $use($dnum) [lindex $dom 1]] < 0)} continue
	    set map [set "${which_group}_group($dom)"]
	    $map set_all_flags $value
	    incr tot [$map count]
	}
    }
    return $tot
}

proc grid_locate_cutouts {} {
    global object_category cutouts_for_solid
    
    set ttol [grid_get_ttol]
    
    catch {unset cutouts_for_solid}
    
    foreach xx {cutout_flat cutout_vol} {
	set found($xx) ""
	if [info exists object_category($xx)] {
	    foreach tt $object_category($xx) {
		foreach obj [db_list_objects_recursive $tt] {
		    foreach sh [db_shapes $obj] {
			switch $xx {
			    cutout_flat {
				# This special-case code for fans 
				# should not be here
				if {([$sh get_volume] == 0) && ([$sh get -name] != "hub2d")} {
				    lappend found($xx) $sh
				}
			    }
			    cutout_vol {
				set fl [$sh get -object]
				
				# It may be fluid but we want to make the 
				# cutout anyway and then remove it below.
				if {([$sh get_volume] != 0) && \
					([$sh get -volume_flag] == 1)} {
				    lappend found($xx) $sh
				}
			    }
			}
		    }
		}
	    }
	}
    }
    set nfcut 0
    if {($found(cutout_flat) != "") && ($found(cutout_vol) != "")} {
	foreach flat $found(cutout_flat) {
	    foreach vol $found(cutout_vol) {
#puts "vol $vol [[$vol get -object] getval name] flat $flat [[$flat get -object] getval name]"
		if {[$vol get -volume_flag] == 2} continue
		set csh [$vol get_cutout $flat $ttol]
#puts $csh
		if {$csh != ""} {
		    lappend cutouts_for_solid($vol) \
			[list $flat $csh cutout$nfcut]
		    lappend cutouts_for_flat($flat) $vol
		    incr nfcut
		}
	    }
	}
    }
    # Now what we have to do is remove the cutouts that overlap with fluid
    # blocks and were created from the same flat object.
    foreach sh [array names cutouts_for_solid] {
	# Maybe we have already deleted this one.
	if ![info exists cutouts_for_solid($sh)] continue
	
	set fl [$sh get -object]

	if {([$fl getval obtype] != "block") || \
		([$fl si_value block_type] != "fluid")} continue

	foreach cut $cutouts_for_solid($sh) {
	    set flat [lindex $cut 0]
	    foreach vol $cutouts_for_flat($flat) {
		set sol [$vol get -object]
		if {([$sol getval obtype] != "block") || \
			([$sol si_value block_type] != "solid") || \
			![info exists cutouts_for_solid($vol)]} continue

		# Blow away the cutouts that correspond to this flat thing.
		set cs ""
		foreach c $cutouts_for_solid($vol) {
		    if {[lindex $c 0] == $flat} {
			mess "Not making a cutout for\
				[[$flat get -object] getval name]\
				with [$sol getval name]\n"
			[lindex $c 1] delete
		    } else {
			lappend cs $c
		    }
		}
		if {$cs == ""} {
		    unset cutouts_for_solid($vol)
		} else {
		    set cutouts_for_solid($vol) $cs
		}
	    }
	    [lindex $cut 1] delete
	    mess "Not making a cutout for [[$flat get -object] getval name]\
		with [$fl getval name] (fluid)\n"
	}
	unset cutouts_for_solid($sh)
    }
}

# Here we look for tetras that have pid 0.  These are ones that were ORFN
# so we need to put material points in.  Put in at most ten new matpoints
# and then rerun the cutter.  This returns a list of {shape x y z}.

proc grid_check_for_junk {file} {
    global family_for_shape tetin_all_shapes domain tetin_do_offset_scale
    global no_low_dim_matpoints tdv_default
    
    if [info exists tetin_do_offset_scale] {
	set tmat $tetin_do_offset_scale
    } else {
	set tmat "1 0 0 0   0 1 0 0   0 0 1 0   0 0 0 1"
    }
    mess "Checking for unassigned mesh elements ...\n"
    
    if [catch {domainfile -name $file -mode r -trans_matrix $tmat} df] {
	mess "Error: the mesher did not create a valid mesh:\n" red
	mess "$df\n" red
	return ""
    }
    if ![$df nnodes] {
	mess "Error: the mesher did not create a valid mesh: 0 nodes\n" red
	$df close; $df delete
	return ""
    }
    
    set ns [nodeset]
    set nnodes [$df nnodes]
    set nodeptr [$df read_nodes]
    $ns set_nodes_ptr 0 $nnodes $nodeptr
    
    # Make an unstruct mesh.
    set uns [unstruct_mesh -nodes $ns]
    
    set nsects [$df nsections]
    for {set s 0} {$s < $nsects} {incr s} {
	set si [$df section_info $s]
	set etype [lindex $si 0]
	set estart [lindex $si 1]
	set eend [lindex $si 2]
	set num [expr {$eend - $estart + 1}]

	switch $etype {
	    HEXA_8 - PENTA_6 - PYRA_5 - TETRA_4 - QUAD_4 - TRI_3 {}
	    default continue
	}
	
	set es [element_set -mesh $uns -type $etype]
	set stuff [$df read_elements $s]
	$es set_elements_ptr 0 $num $stuff 0
	lappend es_type($etype) $es
    }
    set ndomains [$df ndomains]
    set got_dim 0
    for {set d 0} {$d < $ndomains} {incr d} {
	set dname [$df dname $d]
	set utype [$df uns_type $d]
	
	switch $dname {
	    "volume nodes" - "surface nodes" - "curve nodes" - "point nodes" {
		if {$utype != "range"} continue
		set contents [$df uns_contents $d]
		$ns set_node_type [lindex $dname 0] [lindex $contents 0] \
		    [lindex $contents 1] -1
		incr got_dim
	    }
	}
    }
    if !$got_dim {
	foreach t {QUAD_4 TRI_3} {
	    if [info exists es_type($t)] {
		foreach es $es_type($t) {
		    $es set_node_type surface
		}
	    }
	}
    }
    
    set domsh [$domain getval body_shape] 
    set bb [$domsh get_bbox]
    if {$bb == ""} {
	# This is the no-domain case.  Don't put anything out there.
	set bb {{1 1 1} {0 0 0}}
	# [$tdv_default bbox interesting]
    }
    set try_low_dim [expr ![info exists no_low_dim_matpoints]]
    set pts [get_extra_matpoints $uns [lindex $bb 0] [lindex $bb 1] \
		 $tetin_all_shapes $try_low_dim]
    
    foreach es [$uns list_sets] { $es delete }
    $uns delete
    $ns delete
    $df close
    $df delete
    
    return $pts
}

# When we call this the variable tetin_all_shapes will be set to the list of the shapes
# that were written for this subassembly.

proc find_containing_shape_for_created_material {pid} {
    global full_unstruct domain tetin_all_shapes tetin_part_shapes_bbox
    
    set pt [eval $full_unstruct centroid_of_one_volume_element_with_pid $pid \
		$tetin_part_shapes_bbox]
    if {$pt == ""} {
	return ""
    }
    #puts "PID $pid contains $pt"
    
    set domsh [$domain getval body_shape] 
    set bb [$domsh get_bbox]
    if {$bb == ""} {
	# This is the no-domain case.  Don't put anything out there.
	set bb {{1 1 1} {0 0 0}}
    }
    set sh [point_in_what_shape $pt [lindex $bb 0] [lindex $bb 1] \
		$tetin_all_shapes]
    #puts [list point_in_what_shape $pt [lindex $bb 0] [lindex $bb 1] $tetin_all_shapes]
    #puts "yields $sh"
    
    if {$sh == ""} { return "" }
    if {[$sh get -shtype] == "container"} {
	if [[$sh get -object] getval mesh_separate] {
	    return "" ;# since there will be mesh coming from the other asm
	} else {
	    return FLUID ;# it's a regular assembly 
	}
    }
    if {[$sh getval volume_flag] == 0} { return "" }
    return $sh
}

# First we need to go through the mesh and find all quads that are
# sitting on a cutout object, and mark them as not being split.
# Otherwise we would split faces on thin adiabatic plates and defeat
# the purposes of doing the cutout.

proc grid_mark_no_split_faces {} {
    global object_category grid_mapping full_group
    
    if ![info exists object_category(cutout_flat)] return
    
    foreach type $object_category(cutout_flat) {
	foreach obj [db_list_objects $type] {
	    if ![info exists grid_mapping($obj)] continue
	    foreach sh [db_shapes $obj] {
		if [$sh get_volume] continue
		foreach num $grid_mapping($obj) {
		    if ![info exists "full_group($num 1)"] continue
		    set map [set "full_group($num 1)"]
		    $map mark_no_split
		}
	    }
	}
    }
}

# Return an element_map that contains only the default fluid.

proc grid_get_default_fluid_map {} {
    global full_unstruct full_element_set reduced_group
    
    set fluid_map [element_map -mesh $full_unstruct]
    foreach t {hexa penta pyra tetra} {
	if [info exists full_element_set($t)] {
	    $fluid_map add_list_range $full_element_set($t) 0 -1
	}
    }
    foreach key [array names reduced_group] {
	if {[lindex $key 1] == 0} {
	    $fluid_map subtract_other_contents $reduced_group($key)
	}
    }
    return $fluid_map
}

# This returns :
#
# out     if there is no overlap
# in      if the 'i' box is wholly inside the 'o' box
# overlap if there is partial containment of the volume
# touch   if they touch but there is no volume overlap
#
# if tol_f is 1 then it will use the current grid tolerance value

proc object_bbox_check_overlap {omin omax imin imax tol_f} {
    set t [expr [grid_get_ttol] * $tol_f]
    
    set what in
    foreach dim {0 1 2} {
	set o_min [lindex $omin $dim]
	set o_max [lindex $omax $dim]
	set i_min [lindex $imin $dim]
	set i_max [lindex $imax $dim]
	
	#puts "$dim t $t o_min $o_min o_max $o_max i_min $i_min i_max $i_max"
	
	if {($i_max + $t < $o_min) || ($o_max + $t < $i_min)} {
	    #puts out
	    return out
	}
	if {(abs($i_min - $o_max) <= $t) || (abs($i_max - $o_min) <= $t)} {
	    set what touch
	}
	if {($o_min > $i_min + $t) || ($o_max < $i_max - $t)} {
	    if {$what == "in"} { set what overlap }
	}
	#puts $what
    }
    return $what
}

proc find_point_in_mesh {pos} {
    global full_element_set tdv_default job_ptol full_unstruct
    
    set pos [named_point_get $pos]

    if ![info exists full_unstruct] { return "" }
    
    set sm -1
    set bmin [lindex [$full_unstruct get_bbox] 0]
    set bmax [lindex [$full_unstruct get_bbox] 1]
    foreach b1 $bmin b2 $bmax {
	if {($sm < 0) || ($sm > $b2 - $b1)} { set sm [expr $b2 - $b1] }
    }
    
    set scaled_tol [expr $job_ptol * $sm]
    set off [expr $scaled_tol / 100.0]
    foreach offp [list "0 0 0" "$off 0 0" "-$off 0 0" "0 $off 0" "0 -$off 0" \
		      "0 0 $off" "0 0 -$off"] {
	set pt ""
	foreach i $pos j $offp { lappend pt [expr $i + $j] }
	
	foreach ss {hexa tetra penta pyra} {
	    if [info exists full_element_set($ss)] {
#puts "$full_element_set($ss) locate_point $pt $scaled_tol"
		set elno [$full_element_set($ss) locate_point $pt $scaled_tol]
#puts "res $elno"
		if {$elno != ""} { return [list $elno $full_element_set($ss)] }
	    }
	}
    }
    return ""
}

proc grid_vector_to_nearest_centroid {pos} {
    set res [find_point_in_mesh $pos]
    if {$res == ""} { return "0 0 0" }
    set cent [[lindex $res 1] element_center [lindex $res 0]]
    set dif ""
    foreach a $cent b $pos {
	lappend dif [expr $a - $b]
    }
    return $dif
}

proc get_shape_volume_from_mesh {sh} {
    global reduced_group grid_mapping
    
    if ![reload_or_generate_grid] { return 0 }
    
    set sh_volume 0.0
    if [info exists grid_mapping($sh)] {
	foreach p $grid_mapping($sh) {	
	    if [info exists "reduced_group($p 0)"] {
		set m [set "reduced_group($p 0)"]	
		set sh_volume [expr $sh_volume + [$m get_volume]]
	    }
	}
    }

    return $sh_volume
}

proc get_object_volume_from_mesh {obj} {
    global reduced_group grid_mapping
    
    if ![reload_or_generate_grid] { return 0 }
    
    set obj_volume 0.0
    if [info exists grid_mapping($obj)] {
	foreach p $grid_mapping($obj) {
	    if [info exists "reduced_group($p 0)"] {
		set m [set "reduced_group($p 0)"]	
		set obj_volume [expr $obj_volume + [$m get_volume]]
	    }
	}
    }
    return $obj_volume
}

proc get_object_area_from_mesh {obj} {
    global reduced_group grid_mapping
    
    if ![reload_or_generate_grid] { return 0 }
    
    set obj_area 0.0
    if [info exists grid_mapping($obj)] {
	foreach n $grid_mapping($obj) { set use($n) 1 }
	foreach g [array names reduced_group] {
	    if {[info exists use([lindex $g 0])] && [lindex $g 1]} {
		set obj_area [expr $obj_area + [$m get_area]]
	    }
	}
    }
    return $obj_area
}

proc reload_or_generate_grid {} {
    global full_unstruct
    
    if {![info exists full_unstruct] || [db_check_dirty mesh]} {
	if {[should_reload_grid]} {
	    mess "Loading existing grid ...\n"
	    grid_reload 0 "" full 0
	} else {
	    mess "Mesh is out of date -- recreating ...\n"
	    grid_generate
	}
    }
    return [info exists full_unstruct]
}

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

proc grid_make_wire_groups {} {
    global grid_mapping full_group reduced_group full_element_set
    global full_unstruct full_nodeset
    
    set conn [grid_connectivity]
    
    set done 0
    foreach sh [array names grid_mapping] {
	set num $grid_mapping($sh)
	if ![string match shape_pipe__* $sh] continue
	if [info exists "full_group($num 1)"] continue
	
	if ![info exists full_element_set(bar)] {
	    set full_element_set(bar) [element_set -mesh $full_unstruct \
					-type BAR_2]
	}
	if ![info exists full_element_set(node)] {
	    set full_element_set(node) [element_set -mesh $full_unstruct \
					 -type NODE]
	}
	
	set em [element_map -mesh $full_unstruct]
	set "full_group($num 1)" $em
	
	set nv [$sh getval nverts]
	if {$nv < 2} {
	    set node [$full_nodeset closest_node_to_point [$sh getval vert1]]
	    set el [$full_element_set(node) create_element 1 $node]
	    $em add_list_numbered $full_element_set(node) $el
	} else {
	    set nodes ""
	    set prev [$sh getval vert1]
	    for {set i 2} {$i <= $nv} {incr i} {
		set cur [$sh getval vert$i]
		set nodes1 [$conn closest_nodes_to_line $prev $cur]
		#puts "$conn closest_nodes_to_line $prev $cur -> $nodes1"
		set nodes [concat $nodes $nodes1]
		set prev $cur
	    }
	    set nn [llength $nodes]
	    set pn [lindex $nodes 0]
	    for {set i 1} {$i < $nn} {incr i} {
		set cn [lindex $nodes $i]
		if {$pn != $cn} {
		    set el [$full_element_set(bar) create_element 1 $pn $cn]
		    $em add_list_numbered $full_element_set(bar) $el
		    set pn $cn
		}
	    }
	}
	set em2 [element_map -mesh $full_unstruct]
	$em2 add_other_contents $em 1
	set "reduced_group($num 1)" $em2
	
	incr done
    }
    if $done {
	grid_invalidate_connectivity
    }
}

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

proc grid_export_ideas {} {
    global bindir full_unstruct domain export_color_this_object
    global grid_mapping reduced_group domain_family_pid
    
    set objs ""
    foreach obj [db_list_objects_recursive] {
        if {$obj == $domain} continue
        set vol 0
        foreach sh [db_shapes $obj] {
            set vol [expr $vol + [$sh get_volume]]
        }
        if {($vol > 0) && [info exists grid_mapping($obj)]} {
            set n [$obj getval name]
            set obj_for($n) $obj
            lappend objs $n
            if ![info exists export_color_this_object($n)] {
                set export_color_this_object($n) 1
            }
        }
    }
    if {$objs != ""} {
	tree_standalone_model_form .export_object grid_export_ideas_get \
	    grid_export_ideas_set volume "IDEAS export" \
	    "Select the objects to color differently"
    }
    set file [file_selection -default [directory]/grid.ideas -title \
                  "IDEAS neutral file" -new_ok 1 -warn_overwrite 1]
    if {$file == ""} return
   
    set fp [open [directory]/family_boco_dummy w]
    puts $fp "\"DEFAULT\" \"COLOR\" \"\" 1"
    puts $fp "\"SPECIAL\" \"COLOR\" \"\" 9"
    close $fp
   
    foreach set [$full_unstruct list_sets] {
        $set set_pids 0 -1 1
    }
    foreach n $objs {
        if $export_color_this_object($n) {
            foreach n $grid_mapping($obj_for($n)) {
                if [info exists "reduced_group($n 0)"] {
                    [set "reduced_group($n 0)"] set_pids 2 -1
                }
            }
        }
    }
    
    catch {unset domain_family_pid}
    save_domain [directory]/grid_export full reduced
   
    set cmd [list $bindir/ideas -dom [directory]/grid_export \
                 -b [directory]/family_boco_dummy -ucolor $file]
    set retval [run_background $cmd "" 1]
    mess "$file written.\n"
}

proc grid_export_ideas_get {type name} {
    global export_color_this_object
    return [expr {[info exists export_color_this_object($name)] &&
		  $export_color_this_object($name)}]
}
	
proc grid_export_ideas_set {type name val} {
    global export_color_this_object
    set export_color_this_object($name) $val
}

proc grid_export_ansys {} {
    global bindir full_unstruct domain env
    global grid_mapping reduced_group full_unstruct
   
    set file [file_selection -default [directory]/grid.ansys -title \
                  "ANSYS file" -new_ok 1 -warn_overwrite 1]
    if {$file == ""} return
    
    save_domain [directory]/grid_export full reduced
    
    set fp [open [directory]/ansys.par w]
    puts $fp {
begin ansys_product
    type ST
    anal_type STATIC
    solv_type NONE
    type1 ST
    type2 TH
    coupled 0
    exit_opt 0
    exit_save SOLU
    begin ST
	solv_type SPARSE
	solv_tol 1.0E-08
	solv_mult 1.0
	anal_type None
	NLGEOM OFF
	NSUBST 1
	mod_solv LANB
	mod_n 1
	freq 0.0
	freq2 1.0E+08
	mod_norm 0
	mod_ce 0
	mod_expec 0
    end ST
    proc_n 1
end ansys_product
    }
    close $fp
    
    set fp [open [directory]/ansys.fbc w]
    foreach n [$full_unstruct family_stats] {
	if [lindex $n 0] {
	    puts $fp "\"FAM[lindex $n 0]\""
	}
    }
    close $fp
    
    set env(ICEM_NO_LICENSE_CHECK) 1
    set cmd [list $bindir/ansys -dom [directory]/grid_export -par \
		 [directory]/ansys.par -b [directory]/ansys.fbc $file]
    set retval [run_background $cmd "" 1]
    mess "$file written.\n"
}

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

proc grid_error_report {command output args} {
    set stuff "\nCommand: $command\n\nOutput:\n$output\n\n"
    foreach f $args {
	append stuff "Contents of $f ----------------------------------\n\n"
	if [catch {open $f} fp] {
	    append stuff "**** $fp ****\n"
	} else {
	    append stuff [read $fp]
	    close $fp
	}
	append stuff "\n\n"
    }
    catch {interrupt finish}
    tkerror_report $stuff 1 "The mesher has failed to produce a grid for this geometry.\n\n"
}


proc convert_grid_meshing_units_params { varname oval val } {
    global unit_data
    global grid_size_x grid_size_y grid_size_z grid_size_h
    global grid_mesher_params grid_tetra_params
    
    # meshing options: auto(hexa_cart OR hexa_uns)/tetra/global/hexa
    # each have different meshing params to set
    foreach i { grid_size_x grid_size_y grid_size_h grid_size_z grid_mesher_params(max_ogrid) grid_tetra_params(tetra_size_on_curves) grid_tetra_params(tetra_size_on_surfs) } {
	upvar \#0 $i ival
	set $i [unit_convert $ival $oval 0]
	set $i [unit_convert $ival $val 1]
    }
}

proc perobject_form_done_cmd {} {
    if {[winfo exists .perobject_params]} {form_done .perobject_params}
}
