
# Material stuff.
#
# Copyright (c) 1999 Pacific Marketing and Consulting
# Author:  Wayne A. Christopher, wayne@pmac.com
#          Pacific Marketing and Consulting, Berkeley, California

# Can be temp dependent: sp_heat conductivity emissivity vol_expansion
#                        viscosity diffusivity
# Others must be constant

proc add_td {title name utype for_types} {
    global object_params object_extra_units
    
    set pp object_params(material)
    lappend $pp [list "$title value" ${name}_constant float 1.0 $utype \
		     {} $title detailed [list [concat mat_type $for_types]]]
    lappend $pp [list "$title type" ${name}_valuetype string constant "" \
		     {constant linear curve} $title detailed [list [concat mat_type $for_types]]]
    lappend $pp [list "$title type" ${name}_on int 1]
    lappend $pp [list "$title val0"  ${name}_val0 float 0.0 $utype]
    lappend $pp [list "$title coeff" ${name}_coeff float 1.0]
    lappend $pp [list "$title Tref"  ${name}_tref float 1.0 temperature]
    lappend $pp [list "$title curve" ${name}_curvespec string ""]
    
    lappend object_extra_units(material) [list ${name}_curvespec_x temperature]
    lappend object_extra_units(material) [list ${name}_curvespec_y $utype]
}

set pp object_params(material)
set $pp {
    { "Library"    mat_lib_name        string "" \
	  "" "" Object brief always }
    { "Lib path"   mat_lib_path        string "" }
    { "Mat type"   mat_type            string solid ""
	{solid surface fluid} Object brief always }
    { "Subtype"    mat_subtype         string "" "" \
	  "" Object brief always }
    { Custom       mat_custom          bool 0 }
    { Color        obj_color           string pink }
    { Linewidth    obj_linewidth       int    1 }
    { Shading      obj_shading         string View }
    { Texture      obj_texture         string "" }
    { "Texture scale" obj_texture_scale float 1.0 }
    { Transparency obj_transparency    float 0.5 }
    { Transparency obj_transparency_on int 0 }
}

foreach i {
    obj_color obj_linewidth obj_shading obj_texture obj_texture_scale
    obj_transparency obj_transparency_on active mat_custom
} {
    set object_type_params_nosummary(material,$i) 1
}

set never_ignore(material,mat_type) 1
set never_ignore(material,mat_subtype) 1

lappend $pp { "Solid density" solid_density float 1.0 density "" Density detailed {{mat_type solid}} }
add_td "Solid sp. heat"    solid_sp_heat sp_heat solid

add_td "Solid conduct" solid_conductivity conductivity solid
lappend $pp { "Conduct dir"    solid_conductivity_type string iso "" { iso ortho noniso biaxial }}
lappend $pp { "Conduct x"        solid_conductivity_x      float  1.0 }
lappend $pp { "Conduct y"        solid_conductivity_y      float  1.0 }
lappend $pp { "Conduct z"        solid_conductivity_z      float  1.0 }
lappend $pp { "Conduct in-plane" solid_conductivity_p      float  1.0 }
lappend $pp { "Conduct normal"   solid_conductivity_n      float  1.0 }
lappend $pp { "Conduct tensor"   solid_conductivity_tensor string "1 0 0 0 1 0 0 0 1" }

lappend $pp { "Roughness"  surface_roughness   float  0.0 roughness {} Surface detailed {{mat_type surface}} }
lappend $pp { "Emissivity" surface_emissivity  float  0.0 emissivity {} Surface detailed {{mat_type surface}} }


if $is_airpak {
    lappend $pp { "Absorbtance" surface_i_absorb float 0.1 }
    lappend $pp { "Transmittance" surface_i_trans float 0.8 }
    lappend $pp { "Hemispherical Diffuse Absorbtance" surface_d_absorb float 0.1 }
    lappend $pp { "Hemispherical Diffuse Transmittance" surface_d_trans float 0.8 }
}

add_td "Volume exp."    fluid_vol_expansion     vol_expansion fluid
add_td "Viscosity"      fluid_viscosity         viscosity fluid
lappend $pp { "Fluid density" fluid_density           float  1.0 density {} Density detailed {{mat_type fluid}} }
add_td "Fluid sp. heat"    fluid_sp_heat           sp_heat fluid

add_td "Fluid conduct"   fluid_conductivity            conductivity fluid
lappend $pp { "Which"    fluid_conductivity_whichdep   string temperature "" }
lappend $pp { "Coeff"    fluid_conductivity_vdep_coeff float 1.0 }
lappend $pp { "Exp"      fluid_conductivity_vdep_exp   float 1.0 }

add_td "Diffusivity" fluid_diffusivity diffusivity fluid
lappend $pp { "Mol. weight"   fluid_mol_weight      float  1.0 mol_weight }

set object_type_title(material) "Materials"
set object_edit_info(material) { }
set type_name(material) material

set object_list_format(material) {
    { Fluids mat_type fluid mat_subtype }
    { Solids mat_type solid mat_subtype }
    { Surface mat_type surface mat_subtype }
}

set tree_always_detail(material) 2
set tree_always_alpha_sort(material) 1

set object_subtypes(material) {
    {mat_type capitalize}
    {mat_subtype capitalize}
}

array set mat_title {
    fluid Fluid
    surface Surface
    solid Solid
}

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

proc model_matentry {w var type tabgeo {act ""} {inc_default 1}} {
    set vkey [lindex [split $var ()] 1]; if {$vkey == ""} { set vkey $var }
    form_frame $w sunken 2 "$tabgeo -fill both -padx 1 -pady 1"
    form_entry $w.e $var string {0 0 -fill both -padx 0 -pady 0} $act 16
    $w.e configure -relief flat -borderwidth 0
    futil_choicelist $w.e "choice default" \
	"list_materials_for_menu $type $inc_default" \
	{0 1 -padx 0 -pady 0} $act "" "material_entry_pick_by_name $w.e $vkey $type"
}

proc material_entry_pick_by_name {w vkey mtype ch cur} {
    global form_entry_datatype edit_nameactive_okay
    
    set ch [string trim $ch]
    switch $ch {
	"View definition" {
	    set obj [get_material $cur $mtype]
	    mat_print_to_mess $obj
	    return ""
	}
	"Edit definition" {
	    if !$edit_nameactive_okay {
 		popup "Edit material" "Sorry, it's not possible to edit the definition for this material in group edit mode.  Please use the Edit command in the Model / Materials menu instead."
 		return ""
 	    }
	    set nname [mat_edit_definition $cur $mtype]
	    lappend form_entry_datatype($w) $nname
	    return $nname
	}
	"Create material" {
	    if !$edit_nameactive_okay {
		popup "Create material" "Sorry, it's not possible to create new materials in group edit mode.  Please use the New command in the Model / Materials menu instead."
		return ""
	    }
	    set val [mat_create_custom $vkey $mtype]
	    lappend form_entry_datatype($w) $val
	    return $val
	}
	"" { return "" }
	default {
	    if {$ch == "default"} { return default }
	    set top [part_get_root]
	    if {[$top get_name $ch] != ""} {
		return $ch
	    } else {
		return ""
	    }
	}
    }
}

proc mat_edit_definition {cur mtype} {
    global model_data current_object editing_material_definition
    
    set ocur ""; set putprob 0
    if {$current_object != ""} {
	edit_modify_params
	set ocur $current_object
    } elseif {[winfo exists .problem] && [winfo ismapped .problem]} {
	top_withdraw .problem
	set putprob 1
    }
    
    #update_mtype material
    set obj [get_material $cur $mtype]
    
    set islib [expr {[$obj getval mat_lib_path ""] != ""}]
    if $islib {
	# Save away a copy of the old one.
	set oname [$obj getval name]
	set oldobj [model_object]
	$oldobj copy $obj
	
	set editing_material_definition 0
    }
    
    model_set_current $obj
    set w [edit_current_object]
    form_wait $w
    
    set nname [$obj getval name]
    
    if $islib {
	# Did the user change anything?
	if $editing_material_definition {
	    set nname [db_ensure_new_name $nname]
	    set new [db_copy $obj $nname "" 1]
	    set nname [$new getval name]
	    $obj copy $oldobj
	    mess "Made a copy of the material \"$nname\"\n"
	}
	unset editing_material_definition
    }
    
    if $putprob {
	file_problem
    } elseif {$ocur != ""} {
	#update_mtype $otype
	model_set_current $ocur
	edit_current_object
    } else {
	model_set_current ""
    }

    return $nname
}

