 
# Stuff to run the mesher.  This does not include any of the code that
# handles the mesh after it has been loaded, or the mesher form.
#
# Copyright (c) 1993, 1994 Pacific Marketing and Consulting
# Author:  Wayne A. Christopher, wayne@pmac.com
#          Pacific Marketing and Consulting, Berkeley, California
#

proc grid_set_type_auto {} {
    global grid_type grid_qual model_container type_name

    set grid_type auto

    foreach sh [[$model_container getval body_shape] list] {
	if {![$sh get -visible] || ![[$sh get -object] si_value active]} continue
	# don't warn about pipe 
	switch [$sh get -shtype] {
	    sphere - cad {
		set tn [$sh get -shtype]
		if [info exists type_name($tn)] { set tn $type_name($tn) }
		user_error "This model contains $tn objects, and\
			can't be meshed with the automatic Hexa mesher at this\
			time.  Please use the Tetra mesher."
		return 1
	    }
	    polygon {
		if {[$sh getval plane] == -1} {
		    user_error "This model contains non-axis-aligned polygons, and\
			can't be meshed with the automatic Hexa mesher at this\
			time.  Please use the Tetra mesher."
		    return 1
		}
	    }
	}
    }

    grid_set_default_sizes
    return 0
}

proc grid_edit_unit_form {d geo} {
    global allow_wavelength_units meshing_frequency_value

    if !$meshing_frequency_value {
	set meshing_frequency_value 1
	set meshing_frequency_scale GHz
    }

    form_frame $d flat 0 $geo
    form_label $d.l "Units for meshing values" {0 0}
    futil_unitmenu $d.u "unit_get_choices length wavlen" {0 1} meshing_units \
	"" "set_planecut_units 0; list"
#    $d.u_units configure -width 6

    if [info exists allow_wavelength_units] {
	form_label $d.fl "Frequency for meshing" {1 0} \
	    {{meshing_units wavlen}}
	form_entry $d.f meshing_frequency_value float {1 1} \
	    {{meshing_units wavlen}}
	futil_unitmenu $d.ft "list GHz MHz KHz Hz" {1 2} \
	    meshing_frequency_scale {{meshing_units wavlen}}
    }
}

proc edit_grid_auto {d} {
    global auto_debug grid_allow_convert_multi

    #grid_edit_unit_form $d.units {2 0 -cols -}

    form_checkbutton $d.usex "Max X size" grid_usesize_x {3 0}
    form_checkbutton $d.usey "Max Y size" grid_usesize_y {4 0}
    form_checkbutton $d.usez "Max Z size" grid_usesize_z {5 0}
    form_checkbutton $d.useh "Init height" grid_usesize_h {6 0}

    form_checkbutton $d.usep "Object params" grid_perobject {3 2 -cols 2}
    form_button $d.editp "Edit ..." grid_edit_perobject_params \
	{3 4} grid_perobject
    form_entry $d.x grid_size_x float {3 1} grid_usesize_x
    form_entry $d.y grid_size_y float {4 1} grid_usesize_y
    form_entry $d.z grid_size_z float {5 1} grid_usesize_z
    form_entry $d.h grid_size_h float {6 1} grid_usesize_h

    form_label $d.ttl "Minimum gap:" {4 2}
    form_label $d.ttxl "X" {4 3}
    form_label $d.ttyl "Y" {5 3}
    form_label $d.ttzl "Z" {6 3}
    
    model_unitentry $d.ttx grid_sep_x length {4 4} "" 8 grid_sep_x_units 1 model_size
    model_unitentry $d.tty grid_sep_y length {5 4} "" 8 grid_sep_y_units 1 model_size
    model_unitentry $d.ttz grid_sep_z length {6 4} "" 8 grid_sep_z_units 1 model_size

    foreach i {x y z h ttx tty ttz} { $d.$i configure -width 6 }
    
    form_checkbutton $d.acc "Accept \"change value\" checks" grid_accept_all_minval_changes \
	{7 2 -cols 3}
    
    if [info exists grid_allow_convert_multi] {
	form_checkbutton $d.multi "Convert to multi-block" \
	    grid_convert_multi {8 0 -cols -}
    }

    form_rowheight $d 9 2

    set pp [form_label_frame $d.params "Global settings" {10 0 -cols - -sticky w}]
    grid_edit_parameters $pp
}

# This returns the equivalent of the old job_ttol value in SI.  Now there are separate
# X Y and Z values for this number.  Return the min value of all 3.

proc grid_get_ttol {{part ""} {dir ""}} {
    set min 0
    foreach i {x y z} n {0 1 2} {
	if {($dir != "") && ($i != $dir)} continue
	if {$part == ""} {
	    global grid_sep_$i grid_sep_${i}_units
	    set val [unit_convert [set grid_sep_$i] [set grid_sep_${i}_units] 0]
	} else {
	    set val [lindex [grid_get_sepvals $part] $n]
	}
	if {!$min || ($val < $min)} { set min $val }
    }
    return $min
}

proc grid_get_ttol_units {{part ""} {dir ""}} {
    if {$dir == ""} { set dir x }
    
    global grid_sep_${dir}_units
    
    if {$part == ""} {
	return [set grid_sep_${dir}_units]
    } else {
	return [$part getunits grid_sep_${dir}]
    }
}

# If we are looking at part $from_part it returns the X Y Z sepvals active at this point,
# together with the part that actually provided each of them

proc grid_get_sepvals {from_part} {
    set sep ""
    set parts ""
    foreach i {x y z} {
	set val 0
	for {set p $from_part} {$p != ""} {set p [$p get -model_container]} {
	    if {([$p getval obtype] == "part") && [$p getval mesh_separate] \
		    && [$p si_value grid_sep_$i]} {
		set val [$p si_value grid_sep_$i]
		break
	    }
	}
	if !$val {
	    global grid_sep_$i grid_sep_${i}_units
	    set val [unit_convert [set grid_sep_$i] [set grid_sep_${i}_units] 0]
	    set p ""
	}
	lappend sep $val
	lappend parts $p
    }
    return [concat $sep $parts]
}

