qmg_sizecontrol.tcl

来自「算断裂的」· TCL 代码 · 共 197 行

proc gm_sizecontrol {funcname userdata sourcespec patchind \
	realpoint parampoint} {
    ## set sizeval [gm_sizecontrol $funcname $userdata $sourcespec $patchind
    ##                $realpoint $parampoint ]
    ## This routine is invoked by the mesh generator to
    ## determine the mesh size function.  Argument funcname is the
    ## size control function.  See the documentation for more
    ## information.
    
    set func1 [string trim $funcname]
    # puts "funcname = $funcname"
    # puts "userdata = $userdata"
    # puts "sourcespec = $sourcespec"
    # puts "patchind = $patchind"
    # puts "realpoint = $realpoint"
    # puts "parampoint = $parampoint"
    if {[string range $func1 0 0] != "("} {
	error "size control procedure must start with a parenthesis"
    }
    set lastchar [expr [string length $func1] - 1]
    if {[string range $func1 $lastchar $lastchar] != ")"} {
	# puts "func1 = $func1"
	error "Unbalanced parentheses in size control procedure"
    }
    set func2 [string range $func1 1 [expr $lastchar - 1]]
    set cmd [lindex $func2 0]
    set rest [lrange $func2 1 end]
    ## The next test could be commented out because "const" is
    ## caught by the mesh generator, so gm_sizecontrol should
    ## never be reached in that case.
    if {$cmd == "const"} {
	if {[llength $func2] != 2} {
	    error "Size func 'const' takes one argument"
	}
	return $rest
    } elseif {$cmd == "formula" || $cmd == "vecformula"} {
	## next statement replaces %<num> where <num> is a number
	## with [lindex $realpoint <num>].
	regsub -all {(%)([0-9]+)} $rest {[lindex $realpoint \2]} formula
    	return [expr $formula]
    } elseif {$cmd == "pw_const"} {
	scan $sourcespec "%d:%d" facedim faceind
	if {$facedim != 1} {
	    error "pw_const used on non-dimension 1 patch"
	}
	regsub -all {\(} $rest \{ rest
	regsub -all {\)} $rest \} rest
	set numtuple [expr [llength $rest] - 1]
	for {set j 0} {$j < $numtuple} {incr j} {
	    set tuple [lindex $rest $j]
	    if {[lindex $tuple 0] == $patchind && \
		    $parampoint >= [lindex $tuple 1] && \
		    $parampoint <= [lindex $tuple 2]} {
		return [lindex $tuple 3]
	    }
	}
	return [lindex $rest end]
    } else {
	error "Unknown command in size function"
    }
}




proc gm_sizecontrol_interior {funcname userdata sourcespec realpoint} {
    ## set sizeval [gm_sizecontrol_interior  $funcname $userdata $sourcespec
    ##                $realpoint ]
    ## This routine is invoked by the mesh generator to
    ## determine the mesh size function.  Argument funcname is the
    ## size control function.  See the documentation for more
    ## information.
    set func1 [string trim $funcname]

    #    puts "funcname = $funcname"
    #    puts "userdata = $userdata"
    #    puts "sourcespec = $sourcespec"
    #    puts "realpoint = $realpoint"

    if {[string range $func1 0 0] != "("} {
	error "size control procedure must start with a parenthesis"
    }
    set lastchar [expr [string length $func1] - 1]
    if {[string range $func1 $lastchar $lastchar] != ")"} {
	# puts "func1 = $func1"
	error "Unbalanced parentheses in size control procedure"
    }
    set func2 [string range $func1 1 [expr $lastchar - 1]]
    set cmd [lindex $func2 0]
    set rest [lrange $func2 1 end]
    ## The next test could be commented out because "const" is
    ## caught by the mesh generator, so gm_sizecontrol should
    ## never be reached in that case.
    if {$cmd == "const"} {
	if {[llength $func2] != 2} {
	    error "Size func 'const' takes one argument"
	}
	return $rest
    } elseif {$cmd == "formula" || $cmd == "vecformula"} {
	## next statement replaces %<num> where <num> is a number
	## with [lindex $realpoint <num>].
	regsub -all {(%)([0-9]+)} $rest {[lindex $realpoint \2]} formula
    	return [expr $formula]
    } else {
	error "Unknown command in size function"
    }
}



proc gm_curvecontrol {funcname userdata sourcespec patchind \
	realpoint parampoint} {
    ## set sizeval [gm_curvaturecontrol $funcname $userdata $sourcespec \
    ##	            $patchind   $realpoint $parampoint ]
    ## This routine is invoked by the mesh generator to
    ## determine the curvature control function.  Argument funcname is the
    ## size control function.  See the documentation for more
    ## information.
    
    set func1 [string trim $funcname]
    # puts "funcname = $funcname"
    # puts "userdata = $userdata"
    # puts "sourcespec = $sourcespec"
    # puts "patchind = $patchind"
    # puts "realpoint = $realpoint"
    # puts "parampoint = $parampoint"
    if {[string range $func1 0 0] != "("} {
	error "size control procedure must start with a parenthesis"
    }
    set lastchar [expr [string length $func1] - 1]
    if {[string range $func1 $lastchar $lastchar] != ")"} {
	# puts "func1 = $func1"
	error "Unbalanced parentheses in size control procedure"
    }
    set func2 [string range $func1 1 [expr $lastchar - 1]]
    set cmd [lindex $func2 0]
    set rest [lrange $func2 1 end]
    ## The next test could be commented out because "const" is
    ## caught by the mesh generator, so gm_sizecontrol should
    ## never be reached in that case.
    if {$cmd == "const"} {
	if {[llength $func2] != 2} {
	    error "Size func 'const' takes one argument"
	}
	return $rest
    } elseif {$cmd == "formula" || $cmd == "vecformula"} {
	## next statement replaces %<num> where <num> is a number
	## with [lindex $realpoint <num>].
	regsub -all {(%)([0-9]+)} $rest {[lindex $realpoint \2]} formula
    	return [expr $formula]
    } elseif {$cmd == "pw_const"} {
	scan $sourcespec "%d:%d" facedim faceind
	if {$facedim != 1} {
	    error "pw_const used on non-dimension 1 patch"
	}
	regsub -all {\(} $rest \{ rest
	regsub -all {\)} $rest \} rest
	set numtuple [expr [llength $rest] - 1]
	for {set j 0} {$j < $numtuple} {incr j} {
	    set tuple [lindex $rest $j]
	    if {[lindex $tuple 0] == $patchind && \
		    $parampoint >= [lindex $tuple 1] && \
		    $parampoint <= [lindex $tuple 2]} {
		return [lindex $tuple 3]
	    }
	}
	return [lindex $rest end]
    } else {
	error "Unknown command in size function"
    }
}





# ------------------------------------------------------------------
# Copyright (c) 1999 by Cornell University.  All rights reserved
# See the accompanying file 'Copyright' for authorship information,
# the terms of the license governing this software, and disclaimers
# concerning this software.
# ------------------------------------------------------------------
# This file is part of the QMG software.  
# Version 2.0 of QMG, release date September 3, 1999
# ------------------------------------------------------------------