proc mat_create_custom {vkey mtype} {
    global model_data current_object current_mtype
    
    set ocur $current_object
    if {$ocur == ""} {
	form_cancel_class model
	set defname [[part_get_root] new_name $vkey]
    } else {
	edit_modify_params
	set defname "$model_data(name) $vkey"
    }
    
#    update_mtype material
    set obj [edit_new material $defname 1 "" \
		 [list mat_type $mtype mat_subtype Custom mat_custom \
		      1 fixvals 0]]
    model_set_current $obj
    set w [edit_current_object]
    set ok [form_wait $w]
    if !$ok {
	edit_delete 1 $obj
    }
    if {$ocur != ""} {
	model_set_current $ocur
	edit_current_object
    } else {
	model_set_current ""
    }
    if $ok {
	return [$obj getval name]
    } else {
	return ""
    }
}

proc mat_copy_current {} {
    global current_object
    
    set new [db_copy $current_object]
    $new unset mat_lib_path
    mat_edit_update_subtype
    model_set_current $new
    edit_selection_set $new
}

proc mat_get_or_copy_default {name type args} {
    set mat [get_material $name $type -1]
    if {$mat == ""} {
	set def [get_material default surface]
	set mat [db_copy $def $name]
	$mat setval mat_subtype Custom
	$mat unset mat_lib_path
    }
    if {$args != ""} { eval $mat setval $args }
    return $mat
}

proc vdep_res_create_material {from vdep const curve flowlen basearea} {
    set new [db_copy $from]
    
    foreach q {viscosity sp_heat} {
	if {[$new si_value fluid_${q}_valuetype] != "constant" && [$new si_value fluid_${q}_on]  } {
	    user_error "$q must be constant"
	    return ""
	}
    }

    set exponent -0.75

    if {"$vdep" == "curve"} {
       set temp [curve_fit_ax_pow_b $curve]
       set const [max [lindex $temp 0] 1e-10]
       set exponent [lindex $temp 1]
       set exponent [expr ($exponent + 0.5)*(-2.0)]
    } 
    
    set h [expr 1.0 / ($const * $basearea + 0.0)]
    set m [$new si_value fluid_viscosity_constant]
    set r [$new si_value fluid_density]
    set cp [$new si_value fluid_sp_heat_constant]

    # Chunwei says only heatsinks will need this material resistance curve
    # so use his correlation. I know who to ask if there are problems in this
    # assumption 01/22/02

    set coeff [expr $flowlen*$h*$h/1.08/1.08/$r/$cp]
    
    $new setval fluid_conductivity_whichdep velocity
    $new setval fluid_conductivity_vdep $vdep
    $new setval fluid_conductivity_vdep_coeff $coeff
    $new setval fluid_conductivity_vdep_exp $exponent
    
    return $new
}

proc mat_print_to_mess {obj} {
    global is_airpak
    
    set subt [$obj getval mat_subtype]
    if {$subt != ""} {
	set subt ", subtype $subt"
    }
    set mt [$obj getval mat_type]
    mess "\nMaterial name: \"[$obj getval name]\", type $mt$subt\n"
    
    set stuff {
	density       Density
	sp_heat       "Specific heat"
	conductivity  Conductivity
	roughness     Roughness
	emissivity    Emissivity
	vol_expansion "Volume expansion"
	viscosity     Viscosity
	diffusivity   Diffusivity
	mol_weight    "Molecular weight"
    }
    if $is_airpak {
	lappend stuff \
	    ir_absorb     "IR absorptivity" \
	    refract_ind   "Refractive index"
    }
    foreach {v n} $stuff {
	if [$obj checkval ${mt}_$v] {
	    set out [$obj get_value_with_units ${mt}_$v]
	    mess "    $n = [lindex $out 0] [lindex $out 1]\n"
	} elseif [$obj checkval ${mt}_${v}_valuetype] {
	    
	    switch [$obj si_value ${mt}_${v}_valuetype] {
		constant {
		    set out [$obj get_value_with_units ${mt}_${v}_constant]
		    mess "    $n = [lindex $out 0] [lindex $out 1]\n"
		}
		linear {
		    if {![$obj si_value ${mt}_${v}_on]} {
			set out [$obj get_value_with_units ${mt}_${v}_constant]
			mess "    $n = [lindex $out 0] [lindex $out 1]\n"
		    } else {
			set tref [$obj get_value_with_units ${mt}_${v}_tref]
			set val0 [$obj get_value_with_units ${mt}_${v}_val0]
			set coeff [$obj si_value ${mt}_${v}_coeff]
			mess "    $n = [lindex $val0 0] [lindex $val0 1] + $coeff * (T - [lindex $tref 0] [lindex $tref 1])\n"
		    }
		}
		curve {
		    if {![$obj si_value ${mt}_${v}_on]} {
			set out [$obj get_value_with_units ${mt}_${v}_constant]
			mess "    $n = [lindex $out 0] [lindex $out 1]\n"
		    } else {
			set curve [$obj si_value ${mt}_${v}_curvespec]
			set un [$obj getunits ${mt}_${v}_curvespec]
			mess "    $n = curve\n"
			foreach {t v} $curve {
			    mess "        T = $t [lindex $un 0]\tval = $v [lindex $un 1]\n"
			}
		    }
		}
	    }
	}
    }
}

proc list_materials {type} {
    load_materials
    set ret default
    foreach mat [db_list_objects material] {
	if {[$mat getval mat_type] == $type} {
	    lappend ret [$mat getval name]
	}
    }
    return $ret
}