proc grid_edit_parameters {d} {
    global use_nonconformal_meshing app_name object_type_title
    global form_label_text

    form_label $d.settingsl "Mesh parameters" {0 0}
    futil_menuentry_labels $d.settings grid_settings_type \
	{list {normal Normal} {coarse Coarse}} {0 1} "" \
	{grid_set_defaults $grid_settings_type 1;grid_update_type_specific} 6
    # grid_update_type_specific is necessary because grid_set_defaults updates 
    # grid_mesher_params(cartesian) - and hence the active variables below
    # without checking the
    # mesh type chosen/displayed through "grid_type_specific"
    
    set notcart !grid_mesher_params(cartesian)

    form_label $d.mingapl "Min elems in gap" {1 0}
    form_label $d.minblockl "Min elems on edge" {2 0}
    form_label $d.maxratl "Max size ratio" {3 0}
    form_label $d.maxol "Max O-grid height" {4 0} $notcart
    form_label $d.mincyll "Min elems on cyl face" {5 0}
    form_label $d.mintril "Min elems on tri face" {6 0}
    form_label $d.cshrl "Cylinder shrink factor" {7 0}
    form_label $d.maxell "Max elements" {9 0}

    form_entry $d.mingap grid_mesher_params(min_elements_gap) int {1 1} \
	"" 8
    form_entry $d.minblock grid_mesher_params(min_elements_block) int {2 1} \
	"" 8
    form_entry $d.maxrat grid_mesher_params(max_ratio) float {3 1} \
	"" 8
    form_entry $d.maxo grid_mesher_params(max_ogrid) float {4 1} \
	$notcart 8
    form_entry $d.mincyl grid_mesher_params(min_cylinder_face) int {5 1} \
	"" 8
    form_entry $d.mintri grid_mesher_params(min_triangle_face) int {6 1} \
	"" 8
    form_entry $d.cshr grid_mesher_params(cyl_shrink_factor) float {7 1} \
	"" 8
    form_entry $d.maxel grid_max_elements int {9 1} \
	"" 8

    form_checkbutton $d.noog "No O-grids" \
	grid_mesher_params(no_ogrids) {1 2} $notcart
    form_checkbutton $d.nogog "No group O-grids" \
	grid_mesher_params(no_group_ogrids) {2 2} $notcart
    if [info exists use_nonconformal_meshing] {
	if 0 {
	    form_checkbutton $d.conf "Conformal" \
		grid_mesher_params(conformal) {3 2} !grid_mesh_parts_separate
	}
	set partsn [string tolower $object_type_title(part)]
	set lab "Mesh $partsn\n    separately"
	set var "form_label_text(Mesh assemblies separately)"
	if [info exists $var] { set lab [set $var] }
	form_checkbutton $d.mps $lab grid_mesh_parts_separate {4 2 -rows 2}
	form_checkbutton $d.difft "Allow different\nsubgrid types" \
	    grid_different_subgrid {6 2} grid_mesh_parts_separate
    }
}

proc grid_set_default_sizes {} {
    global grid_set_default_sizes batch_mode
    global grid_usesize_x grid_usesize_y grid_usesize_z
    global grid_size_x grid_size_y grid_size_z
    global domain meshing_units tdv_default

    if {$grid_set_default_sizes || $grid_usesize_x || \
	    $grid_usesize_y || $grid_usesize_z} return

    if $batch_mode {
	set bb [[$domain getval body_shape] get_bbox]
    } else {
	set bb [$tdv_default bbox interesting]
	if {$bb == ""} return
    }
    foreach i {0 1 2} {
	set sz [expr [lindex [lindex $bb 1] $i] - [lindex [lindex $bb 0] $i]]
	set x [lindex {x y z} $i]
	set grid_usesize_$x 1
	set u $meshing_units
	set grid_size_$x [unit_convert [expr $sz / 20.0] $u 1]
    }
    
    if {$grid_size_x != 0 && $grid_size_y != 0  && $grid_size_z != 0 } {
	mess "Defined default sizes to be 1/20 of the total.\n"
    } else {
 	set grid_size_x [unit_convert [expr 1.0 / 20.0] $u 1]
	set grid_size_y [unit_convert [expr 1.0 / 20.0] $u 1]
	set grid_size_z [unit_convert [expr 1.0 / 20.0] $u 1]
	mess "In absence of geometry, defined default sizes to be 1/20th of the default meshing unit.\n"
    }
    set grid_set_default_sizes 1
}

proc creation_order_cmp {obj1 obj2} {
    set c1 [$obj1 getval creation_order]
    set c2 [$obj2 getval creation_order]
    return [expr {$c1 - $c2}]
}

proc objname_cmp {obj1 obj2} {
    set c1 [$obj1 getval name]
    set c2 [$obj2 getval name]
    return [family_name_compare -1 $c1 $c2]
}

