
# Profile 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


set profile_types {
    pressure temperature speed power/area power/volume heat_tr_coeff heat_flux turbulent_k turbulent_o
}

set pp object_params(profile)
set $pp {
    { "Value type"            prof_type       string "temperature" }
    { "Units"                 prof_units_y    string ""  }
    { "Length Units"          prof_units_x    string "length" }
    { "Profile Data"          profile         string "" }
}


set never_ignore(profile,prof_type) 1

set object_type_title(profile) "Profiles"
set object_edit_info(profile) { }
set type_name(profile) profile


set tree_always_detail(profile) 3
set tree_always_alpha_sort(profile) 1


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

proc model_profentry {w var type tabgeo {act ""} {inc_default 0}} {
    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
    $w.e configure -relief flat -borderwidth 0
    futil_choicelist $w.e "choice default" \
	"list_profiles_for_menu $type $inc_default" \
	{0 1 -padx 0 -pady 0} $act "" "profile_entry_pick_by_name $w.e $vkey $type"
}

proc profile_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_profile $cur $mtype]
	    prof_print_to_mess $obj
	    return ""
	}
	"Edit definition" {
	    if !$edit_nameactive_okay {
 		popup "Edit profile" "Sorry, it's not possible to edit the definition for this profile in group edit mode.  Please use the Edit command in the Model / Profiles menu instead."
 		return ""
 	    }
	    set nname [prof_edit_definition $cur $mtype]
	    return $nname
	}
	"Create profile" {
	    if !$edit_nameactive_okay {
		popup "Create profile" "Sorry, it's not possible to create new profiles in group edit mode.  Please use the New command in the Model / Profiles menu instead."
		return ""
	    }
	    set val [prof_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 prof_edit_definition {cur mtype} {
    global model_data current_object
    
    set ocur ""
    if {$current_object != ""} {
	edit_modify_params
	set ocur $current_object
    }
    
    #update_mtype profile
    set obj [get_profile $cur $mtype]
    model_set_current $obj
    set w [edit_current_object]
    form_wait $w
    
    set nname [$obj getval name]
    
    if {$ocur != "none"} {
	#update_mtype $otype
	model_set_current $ocur
	edit_current_object
    }

    return $nname
}

proc prof_create_custom {vkey mtype} {
    global model_data current_object current_mtype
    
    set otype $current_mtype
    if {$otype == "none"} {
	form_cancel_class model
	set defname [[part_get_root] new_name $vkey]
    } else {
	edit_modify_params
	set ocur $current_object
	set defname "$model_data(name) $vkey"
    }
    
#    update_mtype profile
    set obj [edit_new profile $defname 1 "" \
		 [list prof_type $mtype prof_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 {$otype != "none"} {
	model_set_current $ocur
	edit_current_object
    }
    if $ok {
	return [$obj getval name]
    } else {
	return ""
    }
}

proc prof_copy_current {} {
    global current_object
    
    set new [db_copy $current_object]
    $new setval from_library 0
    #    prof_edit_update_subtype
    model_set_current $new
    edit_selection_set $new
}

proc prof_print_to_mess {obj} {
    set mt [$obj si_value prof_type]
    mess "\nProfile name: \"[$obj getval name]\", type $mt\n"
    foreach {v n} {
	prof_units_y "Units"
	prof_units_x "Length units"
	profile "Profile data"
    } {
	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 {
		    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 {
		    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_profiles {type} {
    
    set ret default
    foreach prof [db_list_objects profile] {
	if {[$prof si_value prof_type] == $type} {
	    lappend ret [$prof getval name]
	}
    }
    return $ret
}


proc get_profile {name {which ""} {error 1}} {
    if {$name == "default"} {
	global default_${which}_profile
	set name [set default_${which}_profile]
    }
#    load_profiles
    set top [part_get_root]
    set obj [$top get_name $name]
    if {$obj == ""} {
	if $error { mess "Error: no such profile $name\n" red }
	set obj [$top get_name [set default_${which}_profile]]
    }
    if {($which != "") && ([$obj si_value prof_type] != $which)} {
	user_error "expected $name to be a $which profile but it's\
		[$obj si_value prof_type]"
	return ""
    }
    return $obj
}

proc list_profiles_for_menu {type {inc_default 0 }} {
#    load_profiles
    set ret1 [list "View definition" "Edit definition" "Create profile" ""]
    if $inc_default { lappend ret default }
    set ok 0
    set ret2 ""
    foreach prof [db_list_objects profile] {

	
	if {([$prof si_value prof_type] == $type)} {
	    lappend found([$prof getval prof_subtype]) [$prof getval name]
	    set ret2 [concat $ret2 [$prof getval name] ]
	}
    }

    if { [llength $ret2] == 0 } {
	set ret1 [ list "Create profile" "" ]
    }
    set ret [concat $ret1 $ret2 ]
    return $ret
}


proc objects_with_profile {profname} {
    set ret ""
    foreach obj [db_list_objects] {
	foreach v [$obj list_values] {
	    if {[string match *profile* [lindex $v 0]] && \
		    ([lindex $v 1] == $profname)} {
		lappend ret $obj
	    }
	}
    }
    return $ret
}

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

proc profile_get_default {which} {
    global default_${which}_profile
    set name [set default_${which}_profile]
    if {$name == "default"} {
	user_error "The default $which profile is \"default\" - you must\
		set this value on the problem setup form\
 		to a specific profile name."
	return None
    }
    return $name
}

proc profile_uns_param {prof field} {
    # TO DO 
    if 0 {
    set mt [$prof si_value prof_type]

    switch [$prof si_value ${mt}_${field}_valuetype none] {
	none {
	    return "(constant . [$prof si_value ${mt}_${field}])"
	}
	constant {
	    return "(constant . [$prof si_value ${mt}_${field}_constant])"
	}
	linear {
	    set tref [$prof si_value ${mt}_${field}_tref]
	    set val0 [$prof si_value ${mt}_${field}_val0]
	    set coeff [$prof 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)"
	}
	curve {
	    # This is going to be in si anyway...  And there can be no
	    # expressions in the curves so we just grab the value.
	    set curvespec [$prof 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
	}
    }
    }
}


proc profile_uns_definition {profname {override_vals ""}} {
    global is_airpak problem_ideal_gas
    # TO DO
    if 0 {
    set prof [get_profile $profname]
    
    if {$prof == ""} {
	user_error "The profile $profname can't be found."
	return ""
    }
    
    
    foreach {n v} $override_vals { 
	set over($n) $v 
    }
    
    set vals ""
    switch [$prof si_value prof_type] {
	surface {
	    lappend vals solid
	    lappend vals "(emissivity [profile_uns_param $prof 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 [profile_uns_param $prof density])"
	    } elseif {[ info exists over(solid_density) ]} {
		lappend vals "(density (constant . $over(solid_density)))"
	    } else {
		lappend vals "(density [profile_uns_param $prof density])"
	    }
	    
	    if { $override_vals == ""} {		
		lappend vals "(specific-heat [profile_uns_param $prof 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 [profile_uns_param $prof sp_heat])" 
	    }
	    
	    if { $override_vals == ""} {
		
		set cval [profile_uns_param $prof conductivity]
		switch [$prof si_value solid_conductivity_type] {
		    iso {
			lappend vals "(thermal-conductivity $cval)"
		    }
		    ortho {
			foreach i {x y z} {
			    set $i [$prof si_value solid_conductivity_$i]
			}
			lappend vals "(thermal-conductivity (anisotropic\
			(matrix $x 0 0  0 $y 0  0 0 $z) (k $cval)))"
		    }
		    noniso {
			set tens ""
			foreach t [$prof 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))))"
		    }
		}
		
	    }
	}
	fluid {
	    lappend vals fluid
	    lappend vals "(chemical-formula . \#f)"
	    set dens [profile_uns_param $prof density]
	    if {[expression_evaluate $problem_ideal_gas] && ([$prof si_value prof_subtype] == "Gases")} {
		lappend vals "(density (incompressible-ideal-gas . #f) $dens)"
	    } else {
		lappend vals "(density $dens)"
	    }
	    lappend vals "(specific-heat [profile_uns_param $prof sp_heat])"
	    switch [$prof si_value fluid_conductivity_whichdep] {
		temperature {
		    lappend vals "(thermal-conductivity\
				[profile_uns_param $prof conductivity])"
		}
		velocity {
		    lappend vals "(thermal-conductivity\
				[profile_vel_dep_cond $prof])"
		    
		}
	    }
	    
	    lappend vals "(viscosity [profile_uns_param $prof viscosity]\
				  (sutherland 1.7894e-05 273.11 110.56)\
    				  (power-law 1.7894e-05 273.11 0.666))"
	    lappend vals "(diffusivity [profile_uns_param $prof diffusivity])"
	    lappend vals "(molecular-weight\
				[profile_uns_param $prof 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\
				[profile_uns_param $prof vol_expansion])"
	    
	}
    }
    return $vals
    }
}

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

proc app_make_form_profile {d} {
    
    global unit_choices profile_types
    global model_data tmp_curvespec model_data_units tmp_fixcurve unit_names

    form_frame $d.sub ridge 2 {1 0}
    
    # want similar to what is in the Curve specification window right now    
    
    set units1 length
    set num1 3
    set num2 1
    
    set tot [expr $num1 + $num2]
    set mess "The following curve specification consists of a list of\
		coordinates / value sets, with 3 coordinate values and\
		1 value in each set.  Spacing is not significant as\
		long as the numbers are given in sets of $tot."
    
    
    # Profile data type listbox above
    set tmp_curvespec [ units_curve_convert ${model_data(profile)} \
			    [set model_data(prof_units_x)] \
			    [set model_data(prof_units_y)] 1 $num1 $num2]
    set tmp_fixcurve(x) 0
    set tmp_fixcurve(y) 0
    
    # form_finish is called in "edit_current_object" in edit_auto.tcl
    # set buts [ list accept reset cancel ] 
    
    # form_init has been called in "edit_current_object" in edit_auto.tcl
    #    set d [form_init .${model_data(prof_type)}_curveedit "Curve specification" $formclass $buts]
    
    # want a drop down list of the parameters available here -
    # this then affects the units available to the user in the 
    # drop dowm units menu
    form_frame $d.type flat 0 {0 0}
    #    want in opts only the "profile_types" in the list 
    #    set opts [array names unit_choices]
    set opts $profile_types
    form_label $d.type.lab "Profile data type:" {0 0}    
    form_optionmenu $d.type.lbx model_data(prof_type) $opts {0 1}
    
    # HERE put all unit choices for now, but better only the types 
    # that Fluent wants for profiles
    
    
    form_message $d.mess $mess {1 0}
    form_text $d.text "" model_data(profile) {2 0}
    
    form_frame $d.un flat 0 {4 0}
    form_label $d.un.l1 "Length" {0 0}
    
    form_label $d.un.l12 " units" {0 1}
    set pref $d.text

    futil_unitmenu $d.un.m1 "unit_get_choices length" \
	{0 2} model_data(prof_units_x) "" \
    	"profile_units_fix $pref x $num1 $num2"
    #- to change units
    form_checkbutton $d.un.m1fix "Fix values" tmp_fixcurve(x) {0 3}
    if { [set unit_choices($model_data(prof_type))] != "" } {
	form_label_variable $d.un.l2 model_data(prof_type) {1 0}
	form_label $d.un.l3 " units" {1 1}
	futil_unitmenu $d.un.m2 { unit_get_choices ${model_data(prof_type)}} \
	    {1 2} model_data(prof_units_y) "" \
	    "profile_units_fix $pref y $num1 $num2" 
	#- to change units
	form_checkbutton $d.un.m2fix "Fix values" tmp_fixcurve(y) {1 3}
    }
    
    form_text_set $d.text $model_data(profile)
    #    if ![form_wait $d ] return
    set model_data(profile) [form_text_get $d.text]
    set model_data(profile) [units_curve_convert $tmp_curvespec \
				 [set model_data(prof_units_x)] \
				 [set model_data(prof_units_y)] 0 $num1 $num2]

}

proc profile_units_fix {pref v num1 num2 varname {ounits "" } { nunits ""}} {
    global model_data model_data_units tmp_fixcurve

    if !$tmp_fixcurve($v) return

    set vals [form_text_get ${pref} ]
    if {$v == "x"} {
	set vals2 [units_curve_convert $vals $ounits "" 0 $num1 $num2]
	set vals3 [units_curve_convert $vals2 $nunits "" 1 $num1 $num2]
    } else {
	set vals2 [units_curve_convert $vals "" $ounits 0 $num1 $num2]
	set vals3 [units_curve_convert $vals2 "" $nunits 1 $num1 $num2]
    }
    form_text_set $pref $vals3
}


proc app_clean_up_profile {obj} {
    global problem_temp
        
    # check that the value are on a plane?
    # find the plane normal from profile data
    # from normal get local origin
    # find length x+y for mapping coords
    
    
    if [$obj checkval surface_emissivity_valuetype] {
	set cval [get_constant_profval_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 si_value prof_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]
		}
	    }
	}
    }
}

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

proc prof_edit_form {} {
    global prof_cur_edit_type prof_cur_edit_subtype mainwindow_menubar
    global edit_frame
    
    set newstyle [expr {[info exists mainwindow_menubar] && 
			$mainwindow_menubar}]
    
    if ![winfo exists $edit_frame.prof] {
#	load_profiles
	
	frame $edit_frame.prof
	frame $edit_frame.prof.buttons -relief ridge -borderwidth 2
	grid $edit_frame.prof.buttons -row 4 -column 0 -sticky ew
	grid column $edit_frame.prof 0 -weight 1
	
	if !$newstyle {
	    label $edit_frame.prof.title -text Profiles
	    frame $edit_frame.prof.types -relief ridge -borderwidth 2
	    frame $edit_frame.prof.subtypes -relief ridge -borderwidth 2
	    frame $edit_frame.prof.objects -relief ridge -borderwidth 2
	    
	    grid $edit_frame.prof.title -row 0 -column 0 -sticky ew
	    grid $edit_frame.prof.types -row 1 -column 0 -sticky ew
	    grid $edit_frame.prof.subtypes -row 2 -column 0 -sticky ew
	    grid $edit_frame.prof.objects -row 3 -column 0 -sticky ew
	    
	    set t $edit_frame.prof.types
#	    radiobutton $t.solid -text Solid -variable prof_cur_edit_type \
		-value solid -command prof_edit_update_type
#	    radiobutton $t.fluid -text Fluid -variable prof_cur_edit_type \
		-value fluid -command prof_edit_update_type
###	    radiobutton $t.surface -text Surface -variable prof_cur_edit_type \
		-value surface -command prof_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.prof.buttons
	if !$newstyle {
	    button $b.new -text New -command prof_edit_new
###	    button $b.delete -text Delete -command prof_edit_delete
	    button $b.copy -text Copy -command prof_copy_current
	    button $b.edit -text Edit -command edit_current_object
#	    button $b.read -text Load -command prof_read_library
#	    button $b.write -text Save -command prof_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.prof -row 0 -column 0 -sticky ew
    
    if !$newstyle {
	check_box $edit_frame.prof.subtypes  "" 6 "" 0
	check_box $edit_frame.prof.objects  "" 6 "" 0
	
	bind $edit_frame.prof.objects.list <Button-1> "edit_select_action %W \[%W nearest %y\]"
	bind $edit_frame.prof.objects.list <Double-Button-1> edit_current_object
    }
    update
    grid propagate $edit_frame.prof 0
    
    set prof_cur_edit_type solid
#    prof_edit_update_type
}

proc prof_edit_new {} {
    global prof_cur_edit_type
    
    set obj [edit_new profile "" 1 "" [list prof_type $prof_cur_edit_type ]]

    model_set_current $obj
    edit_selection_set $obj
}

proc prof_edit_delete {} {
    edit_delete

}


proc prof_get_used_by_object_types {} {
    global object_params profiles_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] == "prof"} {
		lappend profiles_used_by_objects($obtype,[lindex $ptype 1]) \
		    $name
	    }
	}
    }
}

proc prof_change_object_profiles {obj prof} {
    global object_params profiles_used_by_objects current_object
    
    if {$obj == $current_object} { edit_modify_params }
    
    foreach p $profiles_used_by_objects([$obj getval obtype],[$prof getval prof_type]) {
	undo_record_change_object $obj \
	    [list $p [$obj getval $p] [$prof getval name]]
	$obj setval $p [$prof getval name]
    }
    
    if {$obj == $current_object} { edit_reset_params }
    db_dirty model
}					

#===NOT NEEDED?====================================================

if 0 {
    
proc vdep_res_create_profile {from vdep const curve flowlen basearea} {
    global heat_trans_laminar_constant
    set new [db_copy $from]
    
    foreach q {viscosity sp_heat} {
	if {[$new si_value fluid_${q}_valuetype] != "constant"} {
	    user_error "$q must be constant"
	    return
	}
    }
    
    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]
    set c1 $heat_trans_laminar_constant(c1)
    
    set coeff [expr pow(($h / $c1) * pow($flowlen * $m / $r, 0.5) * \
			    pow($m * $cp, -1/3.0), 1.5)]
    
    $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 -0.75
    
    return $new
}

proc profile_get_primary {obj} {
    global object_params object_primary_profile
    
    set t [$obj getval obtype]
    if [info exists object_primary_profile($t)] {
	set profp $object_primary_profile($t)
    } else {
	set profp ""
	foreach p $object_params($t) {
	    if [string match \#* $p] continue
	    if [string match prof* [lindex $p 2]] {
		set profp [list [lindex $p 1] [lindex [lindex $p 2] 1]]
		break
	    }
	}
	set object_primary_profile($t) $profp
    }
    if {$profp == ""} { return "" }
    set prof [$obj si_value [lindex $profp 0]]
    if {$prof == ""}  { return "" }
    if {$prof == "default"} {
	return [get_profile [profile_get_default [lindex $profp 1]]]
    } else {
	return [get_profile $prof]
    }
}

proc load_profiles {} {
    global profiles_loaded from_library_flag library_path env
    global profile_load_count use_conversion_routine_suffix is_airpak
    
    if [info exists profiles_loaded] return
    set profiles_loaded 1
    
    if 0 {
	don't do this any more
	# First let's see if we're just editing a profiles job
	set nprofs [llength [db_list_objects profile]]
	set nobjs [llength [db_list_objects]]
	
	if {$nprofs && ($nprofs == $nobjs - 1)} {
	    set m "It appears you are editing a profile library (no objects\
		except for profiles are available).  Do\
		you want to load the profiles from the other\
		libraries in your path now?"
	    if [tk_dialog .edit_prof "Editing profiles" $m "" 0 Yes No] {
		mess "No external profiles loaded\n"
		return
	    }
	}
    }
    
    mess "Please wait -- loading profile files ...\n"
    busy 1
    set from_library_flag 1
    set profile_load_count 0
    foreach lib $library_path {
	if $is_airpak {
	    set lib [replace_string $lib \$AIRPAK_ROOT $env(AIRPAK_ROOT)]
	} else {
	    set lib [replace_string $lib \$ICEPAK_ROOT $env(ICEPAK_ROOT)]
	}

	set pf $lib/profiles
	if ![file exists $pf] continue
	if [file isdirectory $pf] { set pf $pf/model }
	
	set profile_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 "$profile_load_count\n"
    }
    set from_library_flag 0
    busy 0
    mess "Done.\n"
}

proc reload_profiles {} {
    global profiles_loaded
    catch {unset profiles_loaded}
    load_profiles
}

proc profile_build_from_properties {to_cont from_cont} {
    global old_fan_curves old_heat_tr_coeffs
    
    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 si_value profname]) $cc
	    }
	    heat_tr_coeff {
		set old_heat_tr_coeffs([$prop si_value profname]) \
		    [$prop si_value constant]
	    }
	    default {
		lappend pprof_found([$prop si_value profname]) [$prop si_value proptype]
		foreach p {valuetype coeff tref curvespec val0 constant} {
		    set key [list [$prop si_value profname] [$prop si_value proptype]]
		    lappend pprof_vals($key) [list $p [$prop si_value $p]]
		}
		incr np
	    }
	}
	$prop delete
    }
    $from_cont delete
    
    if $np {
	mess "Converting $np properties into [llength [array names pprof_found]] profiles\n"
    }
    
    foreach m [array names pprof_found] {
	set types $pprof_found($m)
	set prof [edit_new profile $m 0]
	set what_t ""
	foreach {pref pt} {
	    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 {[lsearch $types $pt] < 0} continue
	    if {$what_t == ""} { set what_t $pref }
	}
	if {$what_t == ""} {
	    mess "Bad property $m -- $types\n" red
	    continue
	}
	$prof setval prof_type $what_t
	
	foreach t $types {
	    foreach k $pprof_vals([list $m $t]) {
		$prof setval ${what_t}_${t}_[lindex $k 0] [lindex $k 1]
	    }
	}
	app_clean_up_profile $prof
    }
}

