gmsummary.tcl

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

proc gmsummary obj {
    # gmsummary $obj 
    # displays summary statistics about the
    # object (brep or simplicial complex)

    set chan stdout
    catch {
	upvar gm_redirect_stdout gm_redirect_stdout
	if {$gm_redirect_stdout != ""} {
	    set chan $gm_redirect_stdout
	}
    }

    gmset objl [gm_obj2list $obj]
    global gm_brep_type_code
    global gm_simpcomp_type_code
    set gdim [lindex $objl 1]
    set di [lindex $objl 2]
    if {[lindex $objl 0] == $gm_brep_type_code} {
	set pvlist [lindex $objl 3]
	set numpv [expr [llength $pvlist] / 2]
	set brep_id "\[none listed\]"
	for {set j 0} {$j < $numpv * 2} {incr j 2} {
	    if {[string tolower [lindex $pvlist $j]] == "geo_global_id"} {
		set brep_id [lindex $pvlist [expr $j + 1]]
	    }
	}
	set numcp [expr [llength [lindex $objl 4]] / $di]
	set numtopvtx [expr [llength [lindex $objl 5]] / 5]
	puts $chan "object type =                  brep"
	puts $chan "intrinsic dimension =          $gdim"
	puts $chan "embedded dimension =           $di"
	puts $chan "number of brep prop/vals =     $numpv"
	puts $chan "global id =                    $brep_id"
	puts $chan "number of control points =     $numcp"
	puts $chan "number of top vertices =       $numtopvtx"
	if {$gdim >= 1} {
	    set topedges [lindex $objl 6]
	    set numtopedge [expr [llength $topedges] / 5]
	    set numcurv 0
	    set maxcurvedegree 0
	    for {set faceind 0} {$faceind < $numtopedge} {incr faceind} {
		set curvlist [lindex $topedges [expr 5 * $faceind + 4]]
		incr numcurv [llength $curvlist]
		foreach curve $curvlist {
		    set deg [lindex $curve 1]
		    if {$deg > $maxcurvedegree} {
			set maxcurvedegree $deg
		    }
		}
	    }
	    puts $chan  "number of top edges =          $numtopedge"
	    puts $chan  "number of bezier curves =      $numcurv"
	    puts $chan  "max degree among curves =      $maxcurvedegree"
	}
	if {$gdim >= 2} {
	    set topsurf [lindex $objl 7]
	    set numtopsurf [expr [llength $topsurf] / 5]
	    if {$di == 2} {
		puts $chan  "number of regions =            $numtopsurf"
	    } else {
		set numtripatch 0
		set numquadpatch 0
		set maxtrideg 0
		set maxquadudeg 0
		set maxquadvdeg 0
		set maxquadtdeg 0
		for {set faceind 0} {$faceind < $numtopsurf} {incr faceind} {
		    set patchlist [lindex $topsurf [expr 5 * $faceind + 4]]
		    foreach patch $patchlist {
			set ptype [string tolower [lindex $patch 0]]
			if {$ptype == "bezier_triangle"} {
			    incr numtripatch
			    set deg [lindex $patch 1]
			    if {$deg > $maxtrideg} {
				set maxtrideg $deg
			    }
			} else {
			    incr numquadpatch
			    set degu [lindex $patch 1]
			    set degv [lindex $patch 2]
			    set deg [expr $degu + $degv]
			    if {$degu > $maxquadudeg} {
				set maxquadudeg $degu
			    }
			    if {$degv > $maxquadvdeg} {
				set maxquadvdeg $degv
			    }
			    if {$deg > $maxquadtdeg} {
				set maxquadtdeg $deg
			    }
			}
		    }
		}
		puts $chan "number of topo. surfaces =     $numtopsurf"
		puts $chan "number of triangle patches =   $numtripatch"
		puts $chan "max degree among triangles =   $maxtrideg"
		puts $chan "number of quad patches =       $numquadpatch"
		puts $chan "max u-degree among quads =     $maxquadudeg"
		puts $chan "max v-degree among quads =     $maxquadvdeg"
		puts $chan "max total degree among quads = $maxquadtdeg"
	    }
	}
	if {$gdim >= 3} {
	    set numregion [expr [llength [lindex $objl 8]] / 5]
	    puts $chan "number of chambers =           $numregion"
	}
    } elseif {[lindex $objl 0] == $gm_simpcomp_type_code} {
	puts $chan "object type =         simpcomp"
	puts $chan "intrinsic dimension = $gdim"
	puts $chan "embedded dimension =  $di"
	set brep_id "\[none listed\]"
	set pvlist [lindex $objl 3]
	set numpv [expr [llength $pvlist] / 2]
	for {set j 0} {$j < $numpv * 2} {incr j 2} {
	    if {[string tolower [lindex $pvlist $j]] == "geo_global_id"} {
		set brep_id [lindex $pvlist [expr $j + 1]]
	    }
	}
	puts $chan "brep global id =      $brep_id"
	set nodes [lindex $objl 4]
	set numnodes [expr [llength $nodes] / (1 + $di)]
	puts $chan "number of nodes =     $numnodes"
	for {set fdim 0} {$fdim <= $gdim} {incr fdim} {
	    set thislev [lindex $objl [expr 5 + $fdim]]
	    set levsize [expr [llength $thislev] / 2]
	    puts $chan "# of (nodes,elts) lying on ${fdim}-dimensional top entities:"
	    set denom  [expr ($fdim == 0)? 1 : (2 + $fdim)]
	    for {set faceind 0} {$faceind < $levsize} {incr faceind} {
		set nn -
		if {$fdim < $di} {
		    set nodelist [lindex $thislev [expr 2 * $faceind]]
		    set nn [expr [llength $nodelist]/$denom]
		}
		set ne -
		if {$fdim > 0} {
		    set eltlist [lindex $thislev [expr 2 * $faceind + 1]]
		    set ne [expr [llength $eltlist] / ($fdim + 1)]
		}
		puts -nonewline $chan "  ($nn,$ne)";
	    }
	    puts $chan  ""
	}
    } else {
	error "Unknown type code [lindex $objl 1]"
    }
}

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