proc grid_runonce_auto {gfile mfile efile pfile mapfile do_part suff inc_others} {
    global mesher_path whoami grid_mapping job_scratch
    global no_run_mesher grid_objects_highlighted domain
    global no_exit_job model_attachment
    global grid_usegraphics grid_editinput type_name
    global grid_current_prefix grid_line_list error_report
    global grid_dont_remove_temp grid_max_elements
    global run_background_last_output writing_ff_grid
    global mesher_was_terminated run_background_diag_info
    global run_uncouple_after_mesher uncouple_path domain
    global dont_pause_on_warnings batch_mode
    global is_iceboard grid_mesh_parts_separate

    set grid_current_prefix ""
    
    if ![file executable $mesher_path] {
	mess "Error: the mesher binary could not be found!\n" red
	mess "Path = $mesher_path\n"
	return 0
    }
    
    vmess "Writing grid input to file \"$gfile\" ...\n"
    busy 1
    
    set r [grid_write_input $gfile $do_part $suff $inc_others 1]
    
    busy 0
    if !$r { return 0 }
    
    grid_write_mapping $mapfile $suff
    
    cmd_rm $mfile
    if [file exists $mfile] {
	user_error "Can't remove the file $mfile before running mesher --\
               please check the permissions on the directory [directory mesh]"
	return
    }
    cmd_rm $efile
    
    if [info exists no_run_mesher] {
	mess "Not running mesher\n" red
	return 0
    }
    
    set scr $job_scratch
    if {$scr == "jobdir"} { set scr [directory tmp] }

    if $grid_editinput {
	edit_file $gfile 0
    }
    
    mess "Running mesher...\n"
    set no_exit_job mesher
    set cmd [list $mesher_path $gfile $mfile -errors $efile \
		 -params $pfile -temp_dir $scr]
    if $grid_usegraphics { lappend cmd -graphics }
    if $grid_max_elements { lappend cmd -max_element $grid_max_elements }
    
    set retval [run_background $cmd "" 1]
    
    unset no_exit_job
    
    if {![info exists grid_dont_remove_temp] || !$grid_dont_remove_temp} {
	set temps [glob_fixed $scr/temp_node.* $scr/temp_hex.* \
		       $scr/temp_quad.*]
	if {$temps != ""} { eval cmd_rm $temps }
    }
    
    # Now clean up the temp files which may be there on Windows.
    cmd_rm $scr/temp_*
    
    if [info exists mesher_was_terminated] { return 0 }
    
    if ![file exists $efile] {
	mess "Couldn't run mesher -- please check to make sure you have\
		enough disk space and that the file \"$mesher_path\"\
		exists.\n" red
	return 0
    }
    
    set ncoup [domain_check_structured_couplings $mfile]
    if [lindex $ncoup 0] {
	mess "[lindex $ncoup 0] structured couplings found: [lindex $ncoup 1] faces on the coarse sides and [lindex $ncoup 2] faces on the fine sides\n"
	
	if {[info exists run_uncouple_after_mesher] &&
	    $run_uncouple_after_mesher && ($uncouple_path != "not_found")} {
	    if [interrupt update 0.5 "Resolving structured non-conformal regions"] { return 0 }
	    
	    cmd_rename $mfile $mfile.with_couplings
	    set cmd [list $uncouple_path $mfile.with_couplings $mfile -three]
	    set retval [run_background $cmd "" 1 "" [list "template*not supported"]]
	    if {!$retval || [lindex [domain_check_structured_couplings $mfile] 0]} {
		mess "possible problem removing structured non-conformal regions\n" red
		#return 0
		set retval 1
	    }
	}
    }
    
    if {$is_iceboard && ($suff == "") && $grid_mesh_parts_separate} {
	# We can ignore all the errors here since stuff is all masked out by the asms
	return $retval
    }
    
    set not_in_mesh 0
    set delta_between 0
    set report_error [expr !$retval]

    set fp [open $efile r]
    while {![eof $fp]} {
	set line [gets $fp]
	if ![llength $line] continue
	set what [lindex $line 0]
	set num [lindex $line 1]
	set mess [lrange $line 2 end]
	set highlight 0
	set obj ""
	
	set desc [grid_object_description $num]
	
	if {[string match "*writing*to temp file*" $mess] || \
		[string match "*error*writing*to file*" $mess]} {
	    user_error "You have run out of disk space to write the mesh. \
		Please free some up and try again."
	    set report_error 0
	    continue
	}
	if {[string match "*mesh too big*" $mess] || \
	    [string match "*failed to allocate*bytes*" $mess] || \
	    [string match "*mesh*larger*memory*" $mess]} {
	    user_error "$mess\nThe mesh you requested is too big for this machine.  Please make it coarser (make the maximum sizes larger) and try again."
	    set report_error 0
	    continue
	}
	
	# These should be ignored.
	set ign 0
	foreach mm {
	    "no deform for object"
	    "object obscured by object"
	    "object mesh exceeds bounds"
	    "object outside of domain ignored"
	    "object is hollow and faces covered by"
	    "only*elements in gap"
	} {
	    if [string match "*$mm*" $mess] { set ign 1; break }
	}
	if $ign continue
	
	# In case the error message references two objects, fix the second one.
	if [regexp {object [0-9]+} $mess ob] {
	    set objdesc [grid_object_description [lindex $ob 1]]
	    regsub $ob $mess $objdesc mess
	}
	switch $what {
	    ERROR {
		mess "Error: $desc: $mess\n" red
		set highlight 1
		set retval 0
		append run_background_last_output "Error: $desc: $mess\n"
		
		if [string match "*object straddles boundary*" $mess] {
		    user_error "One or more objects are outside the cabinet\
			or otherwise placed in an incorrect position.  Please\
			fix them and try again."
		    set report_error 0
		}
		if {[string match "*max element count exceeded*" $mess] ||
		    [string match "*mesh too big*" $mess]} {
		    user_error "Your mesh is larger than the Max element\
			count value you have specified.  Either increase\
			that value, or modify the model to make a smaller\
			mesh."
		    set report_error 0
		}
		if [string match "*identical points for poly*" $mess] {
		    user_error "The polygonal $desc has 2 or more points on\
			top of each other.  Please delete one of the points\
			or move it so that every point is different."
		    set report_error 0
		}
 		foreach m {
 		    "cylinder sections cross each other"
		    "degenerate"
		    "is way too small"
 		} {
 		    if [string match "*$m*" $mess] {
 			user_error $mess
 			set report_error 0
 			break
 		    }
 		}
	    }
	    WARNING {
		if {[string match "*start face*" $mess] ||
		    [string match "*end face*" $mess]} continue
		
		if [string match "*not in mesh*" $mess] {
		    if {$suff != ""} {
			# we expect a lot of these
			continue
		    }
		    if {$desc == "block \"BOARD_OUTLINE.1\""} {
			# This one is expected to be not in the mesh since the
			# two assemblies cover it entirely
			continue
		    }
		    incr not_in_mesh
		}
		if [string match "*between*" $mess] { incr delta_between }
		mess "Warning: $desc: $mess\n" red
		append run_background_last_output "Warning: $desc: $mess\n"
	    }
	    default {
		if [string match *(*)* $line] continue
		mess "Mesher output: $line\n" red
		append run_background_last_output "$line\n"
	    }
	}
	
	if {$highlight && ($obj != "")} {
	    graph_highlight $obj 1
	    lappend grid_objects_highlighted $obj
	}
    }
    close $fp
    
    if [info exists writing_ff_grid] {
	# don't worry about it here
	set not_in_mesh 0
    }
    
    if $not_in_mesh {
	set mess "There was a problem with the mesh generator and some\
		objects were not recognized or meshed (see the message\
		window).\n\nThis is often because a block is inside of a\
		hollow block of higher priority and is therefore ignored. \
		Please check this and if it is the case you could deactivate\
		or delete that block to avoid getting this warning.\n\nIf it\
		is not the case please contact technical support."
	if {[info exists dont_pause_on_warnings] || $batch_mode} {
	    mess "$mess\nGoing ahead anyway since trials are being run.\n" red
	    set retval 1
	} else {
	    set retval [tk_dialog .not_in_mesh "Mesh problem" $mess "" -1 \
			    Cancel Continue]
	}
	set report_error 0
    }
    if $delta_between {
	mess "The above warnings indicate that you have some small gaps\
		in the model, which may be contributing to a high mesh size. \
		They are larger than the minimum gap tolerance specified, but\
		if you are looking for ways to make the mesh smaller, this\
		would be a place to check.\n"
    }
    if {$report_error && [info exists error_report]} {
	set mdate [exec $mesher_path -date]
	grid_error_report $cmd "$mdate\n$run_background_diag_info$run_background_last_output" $gfile $gfile $gfile
    }
    
    return $retval
}

proc grid_convert_multiblock {} {
    global full_element_set hexa_path mesh2block_path
    
    if ![grid_has_only_hexas] {
	mess "Error: this mesh has non-HEXA's in it so it can't\
		be converted to multiblock\n" red
	return
    }
    
    auto_bocos_setpids
    set dom [directory domain]/auto_domain.1
    mess "Saving unstructured domain $dom ...\n"
    save_domain $dom full reduced
    auto_save_tetin
    mess "Running mesh2block ...\n"
    
    set tetin [directory tetin]/tetin1
    set block [directory tetin]/__temp_blocking__
    set hex_in [directory tetin]/hex_in
    
    cmd_rm [directory tetin]/topo_mulcad_out
    
    set cmd [list $mesh2block_path -d [directory domain] -a \
		 $tetin $dom $block]
    set retval [run_background $cmd "" 1]
#    if !$retval { return }
    
    set fp [open $hex_in w]
    puts $fp "restore_blocking __temp_blocking__"
    puts $fp "update_association root"
    puts $fp "auto_merge"
    #puts $fp "renew"
    puts $fp "multi_block proj 2"
    puts $fp "quit"
    close $fp
    
    mess "Running hexa ...\n"
    set cmd [list $hexa_path [file dirname [directory]] \
		 -tetin $tetin -i $hex_in]
    set retval [run_background $cmd "" 1]
#    if !$retval { return }
    
    mess "All done!\n"
}

proc grid_smooth_auto {} {
    auto_bocos_setpids
    set dom [directory domain]/auto_domain.1
    mess "Saving unstructured domain $dom ...\n"
    save_domain $dom full reduced
    auto_save_tetin
}