proc material_get_primary {obj} {
    global object_params object_primary_material
    
    set t [$obj getval obtype]
    if [info exists object_primary_material($t)] {
	set matp $object_primary_material($t)
    } else {
	set matp ""
	foreach p $object_params($t) {
	    if [string match \#* $p] continue
	    if [string match mat* [lindex $p 2]] {
		set matp [list [lindex $p 1] [lindex [lindex $p 2] 1]]
		break
	    }
	}
	set object_primary_material($t) $matp
    }
    if {$matp == ""} { return "" }
    set mat [$obj si_value [lindex $matp 0]]
    if {$mat == ""}  { return "" }
    if {$mat == "default"} {
	return [get_material [material_get_default [lindex $matp 1]]]
    } else {
	return [get_material $mat]
    }
}

proc get_material {name {which ""} {error 1}} {
    global default_solid_material default_surface_material
    global default_fluid_material
    
    if {$name == "default"} {
	set name [expression_evaluate [set default_${which}_material]]
    }
    load_materials
    set top [part_get_root]
    set obj [$top get_name $name]
    if {$obj == ""} {
	if {$which == ""} {
	    user_error "Could not find default material $name.  Please check your library path and make sure the default system material library is being loaded."
	    return ""
	}
	if {$error == 1} { mess "Error: no such material $name - using default\n" red }
	if {$error == -1} { return "" }
	
	set obj [$top get_name [expression_evaluate [set default_${which}_material]]]
    }
    if 0 {
	# this is not a useful check and easy to get wrong
	if {($which != "") && ([$obj getval mat_type] != $which)} {
	    user_error "expected $name to be a $which material but it's\
		[$obj getval mat_type]"
	    return ""
	}
    }
    return $obj
}

proc list_materials_for_menu {type inc_default} {
    load_materials
    set ret [list "View definition" "Edit definition" "Create material" ""]
    if $inc_default { lappend ret default }
    set ok 0
    
    foreach mat [db_list_objects material] {
	if {([$mat getval mat_type] == $type)} {
	    lappend found([$mat getval mat_subtype]) [$mat getval name]
	}
    }
    foreach st [array names found] {
	if {$st == ""} {
	    set ret [concat $ret [lsort $found($st)]]
	} else {
	    lappend ret $st
	    foreach n [lsort $found($st)] {
		lappend ret "    $n"
	    }
	}
    }
    return $ret
}

proc load_materials {} {
    global materials_loaded model_load_extra_values library_path env
    global material_load_count use_conversion_routine_suffix is_airpak
    global loading_materials_flag

    if [info exists materials_loaded] return
    set materials_loaded 1
    
    if 0 {
	# First let's see if we're just editing a materials job
	set nmats [llength [db_list_objects material]]
	set nobjs [llength [db_list_objects]]
	
	if {$nmats && ($nmats == $nobjs - 1)} {
	    set m "It appears you are editing a material library (no objects\
		except for materials are available).  Do\
		you want to load the materials from the other\
		libraries in your path now?"
	    if [tk_dialog .edit_mat "Editing materials" $m "" 0 Yes No] {
		mess "No external materials loaded\n"
		return
	    }
	}
    }
    
    mess "Please wait -- loading material files ...\n"
    busy 1
    set loading_materials_flag 1
    set material_load_count 0
    set libdirs $library_path
    if [file exists [directory]/materials_from_libraries] {
	mess "Adding the materials_from_libraries file in the job directory to your library path.\n"
	lappend libdirs [directory]
    }
    foreach libdir $libdirs {
	if $is_airpak {
	    set lib [replace_string $libdir \$AIRPAK_ROOT $env(AIRPAK_ROOT)]
	} else {
	    set lib [replace_string $libdir \$ICEPAK_ROOT $env(ICEPAK_ROOT)]
	}
	set model_load_extra_values [list mat_lib_path $lib]

	if ![file exists $lib] {
	    mess "Warning: library $lib does not exist - can't find materials\n" \#ff0000
	    continue
	}
	if [file exists $lib/materials_from_libraries] {
	    set pf $lib/materials_from_libraries
	} else {
	    set pf $lib/materials
	}
	if ![file exists $pf] continue
	if [file isdirectory $pf] { set pf $pf/model }
	
	set material_load_count 0
	mess "\t[backslashify $pf] ... "
	if [info exists use_conversion_routine_suffix] {
	    set xxx $use_conversion_routine_suffix
	    unset use_conversion_routine_suffix
	    model_read $pf 1
	    set use_conversion_routine_suffix $xxx
	} else {
	    model_read $pf 1 0
	}
	mess "$material_load_count\n"
	tree_sort_below libraries/$pf
    }
    catch {unset model_load_extra_values}
    catch {unset material_load_count}
    unset loading_materials_flag
    busy 0
    mess "Done.\n"
}

proc reload_materials {} {
    global materials_loaded
    
    if [info exists materials_loaded] {
	foreach m [db_list_objects material] {
	    if {[$m getval mat_lib_path] != ""} { edit_delete 0 $m }
	}
   	unset materials_loaded
	load_materials
    }
}

proc get_constant_matval {param which matname} {
    if {$matname == "default"} {
	set matname [material_get_default $which]
    }
    set obj [get_material $matname $which]
    
    return [get_constant_matval_object $obj ${which}_${param}]
}

proc get_constant_matval_object {obj pref} {
    global problem_temp problem_temp_units
    global problem_oaltitude
    
    if {[$obj checkval ${pref}_valuetype]} {
	switch [$obj si_value ${pref}_valuetype] {
	    constant {
		return [$obj si_value ${pref}_constant]
	    }
	    linear {
		if {[$obj si_value ${pref}_on]}  {
		    foreach i {val0 coeff tref} {
			set $i [$obj si_value ${pref}_$i]
		    }
		    set curve [list 0 [expr $val0 + $coeff * $tref] \
				   [expr $tref - $val0 / ($coeff + 0.0)] 0]
		} else {
		    return [$obj si_value ${pref}_constant]
		}
	    }
	    curve {
		if {[$obj si_value ${pref}_on]}  {
		    set curve [$obj si_value ${pref}_curvespec]
		} else {
		    return [$obj si_value ${pref}_constant]
		}
		
	    }
	}
	set t [unit_convert [expression_evaluate $problem_temp] $problem_temp_units 0]
	return [curve_locate_value $curve $t]
    } else {
	set retval [$obj si_value ${pref}]
	if {[$obj getval name] == "Air" && $problem_oaltitude > 0 && $pref == "fluid_density"} {
	    set retval [expr $retval * [pressure_from_altitude]/101325]
	    mess "calculated density value is $retval\n" 
	}
	return $retval
    }
}

proc curve_locate_value {curve tv} {
    foreach {t v} $curve { set fn($t) $v }
    set ts [lsort -real [array names fn]]
    set nts [llength $ts]
    
    if {$tv < [lindex $ts 0]} {
	set low [lindex $ts 0]
	set hi [lindex $ts 1]
    } elseif {$tv > [lindex $ts [expr $nts - 1]]} {
	set low [lindex $ts [expr $nts - 2]]
	set hi [lindex $ts [expr $nts - 1]]
    } else {
	for {set i 0} {$i < $nts - 1} {incr i} {
	    set j [expr $i + 1]
	    if {($tv >= [lindex $ts $i]) && ($tv <= [lindex $ts $j])} {
		set low [lindex $ts $i]; set hi [lindex $ts $j]
		break
	    }
	}
    }
    return [expr {(($tv - $low) * $fn($low) + ($hi - $tv) * $fn($hi)) / \
		      ($hi - $low + 0.0)}]
}

proc material_build_from_properties {to_cont from_cont} {
    global old_fan_curves old_heat_tr_coeffs is_airpak
    
    set np 0
    foreach prop [$from_cont list_contents] {
	switch [$prop si_value proptype] {
	    fan_curve {
		set cc ""
		foreach {v1 v2} [$prop si_value curvespec] {
		    set v1 [expr $v1 / 1.1614]
		    lappend cc $v1 $v2
		}
		set old_fan_curves([$prop getval matname]) $cc
	    }
	    heat_tr_coeff {
		set old_heat_tr_coeffs([$prop getval matname]) \
		    [$prop si_value constant]
	    }
	    default {
		lappend pmat_found([$prop getval matname]) [$prop getval proptype]
		foreach p {valuetype coeff tref curvespec val0 constant on} {
		    set key [list [$prop getval matname] [$prop getval proptype]]
		    lappend pmat_vals($key) [list $p [$prop getval $p]]
		}
		incr np
	    }
	}
	$prop delete
    }
    $from_cont delete
    
    if $np {
	mess "Converting $np properties into [llength [array names pmat_found]] materials\n"
    }
    
    foreach m [array names pmat_found] {
	set types $pmat_found($m)
	set mat [edit_new material $m 0]
	set what_t ""
	set stuff {
	    surface roughness
	    surface emissivity
	    fluid vol_expansion
	    fluid diffusivity
	    fluid mol_weight
	    fluid viscosity
	    solid density
	    solid conductivity
	    solid sp_heat
	    fluid density
	    fluid sp_heat
	    fluid conductivity
	}
	if $is_airpak {
	    lappend stuff \
		surface absorb_i \
		surface trans_i \
		surface absorb_d \
		surface trans_d
	}
	foreach {pref pt} $stuff {
	    if {[lsearch $types $pt] < 0} continue
	    if {$what_t == ""} { set what_t $pref }
	}
	if {$what_t == ""} {
	    mess "Bad property $m -- $types\n" red
	    continue
	}
	$mat setval mat_type $what_t
	
	foreach t $types {
	    foreach k $pmat_vals([list $m $t]) {
		$mat setval ${what_t}_${t}_[lindex $k 0] [lindex $k 1]
	    }
	}
	app_clean_up_material $mat
    }
}

proc material_update_object_from_properties {obj} {
    global properties_to_materials new_material_cache model_container
    
    if {$obj == "fluid"} {
	set p_to_m {
	    { "" fluid
		{ problem_fl_density density }
		{ problem_fl_viscosity viscosity }
		{ {problem_fl_sp_heat problem_fl_spheat} sp_heat }
		{ {problem_fl_conductivity problem_fl_conduct} conductivity }
		{ {problem_fl_vol_expansion problem_fl_volexp} vol_expansion }
	    }
	}
	set objname "default fluid"
    } else {
        set obtype [$obj getval obtype]
	if ![info exists properties_to_materials($obtype)] return
	set p_to_m $properties_to_materials($obtype)
	set objname [$obj getval name]
    }
    
    foreach mat $p_to_m {
	catch {unset found}
	set mname [lindex $mat 0]
	set mtype [lindex $mat 1]
	set mval ""
	set need_new 0
	set def_fl [expr {$mname == ""}]
	foreach prop [lrange $mat 2 end] {
	    if $def_fl {
		set pname ""
		foreach p [lindex $prop 0] {
		    global $p
		    if [info exists $p] {
			set pname $p
			break
		    }
		}
		if {$pname == ""} { error "no pname" }
		
		set pval [set $pname]
		unset $pname
	    } else {
		set pname [lindex $prop 0]
		set pval [$obj si_value $pname ""]
		$obj unset $pname
	    }
	    if {$pval == ""} continue
	    
	    if [scan $pval %g value] {
		set matobj ""
		set need_new 1
		
		set sss [list [lindex $prop 1]]
		foreach {on nn} [lrange $prop 2 end] {
		    lappend sss $on $nn $pval
		}
	    } else {
		set matobj [get_material $pval "" 0]
		if {$matobj == ""} {
		    set matobj [get_material ${pval}-surface "" 0]
		    if {$matobj != ""} {
			set pval ${pval}-surface
		    }
		}
		if {($matobj != "") && ([$matobj getval mat_type] != $mtype)} {
		    mess "Warning: $objname needs a $mtype material but the value of $pname is $pval which is [$matobj getval mat_type].\n" red
		    set need_new 1
		}
		
		set sss [list [lindex $prop 1]]
		foreach {on nn} [lrange $prop 2 end] {
		    lappend sss $on $nn [$obj si_value $on 0]
		}
	    }
	    
	    set found($pname) [list $pval $matobj $sss]
	    if {$matobj == ""} {
		set need_new 1
	    } elseif {$mval == ""} {
		set mval $pval
	    } elseif {$mval != $pval} {
		set need_new 1
	    }
	    if {[llength $prop] > 2} {
		# Not always true but can't hurt
		set need_new 1
	    }
	}
	if $need_new {
	    set key mat_type=$mtype;
	    foreach p [lsort [array names found]] {
		lappend key "$p=$found($p);"
	    }
	    if [info exists new_material_cache($key)] {
		set newmat $new_material_cache($key)
		set mval [$newmat getval name]
		mess "Used $mtype material for $objname: $mval\n"
	    } else {
		set mval $mtype-$objname
		if {[$model_container get_name $mval] != ""} {
		    set mval [$model_container new_name $mval]
		}
		set newmat [edit_new material $mval]
		$newmat setval mat_type $mtype mat_subtype Custom
		set new_material_cache($key) $newmat
		
		mess "Creating $mtype material for $objname: $mval\n"

		foreach p [array names found] {
		    set pval [lindex $found($p) 0]
		    set matobj [lindex $found($p) 1]
		    set ptype [lindex [lindex $found($p) 2] 0]
		    set pextras [lrange [lindex $found($p) 2] 1 end]
		    if {$matobj != ""} {
			foreach v [$matobj list_values] {
			    if [string match ${mtype}_${ptype}* [lindex $v 0]] {
				$newmat setval [lindex $v 0] [lindex $v 1]
				mess "    [lindex $v 0] -> $pval ([lindex $v 1])\n"
			    }
			}
		    } else {
			if [$newmat checkval ${mtype}_${ptype}_constant] {
			    set pname ${mtype}_${ptype}_constant
			} else {
			    set pname ${mtype}_${ptype}
			}
			$newmat setval $pname $pval
			mess "    $pname -> $pval\n"
			foreach {n1 n2 val} $pextras {
			    if $def_fl error
			    switch $n1 {
				normal_pct {
				    $newmat setval solid_conductivity_type \
					ortho
				    set sh [$obj getval body_shape]
				    if {[$sh get -shtype] != "quad"} continue
				    set x0 [lindex {x y z} [$sh getval plane]]
				    $newmat setval solid_conductivity_$x0 \
					[expr [$obj si_value $n1 100] / 100.0]
				}
				plane_pct {
				    $newmat setval solid_conductivity_type \
					ortho
				    set sh [$obj getval body_shape]
				    if {[$sh get -shtype] != "quad"} continue
				    set p1 [expr ([$sh getval plane] + 1) % 3]
				    set p2 [expr ([$sh getval plane] + 2) % 3]
				    set p1 [lindex {x y z} $p1]
				    set p2 [lindex {x y z} $p2]
				    set v [expr [$obj si_value $n1 100] / 100.0]
				    $newmat setval solid_conductivity_$p1 $v \
					solid_conductivity_$p2 $v
				}
				default {
				    set pv2 [$obj si_value $n1]
				    $newmat setval $n2 $pv2
				    mess "    $n2 -> $pv2\n"
				}
			    }
			}
		    }
		}
	    }
	    app_clean_up_material $newmat
	}
	if {$mval != ""} {
	    if $def_fl {
		global default_fluid_material
		set default_fluid_material $mval
	    } else {
		$obj setval $mname $mval
	    }
	}
    }
}

proc objects_with_material {matname} {
    set ret ""
    foreach obj [db_list_objects_recursive] {
	foreach v [$obj list_values] {
	    if {[string match *material* [lindex $v 0]] && \
		    ([lindex $v 1] == $matname)} {
		lappend ret $obj
	    }
	}
    }
    return $ret
}

proc rename_materials_after_loading {objects} {
    global rename_material_while_loading
    
    if ![info exists rename_material_while_loading] return
    
    foreach obj $objects {
	foreach v [$obj list_values] {
	    set old [lindex $v 1]
	    if {[string match *material* [lindex $v 0]] && \
		    [info exists rename_material_while_loading($old)]} {
		set new $rename_material_while_loading($old)
		mess "Changed [$obj getval name] [lindex $v 0] from \"$old\" to \"$new\"\n"
		$obj setval [lindex $v 0] $new
	    }
	}
    }
}

# Search through all the objects and find instances of old and change them to
# new.

proc mat_rename {old new} {
    foreach obj [db_list_objects_recursive] {
	foreach v [$obj list_values] {
	    if {[string match *material* [lindex $v 0]] && \
		    ([lindex $v 1] == $old)} {
		$obj setval [lindex $v 0] $new
		mess "Changed [lindex $v 0] name for \"[$obj getval name]\"\n"
	    }
	}
    }
    foreach t {solid fluid surface} {
	global default_${t}_material
	if {[set default_${t}_material] == $old} {
	    set default_${t}_material $new
	}
    }
}

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

proc material_get_default {which} {
    global default_${which}_material
    set name [expression_evaluate [set default_${which}_material]]
    if {$name == "default"} {
	user_error "The default $which material is \"default\" - you must\
		set this value on the problem setup form\
 		to a specific material name."
	return Air
    }
    return $name
}

proc material_uns_param {mat field} {
    set mt [$mat getval mat_type]
    if {[$mat checkval ${mt}_${field}_valuetype]} { 
	# only take account of the material valuetype definition if the
	# switch is set to on
	
	switch [$mat si_value ${mt}_${field}_valuetype none] {
	    none {
		return "(constant . [$mat si_value ${mt}_${field}])"
	    }
	    constant {
		return "(constant . [$mat si_value ${mt}_${field}_constant])"
	    }
	    linear {
		# only take account of the material valuetype definition if the
		# switch is set to on
		
		if {[$mat si_value ${mt}_${field}_on]}  {
		    set tref [$mat si_value ${mt}_${field}_tref]
		    set val0 [$mat si_value ${mt}_${field}_val0]
		    set coeff [$mat si_value ${mt}_${field}_coeff]
		    
		    set c0 [expr {$val0 - $coeff * $tref}]
		    set c1 $coeff
		    set k [expr {$c0 + $c1 * $tref}]
		    return "(polynomial $c0 $c1) (constant . $k)"
		} else {
		    return "(constant . [$mat si_value ${mt}_${field}_constant])"	
		}
	    }
	    curve {
		# This is going to be in si anyway...  And there can be no
		# expressions in the curves so we just grab the value.
		if {[$mat si_value ${mt}_${field}_on]}  {
		    # only take account of the material valuetype definition if the
		    # switch is set to on
		    
		    set curvespec [$mat si_value ${mt}_${field}_curvespec]
		    set ret "(polynomial piecewise-linear"
		    set len [llength $curvespec]
		    for {set i 0} {$i < $len / 2} {incr i} {
			set x [lindex $curvespec [expr {$i * 2}]]
			set y [lindex $curvespec [expr {$i * 2 + 1}]]
			append ret " ($x . $y)"
		    }
		    append ret ")"
		    return $ret
		} else {
		    return "(constant . [$mat si_value ${mt}_${field}_constant])"	
		}
		
	    }
	}
    } else {
	return "(constant . [$mat si_value ${mt}_${field}])"
    }
}

proc material_vel_dep_cond {mat} {
    set coef [$mat si_value fluid_conductivity_vdep_coeff]
    set exp [$mat si_value fluid_conductivity_vdep_exp]
    set baseval [$mat si_value fluid_conductivity_constant]
    
    set stuff "\
  real k_lam, vmag2, vmag;\n\
  real uvel = C_U(cell,thread);\n\
  real vvel = C_V(cell,thread);\n\
  real wvel = C_W(cell,thread);\n\
\n\
  vmag2 = pow(uvel,2) + pow(vvel,2) + pow(wvel,2);\n\
  vmag = sqrt(vmag2);\n\
\n\
  if (fabs(vmag) > 0.0)\n\
    k_lam = $coef * pow(vmag, $exp);\n\
  else\n\
    k_lam = $baseval;\n\
\n\
  return k_lam;"
    
    set sfname [write_case_udf_property $stuff]
    
    return "(user-defined \"$sfname\") (constant . 0.8)" ;# 2nd retval is ignored.
}

proc material_uns_definition {matname mattype {override_vals ""}} {
    global is_airpak problem_ideal_gas
    global problem_oaltitude 
    
    set mat [get_material $matname $mattype]
    if {$mat == ""} {
	user_error "The material $matname can't be found."
	return ""
    }
    
    
    foreach {n v} $override_vals { 
	set over($n) $v 
    }
    
    set vals ""
    switch [$mat getval mat_type] {
	surface {
	    lappend vals solid
	    lappend vals "(emissivity [material_uns_param $mat emissivity])"
	    # these aren't actually used -- maybe this is okay but ...
	    lappend vals "(density (constant . 1))"
	    lappend vals "(specific-heat (constant . 1))"
	    lappend vals "(thermal-conductivity (constant . 1))"
	}
	solid {
	    lappend vals solid
	    
	    if { $override_vals == ""} {
		lappend vals "(density [material_uns_param $mat density])"
	    } elseif {[ info exists over(solid_density) ]} {
		lappend vals "(density (constant . $over(solid_density)))"
	    } else {
		lappend vals "(density [material_uns_param $mat density])"
	    }
	    
	    if { $override_vals == ""} {		
		lappend vals "(specific-heat [material_uns_param $mat sp_heat])" 
	    } elseif {[ info exists over(solid_sp_heat_constant) ]} {
		lappend vals "(specific-heat (constant . $over(solid_sp_heat_constant)))"
	    } else {
		lappend vals "(specific-heat [material_uns_param $mat sp_heat])" 
	    }
	    
	    if { $override_vals == ""} {
		
		set cval [material_uns_param $mat conductivity]
		switch [$mat si_value solid_conductivity_type] {
		    iso {
			lappend vals "(thermal-conductivity $cval)"
		    }
		    ortho {
			foreach i {x y z} {
			    set $i [$mat si_value solid_conductivity_$i]
			}
			lappend vals "(thermal-conductivity (anisotropic\
			(matrix $x 0 0  0 $y 0  0 0 $z) (k $cval)))"
		    }
		    biaxial {
			set nv [$mat si_value solid_conductivity_n]
			set pv [$mat si_value solid_conductivity_p]
			lappend vals "(thermal-conductivity (biaxial (k0 (constant . $pv)) (k1 (constant . $nv))) (constant . $cval))"
		    }
		    noniso {
			set tens ""
			foreach t [$mat si_value solid_conductivity_tensor] {
			    lappend tens [expression_evaluate $t]
			}
			lappend vals "(thermal-conductivity (anisotropic\
			(matrix $tens) (k $cval)))"			
		    }
		}
	    } else {
		set c_type $over(solid_conductivity_type)
		switch $c_type   {
		    iso {
			lappend vals "(thermal-conductivity (constant . $over(solid_conductivity_constant)))"
		    }
		    ortho {
			foreach i {x y z} {
			    set $i $over(solid_conductivity_$i)
			}
			lappend vals "(thermal-conductivity (anisotropic\
			(matrix $x 0 0  0 $y 0  0 0 $z) (k (constant . 1))))"
		    }
		    biaxial {
			set nv $over(solid_conductivity_n)
			set pv $over(solid_conductivity_p)
			lappend vals "(thermal-conductivity (biaxial (k0 (constant . $pv)) (k1 (constant . $nv))) (constant . $cval))"
		    }
		}
		
	    }
	}
	fluid {
	    lappend vals fluid
	    lappend vals "(chemical-formula . \#f)"
	    set dens [material_uns_param $mat density]
	    if {$problem_oaltitude > 0 && $matname == "Air" } {
		set altitude_pressure [pressure_from_altitude]
		# assuming no one specifies operating pressure in non-si units
		set airdensity [$mat si_value fluid_density]
		set airdensity [expr $airdensity * $altitude_pressure / 101325.0]
		set dens "(constant . $airdensity) "
		mess "At altitude $problem_oaltitude, air density = $airdensity kg/m3\n"
	    }
	    if {[expression_evaluate $problem_ideal_gas] && ([$mat getval mat_subtype] == "Gases")} {
		lappend vals "(density (incompressible-ideal-gas . #f) $dens)"
	    } else {
		lappend vals "(density $dens)"
	    }
	    lappend vals "(specific-heat [material_uns_param $mat sp_heat])"
	    switch [$mat si_value fluid_conductivity_whichdep] {
		temperature {
		    lappend vals "(thermal-conductivity\
				[material_uns_param $mat conductivity])"
		}
		velocity {
		    lappend vals "(thermal-conductivity\
				[material_vel_dep_cond $mat])"
		    
		}
	    }
	    
	    lappend vals "(viscosity [material_uns_param $mat viscosity]\
				  (sutherland 1.7894e-05 273.11 110.56)\
    				  (power-law 1.7894e-05 273.11 0.666))"
	    lappend vals "(diffusivity [material_uns_param $mat diffusivity])"
	    lappend vals "(molecular-weight\
				[material_uns_param $mat mol_weight])"
	    if {[info exists is_airpak] && $is_airpak} {
		lappend vals "(absorption-coefficient (constant . 0.0))"
		lappend vals "(uds-diffusivity (user-defined \"mean_age_diff\"))"
	    } else {
		lappend vals "(absorption-coefficient (constant . 0.5))"
	    }
	    lappend vals "(therm-exp-coeff\
				[material_uns_param $mat vol_expansion])"
	    
	}
    }
    return $vals
}

# ------------------------------------------------------------------------
proc close_var_mat {prefix} {
    if [winfo exists .var_mat_${prefix}] {
	form_accept_hack .var_mat_${prefix}
    }
}

proc app_make_form_material {d} {
    global is_airpak
    
    form_frame $d.type flat 0 {0 0}
    form_frame $d.sub ridge 2 {1 0}
    
    #form_frame $d.bot flat 0 {2 0}
    #form_button $d.bot.load "Load library" mat_read_library {0 0}
    #form_button $d.bot.save "Save library" mat_write_library {0 1}
    
    # -------------------------------
    
    form_label $d.type.lab "Material type:" {0 0}
    
    form_radiobutton $d.type.solid "Solid" model_data(mat_type) solid {0 1}
    form_radiobutton $d.type.surface "Surface" model_data(mat_type) surface {0 2}
    form_radiobutton $d.type.fluid "Fluid" model_data(mat_type) fluid {0 3}
    
    form_label $d.type.slab "Sub-type:" {1 0}
    form_entry $d.type.stype model_data(mat_subtype) string {1 1 -cols 3}
    
    # -------------------------------
    
    set sf $d.sub.solid
    form_choiceframe $sf
    
    form_label $sf.densl "Density" {0 0}
    model_unitentry $sf.dens model_data(solid_density) density {0 1}

    set sp_act  {{model_data(solid_sp_heat_on) "0"}}
    form_label $sf.specl "Specific heat" {1 0}
    model_unitentry $sf.spec model_data(solid_sp_heat_constant) sp_heat {1 1} $sp_act
    form_checkbutton $sf.checkb "" model_data(solid_sp_heat_on) {1 2} "" "close_var_mat solid_sp_heat"
    form_button $sf.specb "Edit" "material_var solid_sp_heat {solid specific heat} sp_heat 0" {1 3} model_data(solid_sp_heat_on)
   
    form_label $sf.condl "Conductivity" {2 0}
    set cond_act  {{model_data(solid_conductivity_on) "0"}}
    model_unitentry $sf.cond model_data(solid_conductivity_constant) conductivity {2 1} $cond_act
    form_checkbutton $sf.cond_checkb "" model_data(solid_conductivity_on) {2 2}  "" "close_var_mat solid_conductivity"
    form_button $sf.condb "Edit" "material_var solid_conductivity {solid conductivity} conductivity 0" {2 3} model_data(solid_conductivity_on)
    
    form_frame $sf.cont flat 0 {3 0 -cols -}
    form_label $sf.cont.ctypel "Conductivity type" {0 0}
    futil_menuentry_labels $sf.cont.ctype model_data(solid_conductivity_type) \
	{list {iso Isotropic} {ortho Orthotropic} {noniso Anisotropic} {biaxial Biaxial}} {0 1}
    
    form_frame $sf.cont.sub flat 0 {2 0 -cols 2}
    
    # ----------------------
    
    set cc $sf.cont.sub.iso
    form_choiceframe $cc
    
    # ----------------------
    
    set cc $sf.cont.sub.ortho
    form_choiceframe $cc
    
    form_label $cc.xl X {0 0}
    form_label $cc.yl Y {0 2}
    form_label $cc.zl Z {0 4}
    form_entry $cc.x model_data(solid_conductivity_x) float_expr {0 1}
    form_entry $cc.y model_data(solid_conductivity_y) float_expr {0 3}
    form_entry $cc.z model_data(solid_conductivity_z) float_expr {0 5}
    # ----------------------
    
    set cc $sf.cont.sub.noniso
    form_choiceframe $cc
    
    form_label $cc.tl "Tensor" {0 0}
    form_entry $cc.te model_data(solid_conductivity_tensor) string {0 1} 
    form_button $cc.tedit "Edit" \
	{edit_tensor .mat_ctensor solid_conductivity_tensor "Anisotropic tensor" 1} \
	{0 2}
    
    # ----------------------
    
    set cc $sf.cont.sub.biaxial
    form_choiceframe $cc
    
    form_label $cc.nl Normal {0 0}
    form_label $cc.pl In-plane {0 2}
    form_entry $cc.n model_data(solid_conductivity_n) float_expr {0 1}
    form_entry $cc.p model_data(solid_conductivity_p) float_expr {0 3}
    
    # -------------------------------
    
    futil_setup_switch $sf.cont.sub model_data(solid_conductivity_type)
    
    set sf $d.sub.surface
    form_choiceframe $sf
    
    form_label $sf.roughl "Roughness" {0 0}
    model_unitentry $sf.rough model_data(surface_roughness) roughness {0 1}
    
    form_label $sf.emisl "Emissivity" {1 0}
    model_unitentry $sf.emis model_data(surface_emissivity) emissivity {1 1}
    
    if $is_airpak {
	form_label $sf.absorb_il "Solar Absorptance - normal incidence" {2 0}
	form_entry $sf.absorb_i model_data(surface_i_absorb) float {2 1}
	
	form_label $sf.trans_il "Solar Transmittance - normal incidence" {3 0}
	form_entry $sf.trans_i model_data(surface_i_trans) float {3 1}
	
	form_label $sf.absorb_dl "Hemispherical Diffuse Absorptance" {4 0}
	form_entry $sf.absorb_d model_data(surface_d_absorb) float {4 1}
	
	form_label $sf.trans_dl "Hemispherical Diffuse Transmittance" {5 0}
	form_entry $sf.trans_d model_data(surface_d_trans) float {5 1}
    }
    
    # -------------------------------
    
    set sf $d.sub.fluid
    form_choiceframe $sf
    
    form_label $sf.voll "Vol. expansion" {0 0}
    set vol_act  {{model_data(fluid_vol_expansion_on) "1"}}
    model_unitentry $sf.vol model_data(fluid_vol_expansion_constant) vol_expansion {0 1} $vol_act
    form_checkbutton $sf.vol_checkb "" model_data(fluid_vol_expansion_on) {0 2}  "" "close_var_mat fluid_vol_expansion"
    form_button $sf.volb "Edit" "material_var fluid_vol_expansion {fluid volume expansion} vol_expansion 0" {0 3} model_data(fluid_vol_expansion_on)
    
    form_label $sf.visl "Viscosity" {1 0}
    set visc_act  {{model_data(fluid_viscosity_on) "0"}}
    model_unitentry $sf.vis model_data(fluid_viscosity_constant) viscosity {1 1} $visc_act
    form_checkbutton $sf.vis_checkb "" model_data(fluid_viscosity_on) {1 2}  "" "close_var_mat fluid_viscosity"
    form_button $sf.visb "Edit" "material_var fluid_viscosity {fluid viscosity} viscosity 0" {1 3} model_data(fluid_viscosity_on)
    
    form_label $sf.densl "Density" {2 0}
    model_unitentry $sf.dens model_data(fluid_density) density {2 1}
    
    form_label $sf.specl "Specific heat" {3 0}
    set fsp_act  {{model_data(fluid_sp_heat_on) "0"}}
    model_unitentry $sf.spec model_data(fluid_sp_heat_constant) sp_heat {3 1} $fsp_act
    form_checkbutton $sf.spec_checkb "" model_data(fluid_sp_heat_on) {3 2}  "" "close_var_mat fluid_sp_heat"
    form_button $sf.specb "Edit" "material_var fluid_sp_heat {fluid specific heat} sp_heat 0" {3 3} model_data(fluid_sp_heat_on)
    
    form_label $sf.condl "Conductivity" {4 0}
    set fcond_act  {{model_data(fluid_conductivity_on) "0"}}
    model_unitentry $sf.cond model_data(fluid_conductivity_constant) conductivity {4 1} $fcond_act
    form_checkbutton $sf.cond_checkb "" model_data(fluid_conductivity_on) {4 2}  "" "close_var_mat fluid_conductivity"
    form_button $sf.condb "Edit" "material_var fluid_conductivity {fluid conductivity} conductivity 1" {4 3} model_data(fluid_conductivity_on)
    
    form_label $sf.difl "Diffusivity" {5 0}
    set diff_act  {{model_data(fluid_diffusivity_on) "0"}}
    model_unitentry $sf.dif model_data(fluid_diffusivity_constant) diffusivity {5 1} $diff_act
    form_checkbutton $sf.dif_checkb "" model_data(fluid_diffusivity_on) {5 2}  "" "close_var_mat fluid_diffusivity"
    form_button $sf.difb "Edit" "material_var fluid_diffusivity {fluid diffusivity} diffusivity 0" {5 3} model_data(fluid_diffusivity_on)
    
    form_label $sf.moll "Molecular weight" {6 0}
    model_unitentry $sf.mol model_data(fluid_mol_weight) mol_weight {6 1}
    
    # -------------------------------
    
    futil_setup_switch $d.sub model_data(mat_type)
}

proc accept_if_not_blank_curve {prefix} {
    global model_data

    if {$model_data(${prefix}_valuetype) == "curve"} {
	
	if {![info exists model_data(${prefix}_curvespec)] || ([llength $model_data(${prefix}_curvespec)] == 0)} {
	    user_error "The curve contains no values"
	} else {
	    form_accept_hack .var_mat_$prefix
	}
    } else     {
	form_accept_hack .var_mat_$prefix
    }
}

proc material_var {prefix title fieldtype also_vel} {
    if $also_vel {
	set t "Temperature or velocity"
    } else {
	set t "Temperature"
    }

    set buts [list [list Accept "accept_if_not_blank_curve $prefix"] reset cancel help]
    set d1 [form_init .var_mat_$prefix "$t dependent $title" "model sub2" $buts]
    if {$d1 != ""} {
	if $also_vel {
	    form_frame $d1.sub flat 0 {1 0 -cols -}
	    set d $d1.sub.temperature
	    
	    form_choiceframe $d
	    
	    form_frame $d1.which flat 0 {0 0 -cols -}
	    form_radiobutton $d1.which.temp Temperature \
		model_data(${prefix}_whichdep) temperature {0 0}
	    form_radiobutton $d1.which.vel Velocity \
		model_data(${prefix}_whichdep) velocity {0 1}
	    form_colwidth $d1 0 4 M
	} else {
	    set d $d1
	}
	
	form_radiobutton $d.constant "Constant" \
	    model_data(${prefix}_valuetype) constant {1 1 -cols 2}
	form_radiobutton $d.linear "Linear" \
	    model_data(${prefix}_valuetype) linear {10 1 -cols 2}
	form_radiobutton $d.curve "Curve"  \
	    model_data(${prefix}_valuetype) curve {20 1 -cols 2}
	form_colwidth $d 0 4 M
	
	set mcon [list [list model_data(${prefix}_valuetype) constant]]
	set mlin [list [list model_data(${prefix}_valuetype) linear]]
	set mcur [list [list model_data(${prefix}_valuetype) curve]]
	
	model_unitentry $d.constant_v model_data(${prefix}_constant) \
	    $fieldtype {1 3} $mcon
	
	form_label $d.linlab "v = v0 + C (T-Tref)" {11 2 -cols -} $mlin
	form_label $d.linvl "    v0" {12 2} $mlin
	form_label $d.lincl "    C" {13 2} $mlin
	form_label $d.lintrl "    Tref" {14 2} $mlin
	
	model_unitentry $d.linv model_data(${prefix}_val0) \
	    $fieldtype {12 3} $mlin
	form_entry $d.linc model_data(${prefix}_coeff) float {13 3} $mlin
	model_unitentry $d.lintr model_data(${prefix}_tref) \
	    temperature {14 3} $mlin
	
	form_menubutton $d.cedit " Edit " $d.cedit.m {20 3} $mcur
	$d.cedit configure -relief raised -borderwidth 2
	menu $d.cedit.m -tearoff 0
	$d.cedit.m add command -label "Graph editor" \
	    -command [list material_graph_editor $title $prefix $fieldtype]
	$d.cedit.m add command -label "Text editor" \
	    -command [list material_text_editor $title $prefix $fieldtype]
	
	if $also_vel {
	    set d $d1.sub.velocity
	    form_choiceframe $d
	    
	    form_label $d.col "Coefficient" {1 0}
	    form_label $d.pow "Exponent" {2 0}
	    
	    form_entry $d.co model_data(${prefix}_vdep_coeff) float {1 1}
	    form_entry $d.po model_data(${prefix}_vdep_exp) float {2 1}
	    
	    futil_setup_switch $d1.sub model_data(${prefix}_whichdep)
	}
	
	form_finish bot
    }
}

proc material_text_editor {title prefix utype} {
    global model_data tmp_curvespec model_data_units
    
    set mess "The following curve specification consists of a list of\
		temperature / $utype pairs, which define a piecewise-linear\
		curve.  Spacing is not significant as long as the numbers\
		are given in pairs."
    set cs ${prefix}_curvespec
    set tmp_curvespec [units_curve_convert $model_data($cs) \
			   $model_data_units(${cs}_x) \
			   $model_data_units(${cs}_y) 1 1 1]
    
    set d [form_init .curve_$prefix "Curve specification" "model sub" "" "" 1 1 1]
    if {$d != ""} {
	form_message $d.mess $mess {0 0}
	form_text $d.text "" tmp_curvespec {1 0}
	form_frame $d.un flat 0 {2 0}
	form_label $d.un.l1 "Temperature units" {0 0}
	form_label $d.un.l2 "$title units" {0 2}
        futil_unitmenu $d.un.m1 "unit_get_choices temperature" \
	    {0 1} model_data_units(${cs}_x)
        futil_unitmenu $d.un.m2 "unit_get_choices $utype" \
	    {0 3} model_data_units(${cs}_y)
	form_finish
    }
    form_text_set .curve_$prefix.main.text $tmp_curvespec
    if ![form_wait .curve_$prefix] return
    set tmp_curvespec [form_text_get .curve_$prefix.main.text]
    
    set model_data($cs) [units_curve_convert $tmp_curvespec \
			     $model_data_units(${cs}_x) \
			     $model_data_units(${cs}_y) 0 1 1]
    edit_modify_params
}

proc material_graph_editor {title prefix utype} {
    global model_data tmp_curvespec model_data_units
    
    set cs ${prefix}_curvespec
    set tc [units_curve_convert $model_data($cs) \
		$model_data_units(${cs}_x) $model_data_units(${cs}_y) 1 1 1]
    set spec ""
    foreach {x y} $tc { lappend spec [list $x $y] }
    
    set xval "Temperature ($model_data_units(${cs}_x))"
    set yval "$title ($model_data_units(${cs}_y))"
    set labs [list "X = $xval\nY = $yval"]
    
    set ndata [curve_editor .material_curve "Temperature/value curve" \
		   +300+300 "" $labs [list $spec]]
    if {$ndata == ""} return
    
    set nc ""
    foreach pt [lindex $ndata 0] {
	lappend nc [lindex $pt 0] [lindex $pt 1]
    }
    set model_data($cs) [units_curve_convert $nc \
			     $model_data_units(${cs}_x) \
			     $model_data_units(${cs}_y) 0 1 1]
    edit_modify_params
}

proc app_clean_up_material {obj} {
    global problem_temp
    
    $obj setval mat_subtype [string totitle [$obj getval mat_subtype]]
    
    if [$obj checkval surface_emissivity_valuetype] {
	set cval [get_constant_matval_object $obj surface_emissivity]
	$obj setval surface_emissivity $cval
	if {[$obj si_value surface_emissivity_valuetype] != "constant"} {
	    mess "Warning: changed \"[$obj getval name]\" surface emissivity to $cval\n" red
	}
	$obj unset surface_emissivity_valuetype
    }
    if {[$obj si_value solid_conductivity_type] == "noniso"} {
	set ok 0
	set tens [$obj si_value solid_conductivity_tensor]
	foreach p {1 2 3 5 6 7} {
	    if {[string compare [lindex $tens $p] "0"]} { set ok 1; break }
	}
	if !$ok {
	    $obj setval solid_conductivity_x [lindex $tens 0]
	    $obj setval solid_conductivity_y [lindex $tens 4]
	    $obj setval solid_conductivity_z [lindex $tens 8]
	    $obj setval solid_conductivity_type ortho
	    mess "Converted conductivity type for \"[$obj getval name]\"\
		from anisotropic to orthotropic\n"
	}
    }
    if {[$obj si_value solid_conductivity_type] == "ortho"} {
	if {([$obj si_value solid_conductivity_x] ==
	     [$obj si_value solid_conductivity_y]) &&
	    ([$obj si_value solid_conductivity_y] ==
	     [$obj si_value solid_conductivity_z])} {
	    
	    $obj setval solid_conductivity_type iso
	    mess "Converted conductivity type for \"[$obj getval name]\"\
		from orthotropic to isotropic\n"
	}
    }
    switch [$obj getval mat_type] {
	solid {
	    if {[$obj si_value solid_density] == 0} {
		mess "Density must be non-0\n" red
	    }
	    if {[$obj si_value solid_conductivity_constant] == 0} {
		mess "Conductivity must be non-0\n" red
	    }
	    if {[$obj si_value solid_sp_heat_constant] == 0} {
		mess "Specific heat must be non-0\n" red
	    }
	    if {[$obj si_value solid_conductivity_type] == "ortho"} {
		foreach x {x y z} {
		    if {[$obj si_value solid_conductivity_$x] == 0} {
			mess "Solid conductivity $x value must be non-0\n" red
		    }
		}
	    }
	}
	fluid {
	    if {[$obj si_value fluid_density] == 0} {
		mess "Density must be non-0\n" red
	    }
	    if {[$obj si_value fluid_conductivity_constant] == 0} {
		mess "Conductivity must be non-0\n" red
	    }
	    if {[$obj si_value fluid_sp_heat_constant] == 0} {
		mess "Specific heat must be non-0\n" red
	    }
	    if {[$obj si_value fluid_viscosity_constant] == 0} {
		mess "Viscosity must be non-0\n" red
	    }
	    if {[$obj si_value fluid_vol_expansion_constant] == 0} {
		mess "Volume expansion must be non-0\n" red
	    }
	}
    }
    
    # This is to patch up some problems...
    foreach p {
	solid_density fluid_density 
	surface_roughness surface_emissivity
    } {
	if [$obj checkval ${p}_constant] {
	    $obj setval $p [$obj si_value ${p}_constant]
	    foreach v [$obj list_values] {
		if [string match ${p}_* [lindex $v 0]] {
		    $obj unset [lindex $v 0]
		}
	    }
	}
    }
}

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

# layers is a list of frac thick pairs where frac is the fraction of metal

proc mat_composite_conductivity {metal_mat insul_mat layers barea ithick} {
    set mmat [get_material $metal_mat solid]
    set imat [get_material $insul_mat solid]
    if {$mmat == ""} {
	user_error "Material $metal_mat not found"
	return "1 1"
    }
    if {$imat == ""} {
	user_error "Material $insul_mat not found"
	return "1 1"
    }
    if {([$mmat si_value solid_conductivity_type] != "iso") || \
	    ([$imat si_value solid_conductivity_type] != "iso")} {
	user_error "Both metal and insulator materials must be isotropic"
	return "1 1"
    }
    set mcond [$mmat si_value solid_conductivity_constant]
    set icond [$imat si_value solid_conductivity_constant]
    
    # First in the thick direction
    set tthick 0.0
    set tres 0.0
    foreach {frac thick} $layers {
	set econd [expr $frac * $mcond + (1 - $frac) * $icond]
	# resistance = thickness/(k*cross-sectional area), k is conductivity.
	set res [expr $thick / ($econd * $barea)]
	set tthick [expr $tthick + $thick]
	set tres [expr $tres + $res]
    }
    # Finally the insulator
    set res [expr $ithick / ($icond * $barea)]
    set tthick [expr $tthick + $ithick]
    set tres [expr $tres + $res]
    
    if {$tthick == 0} {
	user_error "Zero total thickness for the board"
	return "1 1"
    }
    
    # After you compute the effective resistance in the planar and normal 
    # directions (say Reff),
    # the conductivity value in that direction is = total thickness /
    # (cross-sectional area * Reff)
    set thick_cond [expr $tthick / ($barea * $tres)]
    
    # Now in the lateral direction
    set tcond 0.0
    foreach {frac thick} $layers {
	set econd [expr ($frac * $mcond + (1 - $frac) * $icond) * $thick]
	set tcond [expr $tcond + $econd]
    }
    
    set lat_cond [expr ($tcond + $icond * $ithick) / $tthick]
    return [list $thick_cond $lat_cond]
}

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

proc mat_edit_form {} {
    global mat_cur_edit_type mat_cur_edit_subtype mainwindow_menubar
    global edit_frame
    
    set newstyle [expr {[info exists mainwindow_menubar] && 
			$mainwindow_menubar}]
    
    if ![winfo exists $edit_frame.mat] {
	load_materials
	
	frame $edit_frame.mat
	frame $edit_frame.mat.buttons -relief ridge -borderwidth 2
	grid $edit_frame.mat.buttons -row 4 -column 0 -sticky ew
	grid column $edit_frame.mat 0 -weight 1
	
	if !$newstyle {
	    label $edit_frame.mat.title -text Materials
	    frame $edit_frame.mat.types -relief ridge -borderwidth 2
	    frame $edit_frame.mat.subtypes -relief ridge -borderwidth 2
	    frame $edit_frame.mat.objects -relief ridge -borderwidth 2
	    
	    grid $edit_frame.mat.title -row 0 -column 0 -sticky ew
	    grid $edit_frame.mat.types -row 1 -column 0 -sticky ew
	    grid $edit_frame.mat.subtypes -row 2 -column 0 -sticky ew
	    grid $edit_frame.mat.objects -row 3 -column 0 -sticky ew
	    
	    set t $edit_frame.mat.types
	    radiobutton $t.solid -text Solid -variable mat_cur_edit_type \
		-value solid -command mat_edit_update_type
	    radiobutton $t.fluid -text Fluid -variable mat_cur_edit_type \
		-value fluid -command mat_edit_update_type
	    radiobutton $t.surface -text Surface -variable mat_cur_edit_type \
		-value surface -command mat_edit_update_type
	    
	    grid $t.solid -row 0 -column 0 -sticky w
	    grid $t.fluid -row 1 -column 0 -sticky w
	    grid $t.surface -row 2 -column 0 -sticky w
	    grid column $t 0 -weight 1
	}
	
	set b $edit_frame.mat.buttons
	if !$newstyle {
	    button $b.new -text New -command mat_edit_new
	    button $b.delete -text Delete -command mat_edit_delete
	    button $b.copy -text Copy -command mat_copy_current
	    button $b.edit -text Edit -command edit_current_object
	    button $b.read -text Load -command mat_read_library
	    button $b.write -text Save -command mat_write_library
	    grid $b.new -row 0 -column 0 -sticky ew
	    grid $b.delete -row 0 -column 1 -sticky ew
	    grid $b.edit -row 1 -column 0 -sticky ew
	    grid $b.copy -row 1 -column 1 -sticky ew
	    grid $b.read -row 2 -column 0 -sticky ew
	    grid $b.write -row 2 -column 1 -sticky ew
	}
	grid column $b 0 -weight 1 -minsize 1
	grid column $b 1 -weight 1 -minsize 1
    }
    
    grid $edit_frame.mat -row 0 -column 0 -sticky ew
    
    if !$newstyle {
	check_box $edit_frame.mat.subtypes  "" 6 "" 0
	check_box $edit_frame.mat.objects  "" 6 "" 0
	
	bind $edit_frame.mat.objects.list <Button-1> "edit_select_action %W \[%W nearest %y\]"
	bind $edit_frame.mat.objects.list <Double-Button-1> edit_current_object
    }
    update
    grid propagate $edit_frame.mat 0
    
    set mat_cur_edit_type solid
    mat_edit_update_type
}

proc mat_edit_new {} {
    global mat_cur_edit_type mat_cur_edit_subtype
    
    set obj [edit_new material "" 1 "" [list mat_type $mat_cur_edit_type \
					    mat_subtype $mat_cur_edit_subtype]]
    mat_edit_update_subtype
    model_set_current $obj
    edit_selection_set $obj
}

proc mat_edit_delete {} {
    global current_object species default_fluid_material
    
    # delete the material from any species it shows up in.
    if {$species(available) && ($current_object != "")} {
	set mname [$current_object getval name]
	for {set i 1} {$i <= $species(count)} {incr i} {
	    puts $species(name$i)
	    if {$species(name$i) == $mname} {
		set species(name$i) $default_fluid_material
	    }
	}
    }
    
    edit_delete
    mat_edit_update_subtype
}

proc mat_edit_update_type {} {
    global mat_cur_edit_type mat_cur_edit_subtype
    global edit_frame
    
    if ![winfo exists $edit_frame.mat.subtypes] return
    
    catch {unset mat_cur_edit_subtype}
    
    foreach mat [db_list_objects material] {
	if {[$mat getval mat_type] == $mat_cur_edit_type} {
	    lappend found([$mat getval mat_subtype]) 1
	}
    }
    
    set opts ""
    foreach m [lsort [array names found]] {
	set n $m; if {$n == ""} { set n "(no subtype)" }
	lappend opts [list $m -text $n -command mat_edit_update_subtype]
	if ![info exists mat_cur_edit_subtype] { set mat_cur_edit_subtype $m }
    }
    
    check_box $edit_frame.mat.subtypes $opts 6 mat_cur_edit_subtype 0
    mat_edit_update_subtype
}

proc mat_edit_update_subtype {} {
    global mat_cur_edit_type mat_cur_edit_subtype current_object
    global edit_frame
    
    if ![winfo exists $edit_frame.mat.subtypes] return
    
    if ![info exists mat_cur_edit_type] return ;# maybe we got here too fast
    
    set found ""
    
    foreach mat [db_list_objects material] {
	if {([$mat getval mat_type] == $mat_cur_edit_type) &&
	    ([$mat getval mat_subtype] == $mat_cur_edit_subtype)} {
	    lappend found [$mat getval name]
	}
    }
    
    set opts ""
    foreach m [lsort $found] {
	lappend opts [list $m]
	if ![info exists mat_cur_edit_subtype] { set mat_cur_edit_subtype $m }
    }
    check_box $edit_frame.mat.objects $opts 6 "" 0
}

proc mat_write_library {} {
    global mat_save_selected
    
    load_materials
    
    set opts1 ""
    foreach obj [db_list_objects material] {
	set name "[string totitle [$obj getval mat_type]]:\
		[$obj getval mat_subtype]: [$obj getval name]"
	lappend opts1 [list $name $obj]
    }
    set opts ""
    foreach mm [lsort $opts1] {
	lappend opts [list [lindex $mm 1] -text [lindex $mm 0]]
    }
    
    catch {unset mat_save_selected} ;# might have been done previously
    if ![check_box_form .save_mats "Select a subset of the following\
	materials to save." $opts 16 mat_save_selected] return
    
    set objs ""
    foreach m [array names mat_save_selected] {
	if $mat_save_selected($m) {
	    lappend objs $m
	}
    }
    if {$objs == ""} { mess "No materials selected\n" red; return }
    
    set file [file_selection -message "Select a materials database to write." \
		  -new_ok 1 -delete_button 1 -mkdir_button 1 -get_dir 1]
    if {$file == ""} return
    cmd_mkdir $file
    set file $file/materials
    
    if [file exists $file] {
	if [tk_dialog .overwrite_mat "Overwrite" "Overwrite existing material library $file?" "" -1 Yes No] return
    }
    
    mess "Writing [llength $objs] materials to $file ..."
    set fp [open $file w]
    model_write $fp $objs
    close $fp
    mess " done.\n"
}

proc mat_append_to_library {objs lib} {
    global whoami version current_object model_data
    
    set dir [library_dir $lib]
    
    if [file exists $dir/materials] {
	set fp [open $dir/materials a]
    } else {
	set fp [open $dir/materials w]
	
	# First put out the header.
	puts $fp "#@ $whoami $version model file\n"
    }
    
    set newobjs ""
    foreach obj $objs {
	if {[$obj getval mat_lib_path] != ""} {
	    set obj [db_copy $obj]
	}
	model_write_object $fp $obj ""
	$obj setval mat_lib_path $dir
	if {$obj == $current_object} { set model_data(mat_lib_path) $dir }
	lappend newobjs $obj
    }
    close $fp
    tree_reparent_objects $newobjs
}

proc mat_read_library {} {
    global material_load_count
    
    set file [file_selection -message "Select a materials database to read."]
    if {$file == ""} return
    set material_load_count 0
    model_read $file 1 0
    mess "$material_load_count materials loaded.\n"
    mess "Note that when you save the current project these materials will be saved with it.\n"
    unset material_load_count
}

proc mat_get_used_by_object_types {} {
    global object_params materials_used_by_objects
    
    foreach obtype [array names object_params] {
	foreach param $object_params($obtype) {
	    if [string match \#* $param] continue
	    set name [lindex $param 1]
	    set ptype [lindex $param 2]
	    if {[lindex $ptype 0] == "mat"} {
		lappend materials_used_by_objects($obtype,[lindex $ptype 1]) \
		    $name
	    }
	}
    }
}

proc mat_change_object_materials {obj mat} {
    global object_params materials_used_by_objects current_object
    
    if {$obj == $current_object} { edit_modify_params }
    
    foreach p $materials_used_by_objects([$obj getval obtype],[$mat getval mat_type]) {
	undo_record_change_object $obj \
	    [list $p [$obj getval $p] [$mat getval name]]
	$obj setval $p [$mat getval name]
    }
    
    if {$obj == $current_object} { edit_reset_params }
    db_dirty model
}

proc mat_save_from_libraries {} {
    global model_container_root
    
    set objs ""
    foreach obj [$model_container_root list_contents creation_order int] {
	set obtype [$obj getval obtype]
	if {($obtype == "material") && \
		([$obj getval mat_lib_path ""] != "")} {
	    lappend objs $obj
	}
    }
    if {$objs == ""} { return "" }
    
    set file [directory]/materials_from_libraries
    set fp [open $file w]
    model_write $fp $objs
    close $fp
    return $file
}

proc mat_save_back_to_library {lib} {
    global model_container_root whoami version
    
    set dir [library_dir $lib]
    if {[file exists $dir/library_read_only] ||
	![file writable $dir/materials]} {
	user_error "Can't save back to a read-only library!"
	return
    }
    
    set objs ""
    foreach obj [$model_container_root list_contents creation_order int] {
	set obtype [$obj getval obtype]
	if {($obtype == "material") && \
		([$obj getval mat_lib_path ""] == $lib)} {
	    lappend objs $obj
	}
    }
    
    set fp [open $dir/materials w]
    puts $fp "#@ $whoami $version model file\n"
    
    foreach obj $objs {
	model_write_object $fp $obj ""
    }
    close $fp
    mess "Saved materials back to $lib/materials\n"
}
