qmg_batch_init.tcl

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

# QMG batch initialization

# procedure to read an object from a file

proc gm_readfile {filename fileformat} {
    if {$fileformat == "xdr"} {
	set obj [gmxdr_read $filename]
    } else {
	set obj [gm_read $filename]
    }
    return $obj
}


# procedure to process options in the command line

proc gm_process_options {argvec arrayname} {
    upvar $arrayname options
    while 1 {
	if {[llength $argvec] < 2} {
	    return $argvec
	}
	set optname [lindex $argvec 0]
	if {[string range $optname 0 0] != "-"} {
	    return $argvec
	}
	set optname [string tolower [string range $optname 1 end]]
	set optval [string tolower [lindex $argvec 1]]
	set argvec [lrange $argvec 2 end]
	if {![info exists options($optname)]} {
	    error "Unrecognized option $optname; valid options: [array names options]"
	}
	set options($optname) $optval
	if {$optname == "fileformat" && ($optval != "xdr" 
		&& $optval != "ascii")} {
	    error "Illegal file format $optval; should be either xdr or ascii"
	}
    }
}

set opcode [string tolower [lindex $argv 0]]
set argv [lrange $argv 1 end]


set errcode [ catch {
    if {$opcode == "-meshgen"} {
	set options(fileformat) xdr
	set options(sizecontrol) "(const 1e307)"
	set options(curvecontrol) "(const .5)"
	set options(show) 0
	set options(tol) $gm_default_tol
	set options(orientation) 1
	set options(logfile) mglog[pid]
	set nargv [gm_process_options $argv options]
	if {[llength $nargv] != 2} {
	    error "Expected syntax: $argv0 $opcode <options> <infile> <outfile>"
	}
	set ifile [lindex $nargv 0]
	set ofile [lindex $nargv 1]
	if {[file exists $ofile]} {
	    error "Output file $ofile already exists"
	}
	set domain [gm_readfile $ifile $options(fileformat)]
	source $qmg_library/gmmeshgen.tcl
	source $qmg_library/gm_meshgui.tcl
	if {$options(show) != 0} {
	    qmg_start_tk
	    wm withdraw .
	}
	set mesh [gmmeshgen $domain size $options(sizecontrol) \
		curve $options(curvecontrol) show $options(show) \
		tol $options(tol) logfile $options(logfile) orientation $options(orientation)]
	if {$options(fileformat) == "xdr"} {
	    gmxdr_write $mesh $ofile
	} else {
	    gm_write $mesh $ofile
	}
	if {$options(show) != 0} {
	    tkwait window .gm_meshgen1
	}
    } elseif {$opcode == "-checktri"} {
	set options(checkorientation) 1
	set options(fileformat) xdr
	set options(tol) $gm_default_tol
	set nargv [gm_process_options $argv options]
	if {[llength $nargv] != 2} {
	    error "Expected syntax: $argv0 $opcode <options> <geofile> <meshfile>"
	}
	set domain [gm_readfile [lindex $nargv 0] $options(fileformat)]
	set mesh [gm_readfile [lindex $nargv 1] $options(fileformat)]
	gmchecktri $domain $mesh $options(checkorientation) $options(tol)
    } elseif {$opcode == "-double1"} {
	set options(fileformat) xdr
	set options(tol) $gm_default_tol
	set nargv [gm_process_options $argv options]
	if {[llength $nargv] != 3} {
	    error "Expected syntax: $argv0 $opcode <brepinfile>  <brepoutfile>  \"<list of face names>\""
	}
	if {[file exists [lindex $nargv 1]]} {
	    error "Output file [lindex $nargv 1] already exists"
	}
	set brepin [gm_readfile [lindex $nargv 0] $options(fileformat)]
	set dblfaces [lindex $nargv 2]
	set gm_default_tol $options(tol)
	gmset brepout [gmdouble $brepin $dblfaces]
	if {$options(fileformat) == "xdr"} {
	    gmxdr_write $brepout [lindex $nargv 1]
	} else {
	    gm_write $brepout [lindex $nargv 1]
	}
	
    } elseif {$opcode == "-double2"} {
	set options(fileformat) xdr
	set options(tol) $gm_default_tol
	set nargv [gm_process_options $argv options]
	set gm_default_tol $options(tol)
	if {[llength $nargv] != 5} {
	    error "Expected syntax: $argv0 $opcode <brepinfile> <meshinfile> <brepoutfile> <meshoutfile> \"<list of face names>\""
	}
	if {[file exists [lindex $nargv 2]]} {
	    error "Output file [lindex $nargv 2] already exists"
	}
	if {[file exists [lindex $nargv 3]]} {
	    error "Output file [lindex $nargv 3] already exists"
	}
	set brepin [gm_readfile [lindex $nargv 0] $options(fileformat)]
	set meshin [gm_readfile [lindex $nargv 1] $options(fileformat)]
	set dblfaces [lindex $nargv 4]
	gmset {brepout meshout} [gmdouble $brepin $dblfaces $meshin ]
	if {$options(fileformat) == "xdr"} {
	    gmxdr_write $brepout [lindex $nargv 2]
	    gmxdr_write $meshout [lindex $nargv 3]
	} else {
	    gm_write $brepout [lindex $nargv 2]
	    gm_write $meshout [lindex $nargv 3]
	}
    } elseif {$opcode == "-translate"} {
    set errmsg "Expected syntax: $argv0 $opcode {toxdr | toascii} <infile> <outfile>"
	if {[llength $argv] != 3} {
	    error $errmsg
	}
	set direction [string tolower [lindex $argv 0]]
	if {$direction != "toxdr" && $direction != "toascii"} {
	    error $errmsg
	}
	set ifile [lindex $argv 1]
	set ofile [lindex $argv 2]
	if {[file exists $ofile]} {
	    error "Output file already exists"
	}
	if {$direction == "toxdr"} {
	    set obj [gm_read $ifile]
	    gmxdr_write $obj $ofile
	} else {
	    set obj [gmxdr_read $ifile]
	    gm_write $obj $ofile
	}
    } elseif {$opcode == "-noop"} {
    } else {
	error "Unknown opcode $opcode; should be one of -meshgen, -double1, -double2, -checktri, -translate"
    }
} errmsg]

if {$errcode} {
    puts stderr $errmsg
}

exit $errcode



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