proc grid_load_params {pfile ifgreater map_group_numbers_to} {
    global grid_param_list grid_line_length grid_mapping full_group

    set fp [open $pfile r]
    
    array set map_group $map_group_numbers_to
    
    while {![eof $fp]} {
	set line [gets $fp]
	set ll [llength $line]
	set num [lindex $line 1]
	
	if {($num == "") || ([lindex $line 0] == "#")} continue
	if !$num {
	    set nline [lrange $line 0 7]
	    lappend nline 0
	    foreach i {8 9 10 11 13 15 17 19 21 12 14 16 18 20 22} {
		lappend nline [lindex $line $i]
	    }
	    lappend nline 0 0
	    set line $nline
	}
	
	if [info exists map_group($num)] {
	    set num $map_group($num)
	} else {
	    #puts "no mapping was found for $num"
	}
	
	if ![info exists grid_mapping($num)] {
	    puts "No such object numbered $num was written"
	    continue
	}
	
	set obj [lindex $grid_mapping($num) 0]
	set sect [lindex $grid_mapping($num) 1]
	set spec [lindex $grid_mapping($num) 2]
	
	if {($obj == "") || ($spec != "") || \
		[string match cutout* $sect]} continue
	
	if [$obj checkval ${sect}_shape] {
	    set shape [$obj getval ${sect}_shape]
	} else {
	    set shape [$obj getval body_shape]
	}
	if {$shape == ""} {
	    user_error "Something has changed in the model since this grid was created.  It's probably not valid any more - please re-generate it."
	    close $fp
	    return
	}
	
	if {([lindex $line 0] == "hexa") &&
	    ([$shape get -shtype] == "polygon")} {
	    # This is a hack.  We need to fix some mappings based on the
	    # fact that this was a polygon when it went in but it is a 
	    # hexa when it comes out.
	    set pl [$shape getval plane]
	    catch {unset ng}
	    foreach p {1 2 3 4 5 6} {
		set nn [expr ($pl * 2 + $p - 1) % 6 + 1]
		if [info exists "full_group($num $nn)"] {
		    set ng($p) [set "full_group($num $nn)"]
		    unset "full_group($num $nn)"
		}
	    }
	    foreach p [array names ng] {
		set "full_group($num $p)" $ng($p)
	    }
	}
	if [catch {eval $shape mesher_params $line}] {
	    #mess "Warning: couldn't get the mesh params from [$obj getval name]\n" red
	}
    }
    close $fp
}

proc grid_write_input {gfile do_part suff inc_others for_auto_mesher} {
    global whoami grid_mapping domain job_name grid_perobject
    global grid_mapcount model_attachment tdv_default
    global grid_current_prefix grid_line_list
    global grid_mesher_params meshing_units
    global grid_coupling_walls grid_coupling_cutouts grid_coupling_otherparts
    global grid_mesh_parts_separate grid_dont_round
    global grid_always_ignore_outside
    
    # Just disable this.  Uncouple doesn't work yet.
    set grid_mesher_params(conformal) 1
    
    if {$grid_mesh_parts_separate || $grid_mesher_params(cartesian)} {
	set grid_mesher_params(conformal) 1
    }
    
    if {$grid_mesher_params(max_ratio) <= 1} {
	user_error "Can't run mesher: the max size ratio parameter must be > 1"
	return 0
    }

    set fp [open $gfile w]
        
    puts $fp "# Grid file for project \"$job_name\""
    puts $fp "# Written on [cmd_date], by $whoami"
    puts $fp "# User: [cmd_whoami]@[cmd_uname_n]"
    puts $fp ""
    
    catch {unset grid_mapping}  ;# is this okay?  hope so *****
    
    catch {unset grid_line_list}
    catch {unset grid_mesher_params(max_elements)} ;# temporary glitch
    if {[array names grid_mesher_params] != ""} {
	set p params
	foreach pn [array names grid_mesher_params] {
	    if {[string match ignore_* $pn] || ($pn == "conformal_tol")} continue
	    if {[lsearch {no_group_ogrids no_ogrids cartesian} $pn] >= 0} {
		if !$grid_mesher_params($pn) continue
	    }
	    
	    lappend p $pn
	    if {$pn == "max_ogrid"} {		
		lappend p [unit_convert $grid_mesher_params($pn) $meshing_units 0]
	    } else {
		lappend p $grid_mesher_params($pn)
	    }
	}
	lappend p jump_factor 3 ;# for uncouple to work
	if {($do_part != "") || [info exists grid_always_ignore_outside]} {
	    lappend p ignore_outside 1
	}
	lappend grid_line_list $p
    }
    
    if {$do_part == ""} {
	set domsh [db_get_shape $domain]
    } else {
	set domsh [db_get_shape $do_part]
    }
    set domh [$domsh get -grid_height]
    set domr [$domsh get -grid_ratio]
    
    set ign [expr {!$grid_perobject || ![$domsh get -grid_enabled] || \
		       $grid_mesher_params(ignore_perobject)}]
    
    set real_domain_shape [db_shapes $domain]
    if {$real_domain_shape != ""} {
	set b [$real_domain_shape get_bbox]
	set real_start [lindex $b 0]
	set real_end [lindex $b 1]
    } else {
	set real_start ""
	set real_end ""
    }
    
    foreach s {sx sy sz sh} v [grid_get_sizes $do_part] { set $s $v }
    
    if {$do_part == ""} {
	foreach i {1 2 3 4 5 6} {
	    if $ign {
		set h$i 0; set r$i 0
	    } else {
		set h$i [lindex $domh [expr $i - 1]] 		
		set r$i [lindex $domr [expr $i - 1]] 
		if {[set h$i] == ""} { set h$i 0 }
		if {[set r$i] == ""} { set r$i 0 }
	    }
	}
    } else {
	set doml [$domsh get -grid_length]
	foreach i {x y z} p {3 4 5} {
	    set s [lindex $doml $p]
	    if {($s != "") && !$ign} {
		set s [unit_convert [lindex $doml $p] $meshing_units 0]
		if $s { set s$i $s }
	    }
	}
	
	foreach i {1 2 3 4 5 6} {
	    if $ign {
		set h$i 0; set r$i 0
	    } else {
		set h$i [lindex $domh [expr $i + 5]] 
		set r$i [lindex $domr [expr $i + 5]] 
		if {[set h$i] == ""} { set h$i 0 }
		if {[set r$i] == ""} { set r$i 0 }
	    }
	}
    }
    
    set hollow_boxes ""
    if {[$domsh get -shtype] == "none"} {
	set bb [$tdv_default bbox interesting]
	if {$bb == ""} { return 0 }
	set min [lindex $bb 0]; set max [lindex $bb 1]
	set start ""; set end ""
	foreach i {0 1 2} {
	    set d [expr [lindex $max $i] - [lindex $min $i]]
	    lappend start [expr [lindex $min $i] - $d * 0.5]
	    lappend end [expr [lindex $max $i] + $d * 0.5]
	}
	
    } else {
	set bb [$domsh get_bbox]
	set start [lindex $bb 0]
	set end [lindex $bb 1]
    }
    
    set dist 0
    foreach i {0 1 2} {
	set d [expr [lindex $end $i] - [lindex $start $i]]
	set dist [expr {$dist + $d * $d}]
    }
    set dist [expr sqrt($dist)]
    if {($sh > 0) && ($sh < $dist * 1e-5)} {
	user_error "Max O-grid height is too small"
	return 0
    }
    
    foreach i {0 1 2} x {x y z} {
	set v [set s$x]
	if {$v == ""} {
	    user_error "Max $x size is blank."
	    return 0
	}
	
	if !$v continue
	set d [expr [lindex $end $i] - [lindex $start $i]]
	if {$d / $v > 1000} {
	    set m "You have requested [expr $d / $v] elements in the $x\
		direction.  Do you want to continue?"
	    if [tk_dialog .bigmesh "Large mesh" $m "" -1 \
		    Continue "Cancel meshing"] {
		return 0
	    }
	}
    }
    
    lappend grid_line_list "domain 0 $start $end $sx $sy $sz\
	    $h1 $h2 $h3 $h4 $h5 $h6 $r1 $r2 $r3 $r4 $r5 $r6 $sh"
    set grid_mapping($domsh) 0
    set grid_mapping($domain) 0
    lappend "grid_mapping($domain body)" 0
    set grid_mapping(0) "$domain body"
    set grid_mapcount 1
    
    foreach var {
	objects
	outside_hollow
	outside_flat
	outside_otherparts
	outside_otherpart_sides
	side_quads
    } val [grid_get_objects_inside_and_outside $for_auto_mesher $do_part $inc_others 1] {
	set $var $val
    }
    
    if {$side_quads != ""} {
	lappend grid_line_list "\# non-conformal interface walls"
	
	foreach sq $side_quads {
	    foreach var {name pl start end side} val $sq { set $var $val }
	    
	    lappend grid_line_list "\# $name"
	    lappend grid_line_list "quad $grid_mapcount $pl $start $end 0"
	    lappend "grid_mapping({} junk)" $grid_mapcount
	    set grid_mapping($grid_mapcount) "$domain body"
	    lappend grid_coupling_walls($suff) $side $grid_mapcount 1
	    set grid_dont_round($grid_mapcount) 1
	    incr grid_mapcount
	}
	lappend grid_line_list "\# end of non-conformal interface walls"
    }
    
    # We have to do something a bit strange here to handle hollow blocks
    # that might be touching the objects inside the part.  These hollow
    # blocks need to get treated the same as the domain walls.  But what is
    # strange is that we can't write them as volume objects because they
    # wouldn't mask out the quad objects we're using for the n.c. interfaces.
    # So make them into 2-d things ...  Also they have to have a priority
    # above the n.c. walls but below the regular flat objects that sit there.
    
    if {$outside_hollow != ""} {
	lappend grid_line_list "\# hollow blocks which should mask out the nonconformal faces"
	set mc $grid_mapcount
	if ![grid_write_object_list $fp $outside_hollow $domsh $for_auto_mesher $do_part] { return 0 }
	while {$mc < $grid_mapcount} {
	    lappend grid_coupling_cutouts($suff) $mc
	    incr mc
	}
	lappend grid_line_list "\# end of hollow blocks"
    }
    
    # Now the touching quads (I guess they should come after the hollow and before the
    # other NC ones, although they had better not overlap an NC block)
    
    if {$outside_flat != ""} {
	lappend grid_line_list "\# flat objects which sit on the domain boundary"
	if ![grid_write_object_list $fp $outside_flat $domsh $for_auto_mesher $do_part] { return 0 }
	lappend grid_line_list "\# end of flat objects"
    }
    
    # Exactly similar to hollow blocks are other mesh-separately parts that touch
    # this part.  Except that we have to remember to patch up the couplings when reading
    # in the mesh ....
    if {$outside_otherparts != ""} {
	lappend grid_line_list "\# non-conformal interface walls with other assemblies"
	set mc $grid_mapcount
	foreach op $outside_otherparts os $outside_otherpart_sides {
	    if ![grid_write_object_list $fp $op $domsh $for_auto_mesher $do_part] { return 0 }
	    while {$mc < $grid_mapcount} {
		lappend grid_coupling_otherparts($suff) $mc .sub_[$op getval name] $os
		incr mc
	    }
	}
	lappend grid_line_list "\# end of other asm walls"
    }
    
    # objects is a list of obj is_part pairs
    set objects2 ""
    foreach {obj n} $objects { lappend objects2 $obj }
    if ![grid_write_object_list $fp $objects2 "" $for_auto_mesher $do_part] { return 0 }
    
    set r [grid_flush_lines $fp $do_part]
    close $fp
    return $r
}