proc profile_update_object_from_properties {obj} {
    global properties_to_profiles new_profile_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_profiles($obtype)] return
	set p_to_m $properties_to_profiles($obtype)
	set objname [$obj getval name]
    }
    
    foreach prof $p_to_m {
	catch {unset found}
	set mname [lindex $prof 0]
	set mtype [lindex $prof 1]
	set mval ""
	set need_new 0
	set def_fl [expr {$mname == ""}]
	foreach prop [lrange $prof 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
	    set profobj ""
	    set profobj [get_profile $pval "" 0]
	    if {$profobj == ""} {
		set profobj [get_profile ${pval}-surface "" 0]
		if {$profobj != ""} {
		    set pval ${pval}-surface
		}
	    }
	    if {($profobj != "") && ([$profobj si_value prof_type] != $mtype)} {
		mess "Warning: $objname needs a $mtype profile but the value of $pname is $pval which is [$profobj si_value prof_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 $profobj $sss]
	    if {$profobj == ""} {
		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 prof_type=$mtype;
	    foreach p [lsort [array names found]] {
		lappend key "$p=$found($p);"
	    }
	    if [info exists new_profile_cache($key)] {
		set newprof $new_profile_cache($key)
		set mval [$newprof getval name]
		mess "Used $mtype profile for $objname: $mval\n"
	    } else {
		set mval $mtype-$objname
		if {[$model_container get_name $mval] != ""} {
		    set mval [$model_container new_name $mval]
		}
		set newprof [edit_new profile $mval]
		$newprof setval prof_type $mtype prof_subtype Custom
		set new_profile_cache($key) $newprof
		
		mess "Creating $mtype profile for $objname: $mval\n"

		foreach p [array names found] {
		    set pval [lindex $found($p) 0]
		    set profobj [lindex $found($p) 1]
		    set ptype [lindex [lindex $found($p) 2] 0]
		    set pextras [lrange [lindex $found($p) 2] 1 end]
		    if {$profobj != ""} {
			foreach v [$profobj list_values] {
			    if [string match ${mtype}_${ptype}* [lindex $v 0]] {
				$newprof setval [lindex $v 0] [lindex $v 1]
				mess "    [lindex $v 0] -> $pval ([lindex $v 1])\n"
			    }
			}
		    } else {
			if [$newprof checkval ${mtype}_${ptype}_constant] {
			    set pname ${mtype}_${ptype}_constant
			} else {
			    set pname ${mtype}_${ptype}
			}
			$newprof setval $pname $pval
			mess "    $pname -> $pval\n"
			foreach {n1 n2 val} $pextras {
			    if $def_fl error
			    switch $n1 {
				normal_pct {
				    $newprof 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]]
				    $newprof setval solid_conductivity_$x0 \
					[expr [$obj si_value $n1 100] / 100.0]
				}
				plane_pct {
				    $newprof 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]
				    $newprof setval solid_conductivity_$p1 $v \
					solid_conductivity_$p2 $v
				}
				default {
				    set pv2 [$obj si_value $n1]
				    $newprof setval $n2 $pv2
				    mess "    $n2 -> $pv2\n"
				}
			    }
			}
		    }
		}
	    }
	    app_clean_up_profile $newprof
	}
	if {$mval != ""} {
	    if $def_fl {
		global default_fluid_profile
		set default_fluid_profile $mval
	    } else {
		$obj setval $mname $mval
	    }
	}
    }
}