proc grid_write_object_list {fp objects flatten_to_shape do_round from_part} {
    global grid_dont_round errorInfo grid_min_sep grid_num_rounded

    catch {unset grid_min_sep}
    set grid_num_rounded 0
    
    catch {unset grid_dont_round}
    if !$do_round { set grid_dont_round(all) 1 }
    if [catch {
	foreach obj $objects {
	    if ![grid_write_object $obj $flatten_to_shape $from_part] {
		user_error "Can't create mesh because of problems with objects (see message window)\n"
		close $fp
		return 0
	    }
	}
    } res] {
	close $fp
	user_error $res\n$errorInfo
	return 0
    }
    return 1
}

# This routine has to enforce the zero tolerance before
# writing out the thing.

proc grid_flush_lines {fp from_part} {
    global grid_line_list grid_min_sep
    global grid_num_rounded
    
    set sep [grid_get_sepvals $from_part]
    
    foreach line $grid_line_list {
	set line1 $line
	set line [grid_enforce_min_sep $line $sep 0 $from_part]
	if {$line1 != $line} {
	    #puts "BEFORE $line1"
	    #puts "AFTER  $line"
	}
	puts $fp $line
    }
    if $grid_num_rounded {
	mess "$grid_num_rounded values were modified by less than minimum separation values to eliminate small gaps\n"
    }
    return 1
}

proc grid_write_object {obj flatten_to_shape from_part} {
    global grid_line_list app_has_special_grid app_has_section_list_for_meshing

    set type [$obj getval obtype]
    
    lappend grid_line_list "# $type [$obj getval name]"
    
    set shnames [expr [llength [$obj getval section_list]] > 1]
    
    # If this is defined it has to return the sections with higher priority
    # shapes coming later.
    if [info exists app_has_section_list_for_meshing($type)] {
	set sections [app_section_list_for_meshing_$type $obj]
    } else {
	set sections [$obj getval section_list]
    }
    foreach sectname $sections {
	set shape [$obj getval ${sectname}_shape]
	if [info exists app_has_special_grid($type)] {
	    set shapes [app_special_grid_$type $obj $shape $sectname]
	} else {
	    set shapes $shape
	}
	
	foreach shh $shapes {
	    set sh [lindex $shh 0]

	    if ![$sh get -active] continue
	    set shkey [lrange $shh 1 end]

	    if {$shkey == ""} { set shkey $sectname }

	    if ![grid_write_shape $sh $obj $shkey $shnames $flatten_to_shape $from_part] {
		return 0
	    }
	    if {$sh != $shape} { $sh delete }
	}
    }
    return 1
}

proc grid_write_shape {sh obj shkey shnames flatten_to_shape from_part} {
    global grid_mapping grid_mapcount grid_line_list grid_mesher_params
    global grid_perobject cutouts_for_solid use_grid_grading
    global writing_ff_grid grid_convert_multi grid_dont_round
    
    set res [$sh verify auto]
    if {$res != ""} {
	set obname [$obj getval name]
	mess "Object $obname, [$sh get -name]: $res\n" red
    }
    
    set ign [expr {!$grid_perobject || ![$sh get -grid_enabled] || \
		       $grid_mesher_params(ignore_perobject)}]
    
    $sh configure -grid_grading_enabled $use_grid_grading
    
    # This is an ugly hack becuase plates are not always 2-sided
    if [info exists writing_ff_grid] {
	catch {
	    set osf [$sh get -split_flag]
	    $sh configure -split_flag 1
	}
	catch {
	    set ovf [$sh get -volume_flag]
	    if {$ovf == 1} {
		# $sh configure -volume_flag 0
	    }
	}
    } elseif $grid_convert_multi {
	set ovf [$sh get -volume_flag]
	$sh configure -volume_flag 1
    }
    $sh get_bbox
    set lines [split [$sh mesher_input $grid_mapcount $ign] \n]
    catch {$sh configure -split_flag $osf}
    catch {$sh configure -volume_flag $ovf}
    
    #puts "grid_write_shape $sh $obj $shkey  -->  $lines"
    set nl [llength $lines]
    set p 0
    if $shnames { lappend grid_line_list "\#     [$sh get -name]" }
    foreach line $lines {
	# This is the hack to make hexas into quads when they touch
	# nonconformal boundaries.
	if {($flatten_to_shape != "") && ([lindex $line 0] == "hexa")} {
	    set flat [grid_flatten_to_shape $flatten_to_shape \
			  [lrange $line 2 7]]
	    if {$flat == ""} continue
	    set line [concat quad [lindex $line 1] $flat 0]
	}
	
	lappend grid_line_list $line
	set num $grid_mapcount; incr grid_mapcount
	
	if {$obj == ""} error
	
	if {$p > 0} {
	    set key "$obj $shkey$p"	    
	} else {
	    set key "$obj $shkey"
	}

	incr p
	
	lappend grid_mapping($obj) $num
	lappend grid_mapping($sh) $num
	set grid_mapping($key) $num
	set grid_mapping($num) $key
	
	switch [$obj getval obtype] {
	    domain - part {
		# But we do want to make sure other objects round to us
		# and not vice versa ...
		set sep [grid_get_sepvals $obj]
		set ignore_line [grid_enforce_min_sep $line $sep 1 $from_part]
		
		set grid_dont_round($num) 1
	    }
	}
	
    }
    if [info exists cutouts_for_solid($sh)] {
	foreach cc $cutouts_for_solid($sh) {
	    set flat [lindex $cc 0]
	    set csh [lindex $cc 1]
	    set fcname [lindex $cc 2]
	    
	    if {[info command $csh] == ""} {
		# This means that the cutout was written with a different
		# part already.
		continue
	    }
	    set n1 [[$sh get -object] getval name]
	    set n2 [[$flat get -object] getval name]
	    
	    lappend grid_line_list "\# Fluid cutout for $n1 and $n2"
	    if ![grid_write_shape $csh [$flat get -object] $fcname 0 "" $from_part] {
		return 0
	    }
# *** WARNING : in the code above, if the shape has already been written out
# and deleted via a different part, then it won't get written a second time.
# But this is not the behavior we want.  If should be written out for every
# part.  Since the 4.0 release is tomorrow I am just commentng out this 
# line to get that behavior but it will create a memory leak .....  Fix
# later "for real"
#	    $csh delete
	}
    }
    return 1
}

proc grid_flatten_to_shape {sh hexa} {
    set min [$sh getval min]
    set max [$sh getval max]
    set tol [expr [$sh getval shortest] * 0.001]
    set ret ""
    foreach i {0 1 2} pl {yz xz xy} {
	set i3 [expr $i + 3]
	if {[lindex $hexa $i] > [lindex $max $i] - $tol} {
	    set ret [concat $pl [lreplace $hexa $i3 $i3 [lindex $hexa $i]]]
	    break
	} elseif {[lindex $hexa $i3] < [lindex $min $i] + $tol} {
	    set ret [concat $pl [lreplace $hexa $i $i [lindex $hexa $i3]]]
	    break
	}
    }
    if {$ret == ""} {
	# Okay, this hollow block isn't touching the shape.  Maybe it's
	# intersecting.
	foreach i {0 1 2} pl {yz xz xy} {
	    set i1 [expr ($i + 1) % 3]
	    set i2 [expr ($i + 2) % 3]
	    set pos0 $i
	    set pos3 [expr $i + 3]
	    
	    # Is it overlapping in the other two directions?
	    if {([lindex $hexa [expr $i1 + 3]] < [lindex $min $i1] + $tol) ||
		([lindex $hexa $i1] > [lindex $max $i1] - $tol) ||
		([lindex $hexa [expr $i2 + 3]] < [lindex $min $i2] + $tol) ||
		([lindex $hexa $i2] > [lindex $max $i2] - $tol)} continue
	    
	    if {([lindex $hexa $pos0] < [lindex $min $i] - $tol) &&
		([lindex $hexa $pos3] > [lindex $min $i] + $tol)} {
		set hexa [lreplace $hexa $pos0 $pos0 [lindex $min $i]]
		set hexa [lreplace $hexa $pos3 $pos3 [lindex $min $i]]
		set ret [concat $pl $hexa]
		break
	    } elseif {([lindex $hexa $pos0] < [lindex $max $i] - $tol) &&
		([lindex $hexa $pos3] > [lindex $max $i] + $tol)} {
		set hexa [lreplace $hexa $pos0 $pos0 [lindex $max $i]]
		set hexa [lreplace $hexa $pos3 $pos3 [lindex $max $i]]
		set ret [concat $pl $hexa]
		break
	    }
	}
    }
    return $ret
}
    
# ------------------------------------------------------------------

proc grid_any_params_used {sh} {
    foreach i {length height ratio} {
	foreach v [$sh get -grid_${i}] {
	    if $v { return USED }
	}
    }
    return ""
}

proc grid_set_all_enabled {on} {
    global edit_params_active
    foreach i [array names edit_params_active] {
	set edit_params_active($i) $on
    }
}

proc grid_edit_perobject {} {
    global edit_params_active edit_params_used
    global object_type_list object_type_title form_done_flag botform_geo
    global grid_perobject_buttons
    
    set buts [list done cancel \
		  [list "Enable all" "grid_set_all_enabled 1"] \
		  [list "Disable all" "grid_set_all_enabled 0"]]
    
    catch {unset edit_params_active}
    catch {unset edit_params_used}
    catch {unset grid_perobject_buttons}
    
    form_kill .grid_perobject
    set d [form_init .grid_perobject "Per-object mesh parameters" \
	       "mesh sub" $buts]
    if {$d == ""} return
    
    set fr [form_scroller $d.scr 400 {0 0}]
    
    set row 1
    foreach type $object_type_list {
	switch $type { material - part continue }
	
	set objects ""
	foreach obj [db_list_objects $type] {
	    if [$obj si_value active] { lappend objects $obj }
	}
	if {$objects == ""} continue
	
	form_label $fr.l$row "$object_type_title($type):" \
	    "$row 0 -cols -"
	incr row
	
	foreach obj $objects {
	    if {$type == "domain"} {
		set obname ""
	    } else {
		set obname [$obj getval name]
	    }
	    set sects [$obj getval section_list]
	    switch [llength $sects] {
		0 continue
		1 {
		    set sh [$obj getval ${sects}_shape]
		    if {[$sh get -shtype] == "none"} continue
		    set edit_params_active($sh) [$sh get -grid_enabled]
		    set edit_params_used($sh) [grid_any_params_used $sh]
		    form_checkbutton $fr.a$row $obname \
			edit_params_active($sh) "$row 3"
		    set grid_perobject_buttons($sh) $fr.a$row
		    form_button $fr.b$row Edit "grid_perobject_one $obj $sh" \
			"$row 4" edit_params_active($sh)
		    form_label $fr.u$row "" "$row 5" edit_params_active($sh)
		    $fr.u$row configure -textvariable edit_params_used($sh)
		    incr row
		}
		default {
		    form_label $fr.l$row $obname "$row 1 -cols 2"
		    incr row
		    foreach ss $sects {
			set sh [$obj getval ${ss}_shape]
			if {[$sh get -shtype] == "none"} continue
			set edit_params_active($sh) [$sh get -grid_enabled]
			set edit_params_used($sh) [grid_any_params_used $sh]
			form_checkbutton $fr.a$row $ss \
			    edit_params_active($sh) "$row 3"
			set grid_perobject_buttons($sh) $fr.a$row
			form_button $fr.b$row Edit "grid_perobject_one $obj $sh" \
			    "$row 4" edit_params_active($sh)
			form_label $fr.u$row "" "$row 5" \
			    edit_params_active($sh)
			$fr.u$row configure -textvariable edit_params_used($sh)
			incr row
		    }
		}
	    }
	}
    }
    form_colwidth $fr 0 2 M
    form_colwidth $fr 1 2 M
    
    form_finish $botform_geo
    $d.scr configure -height [expr {[winfo reqheight $d.scr] + 1}]
    
    tkwait variable form_done_flag(.grid_perobject)
    if !$form_done_flag(.grid_perobject) return
    
    foreach sh [array names edit_params_active] {
	$sh configure -grid_enabled $edit_params_active($sh)
    }
}