proc profile_vel_dep_cond {prof} {
    set coef [$prof si_value fluid_conductivity_vdep_coeff]
    set exp [$prof si_value fluid_conductivity_vdep_exp]
    
    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 = 0.8;\n\
\n\
  return k_lam;"
    
    set sfname [write_case_udf_property $stuff]
    
    return "(user-defined \"$sfname\") (constant . 0.8)"
}

proc profile_var {prefix title fieldtype also_vel} {
    if $also_vel {
	set t "Temperature or velocity"
    } else {
	set t "Temperature"
    }
    set d1 [form_init .var_prof_$prefix "$t dependent $title" "model sub2"]
    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 profile_graph_editor $title $prefix $fieldtype]
	$d.cedit.m add command -label "Text editor" \
	    -command [list profile_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 profile_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"]
    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 profile_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 .profile_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 prof_edit_update_subtype {} {
    global prof_cur_edit_type prof_cur_edit_subtype current_object
    global edit_frame
    
    if ![winfo exists $edit_frame.prof.subtypes] return
    
    if ![info exists prof_cur_edit_type] return ;# maybe we got here too fast
    
    set found ""
    
    foreach prof [db_list_objects profile] {
	if {([$prof si_value prof_type] == $prof_cur_edit_type) &&
	    ([$prof si_value prof_subtype] == $prof_cur_edit_subtype)} {
	    lappend found [$prof getval name]
	}
    }
    
    set opts ""
    foreach m [lsort $found] {
	lappend opts [list $m]
	if ![info exists prof_cur_edit_subtype] { set prof_cur_edit_subtype $m }
    }
    check_box $edit_frame.prof.objects $opts 6 "" 0
}

proc prof_write_library {} {
    global prof_save_selected
    
    set opts1 ""
    foreach obj [db_list_objects profile] {
	set name "[string totitle [$obj si_value prof_type]]:\
		[$obj getval prof_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]]
    }
    
    if ![check_box_form .save_profs "Select a subset of the following\
	profiles to save." $opts 16 prof_save_selected] return
    
    set objs ""
    foreach m [array names prof_save_selected] {
	if $prof_save_selected($m) {
	    lappend objs $m
	}
    }
    if {$objs == ""} { mess "No profiles selected\n" red; return }
    
    set file [file_selection -message "Select a profiles database to write." \
		  -new_ok 1 -delete_button 1 -mkdir_button 1]
    if {$file == ""} return
    
    mess "Writing [llength $objs] to $file ..."
    set fp [open $file w]
    model_write $fp $objs
    close $fp
    mess " done.\n"
}

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

}

if 0 {
proc get_constant_profval {param which profname} {
    if {$profname == "default"} {
	set profname [profile_get_default $which]
    }
    set obj [get_profile $profname]
    
    return [get_constant_profval_object $obj ${which}_${param}]
}

proc get_constant_profval_object {obj pref} {
    global problem_temp problem_temp_units
    

    if [$obj checkval ${pref}_valuetype] {	
	switch [$obj si_value ${pref}_valuetype] {
	    constant {
		return [$obj si_value ${pref}_constant]
	    }
	    linear {
		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]
	    }
	    curve {
		set curve [$obj si_value ${pref}_curvespec]
	    }
	}
	set t [unit_convert [expression_evaluate $problem_temp] $problem_temp_units 0]
	return [curve_locate_value $curve $t]
    } else {
	return [$obj si_value ${pref}]
    }
}

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)}]
}

}