proc grid_perobject_type {sh} {
    global domain edit_params_for use_grid_grading
    
    set obj [$sh get -object]
    
    set tt [lindex [split [$sh get -type] _] 1]
    set tp $tt
    switch $tt {
	quad {
	    append tt _[$sh getval plane]
	    if {[$obj getval obtype] == "wall"} {
		append tt _oneside
	    }
	}
	circ {
	    if {[$obj getval obtype] != "fan"} {
		append tt _nohub
	    }
	}
	incline {
	    append tt _[$sh getval axis]
	    if {[$sh si_value thickness] != 0} {
		append tt _thick
	    }
	}
	polygon {
	    set hgt [$sh si_value height]
	    if !$hgt { append tt _thin }
	    set n [$sh getval nverts]
	    append tt _$n
	    if ![info exists edit_params_for($tt)] {
		set ll ""; set hh ""; set rr ""
		for {set i 0} {$i < $n} {incr i}  {
		    set i2 [expr {$i + 2}]
		    lappend ll [list "Side [expr $i + 1] count" length $i]
		    if $hgt {
			lappend hh [list "Side [expr $i + 1] height" height $i2]
			lappend rr [list "Side [expr $i + 1] ratio" ratio $i2]
		    }
		}
		if $hgt {
		    set edit_params_for($tt) \
			[concat $ll [list [list "Height count" length $n]] {{}} \
			     [list [list "Bottom height" height 0] \
				  [list "Top height" height 1]] $hh {{}} \
			     [list [list "Bottom ratio" ratio 0] \
				  [list "Top ratio" ratio 1]] $rr]
		} else {
		    set edit_params_for($tt) \
			[concat $ll {{}} \
			     [list [list "Bottom height" height 0] \
				  [list "Top height" height 1]] $hh {{}} \
			     [list [list "Bottom ratio" ratio 0] \
				  [list "Top ratio" ratio 1]] $rr]
		}
		if $use_grid_grading {
		    lappend edit_params_for($tt) {} \
			[list "Grading height" height [expr $n + 2]] \
			[list "Grading ratio"  ratio  [expr $n + 2]]
		}
	    }
	}
    }
    if {$obj == $domain} { append tt _domain }
    return $tt
}

proc grid_perobject_one {obj sh} {
    global edit_params_used edit_params_for form_done_flag botform_geo
    global edit_param_val edit_param_actual edit_param_on domain
    global grid_copyto_mode use_grid_grading meshing_units
    
    set tt [grid_perobject_type $sh]
    
    set tw .grid_params_$tt
    
    set buts [list [list Done "form_accept_hack $tw"] cancel \
		  [list "Copy to" "grid_perobject_copyto $tt"]]
    set d [form_init $tw "" "grid sub sub" $buts]
    top_title $tw [$obj getval name]

    if {$d != ""} {
	form_label $d.top1 Requested {0 1}
	form_label $d.top2 "Actual     " {0 2}
	set sc [form_scroller $d.fr 500 {1 0 -cols -}]
    }
    set r 1
    set u $meshing_units
    foreach p $edit_params_for($tt) {
	if {$p == ""} {
	    if {$d != ""} {
		form_rowheight $sc $r 10
	    }
	    incr r
	    continue
	}
	set ptype [lindex $p 1]
	if {$d != ""} {
	    switch $ptype {
		height { set dtype [list float_cmp ">0"] }
		length { set dtype [list float_cmp ">0"] }
		ratio  { set dtype [list float_cmp ">1"] }
	    }
	    
	    form_checkbutton $sc.l$r [lindex $p 0] edit_param_on($tt,$r) "$r 0"
	    form_entry $sc.e$r edit_param_val($tt,$r) $dtype "$r 1" \
		edit_param_on($tt,$r)
	    form_entry $sc.a$r edit_param_actual($tt,$r) float "$r 2"
	    $sc.a$r configure -state disabled
	}
	set n [lindex $p 2]
	set rval [lindex [$sh get -grid_$ptype] $n]
	set aval [lindex [$sh get -grid_${ptype}_used] $n]
	if {($rval == "") || ($rval == 0)} {
	    set edit_param_on($tt,$r) 0
	    switch $ptype {
		height { set edit_param_val($tt,$r) 0 }
		length { set edit_param_val($tt,$r) 0 }
		ratio  { set edit_param_val($tt,$r) 2 }
	    }
	} else {
	    set edit_param_on($tt,$r) 1
	    if {$ptype == "height"} {
		set edit_param_val($tt,$r) [unit_convert $rval $u 1]
	    } else {
		set edit_param_val($tt,$r) $rval
	    }
	}
	if {($ptype == "height") && ($aval != "")} {
	    set aval [unit_convert $aval $u 1]
	}
	set edit_param_actual($tt,$r) $aval
	
	incr r
    }
    if {$d != ""} {
	form_finish bot
	$d.fr configure -height [expr {[winfo reqheight $d.fr] + 1}]
    }
    
    tkwait variable form_done_flag($tw)
    if !$form_done_flag($tw) return
    
    grid_perobject_toshape $sh $tt 0
    if [info exists grid_copyto_mode] {
	grid_perobject_copyto $tt
    }
}

proc grid_perobject_toshape {sh tt verbose} {
    global edit_params_for edit_param_on edit_param_val edit_params_used
    global edit_params_active edit_tetra_params_for grid_type meshing_units
    
    set u $meshing_units
    
    set edit_params_active($sh) 1
    
    switch $grid_type {
	tetra { set params $edit_tetra_params_for($tt) }
	auto  { set params $edit_params_for($tt) }
    }
    
    set r 1
    foreach p $params {
	if {$p == ""} { incr r; continue }
	
	set ptype [lindex $p 1]
	
	set req [$sh get -grid_$ptype]
	set n [lindex $p 2]
	if {[info exists edit_param_on($tt,$r)] && $edit_param_on($tt,$r)} {
	    if {$ptype == "height"} {
		set v [unit_convert $edit_param_val($tt,$r) $u 0]
	    } else {
		set v $edit_param_val($tt,$r)
	    }
	} else {
	    set v 0
	}
	if {[lindex $req $n] == ""} {
	    for {set q [llength $req]} {$q < $n + 1} {incr q} {
		lappend req 0
	    }
	}
	#foreach n [lrange $p 2 end] ?????
	
	set req [lreplace $req $n $n $v]
	
	$sh configure -grid_$ptype $req
#	puts "$sh configure -grid_$ptype $req"
	incr r
    }
    set edit_params_used($sh) [grid_any_params_used $sh]
    
    if $verbose {
	set obj [$sh get -object]
	mess "Params copied to [$obj getval name]\n"
    }
}

proc grid_perobject_copyto {tt} {
    global grid_copyto_mode grid_perobject_buttons
    
    if [info exists grid_copyto_mode] {
	mess "Finished \"Copy to\".\n"
	unset grid_copyto_mode
	foreach sh [array names grid_perobject_buttons] {
	    grid_perobject_chbut $sh $grid_perobject_buttons($sh) $tt 0
	}
	return
    }
    set grid_copyto_mode 1
    
    mess "Click on the object names in the \"Per-object mesh parameters\"\
	window that you want to copy to.  Note that only objects of the\
	same shape can be copied to.  Click on the \"Copy to\" button again\
	to finish.\n"
    foreach sh [array names grid_perobject_buttons] {
	grid_perobject_chbut $sh $grid_perobject_buttons($sh) $tt 1
    }
}

proc grid_perobject_chbut {sh but tt on} {
    set stt [lindex [split [$sh get -type] _] 1]
    if {$stt != [lindex [split $tt _] 0]} return
    
    if $on {
	$but configure -relief ridge -foreground \#88ff88
	bind $but <1> "grid_perobject_toshape $sh $tt 1; break"
    } else {
	$but configure -relief flat -foreground black
	bind $but <1> ""
    }
}

# Gap-checking code

proc grid_enforce_min_sep {line sepvals ispart part} {
    set obnum [lindex $line 1]
    
    switch [lindex $line 0] {
	hexa - domain {
	    return [concat [lrange $line 0 1] \
			[grid_enforce_min_sep_coords [lrange $line 2 4] $sepvals $obnum $ispart $part] \
			[grid_enforce_min_sep_coords [lrange $line 5 7] $sepvals $obnum $ispart $part] \
			[lrange $line 8 end]]
	}
	quad - incline {
	    return [concat [lrange $line 0 2] \
			[grid_enforce_min_sep_coords [lrange $line 3 5] $sepvals $obnum $ispart $part] \
			[grid_enforce_min_sep_coords [lrange $line 6 8] $sepvals $obnum $ispart $part] \
			[lrange $line 9 end]]
	}
	cyl {
	    return [concat [lrange $line 0 2] \
			[grid_enforce_min_sep_coords [lrange $line 3 5] $sepvals $obnum $ispart $part] \
			[lrange $line 6 end]]
	}
	poly {
	    set np [expr [lindex $line 3] * 2]
	    set nline [lrange $line 0 3]
	    set pos 4
	    for {set i 0} {$i < $np} {incr i} {
		set nc [grid_enforce_min_sep_coords \
			    [lrange $line $pos [expr $pos + 2]] $sepvals $obnum $ispart $part]
		set nline [concat $nline $nc]
		incr pos 3
	    }
	    set nline [concat $nline [lrange $line $pos end]]
	    return $nline
	}
	cyl {
	    return [concat [lrange $line 0 2] \
			[grid_enforce_min_sep_coords [lrange $line 3 5] $sepvals $obnum $ispart $part] \
			[lrange $line 6 end]]
	}
	default {
	    return $line
	}
    }
}

proc grid_enforce_min_sep_coords {coords sepvals obnum ispart part} {
    return [list [grid_enforce_min_sep_one x [lindex $coords 0] [lindex $sepvals 0] \
		      $obnum $ispart $part] \
		 [grid_enforce_min_sep_one y [lindex $coords 1] [lindex $sepvals 1] \
		      $obnum $ispart $part] \
		 [grid_enforce_min_sep_one z [lindex $coords 2] [lindex $sepvals 2] \
		      $obnum $ispart $part]]
}

proc grid_min_sep_name {num} {
    global grid_mapping
    set obj [lindex $grid_mapping($num) 0]
    if {[lindex $grid_mapping($num) 1] != "body"} {
	set shn " [lindex $grid_mapping($num) 1]"
    } else {
	set shn ""
    }
    return "[$obj getval obtype] [$obj getval name]$shn"
}

proc grid_min_sep_mess {num1 num2 dir p1 p2 ispart part} {
    global warn_if_roundoff_more_than
    
    set dif [expr abs($p1 - $p2)]
    
    if $ispart {
	mess "Gap between [grid_min_sep_name $num1] and [grid_min_sep_name $num2] is [format %g $dif] but the mesh cannot be modified.\n" red
    } elseif {($warn_if_roundoff_more_than($part,$dir) >= 0) &&
	      ($dif > $warn_if_roundoff_more_than($part,$dir))} {
	mess "Modified [grid_min_sep_name $num1] to match [grid_min_sep_name $num2]:\
		$dir = $p1 -> $p2, diff $dif\n" red
    }
}

proc grid_enforce_min_sep_one {dir new ttol obnum ispart part} {
    global grid_min_sep grid_num_rounded
    global grid_dont_round
    
    if {[info exists grid_dont_round($obnum)] || [info exists grid_dont_round(all)]} {
	# *only* check this vs 0, and use a smaller tolerance
	if {abs($new) < $ttol / 1000.0} {
	    return 0
	} else {
	    return $new
	}
    }
    
    if ![info exists grid_min_sep($dir)] {
	# Introduce a dummy point at the origin.  This may or may not be
	# really necessary but makes the grid input cleaner.
	set grid_min_sep($dir) [list [list 0 0]]
    }
    
    set low 0
    set high -1
    foreach v $grid_min_sep($dir) {
	incr high
	set vals($high) [lindex $v 0]
	set obnums($high) [lindex $v 1]
    }
    if {$high == -1} {
	set grid_min_sep($dir) [list [list $new $obnum]]
	return $new
	
    } elseif {$new <= $vals($low)} {
	set dif [expr $vals($low) - $new]
	if {$dif < $ttol} {
	    if $dif {
		grid_min_sep_mess $obnum $obnums($low) $dir $new $vals($low) $ispart $part
		incr grid_num_rounded
	    }
	    return $vals($low)
	} else {
	    set grid_min_sep($dir) [lreplace $grid_min_sep($dir) -1 -1 \
					[list $new $obnum]]
	    return $new
	}
	    
    } elseif {$new >= $vals($high)} {
	set dif [expr $new - $vals($high)]
	if {$dif < $ttol} {
	    if $dif {
		grid_min_sep_mess $obnum $obnums($high) $dir $new $vals($high) $ispart $part
		incr grid_num_rounded
	    }
	    return $vals($high)
	} else {
	    lappend grid_min_sep($dir) [list $new $obnum]
	    return $new
	}
	
    } else {
	while {$low < $high - 1} {
	    set pt [expr ($low + $high) / 2]
	    if {$vals($pt) == $new} {
		return $new
	    } elseif {$vals($pt) < $new} {
		set low $pt
	    } else {
		set high $pt
	    }
	}
	set dif1 [expr $new - $vals($low)]
	set dif2 [expr $vals($high) - $new]
	#puts "diffs $dif1 $dif2"
	if {($dif1 < $ttol) && ($dif1 < $dif2)} {
	    grid_min_sep_mess $obnum $obnums($low) $dir $new $vals($low) $ispart $part
	    incr grid_num_rounded
	    return $vals($low)
	} elseif {$dif2 < $ttol} {
	    grid_min_sep_mess $obnum $obnums($high) $dir $new $vals($high) $ispart $part
	    incr grid_num_rounded
	    return $vals($high)
	} else {
	    set grid_min_sep($dir) [lreplace $grid_min_sep($dir) \
					$high $low [list $new $obnum]]
	    return $new
	}
    }
}
