#!/usr/bin/env perl
# /* {{{1 GNU General Public License
# 
# csv2db for sofea, the Stack Operated Finite Element Analysis program
# Copyright (C) 2003-2005  Al Danial <al.danial@gmail.com>
# 
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
# 
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
# 
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software Foundation,
# Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
# Read .csv file describing an fea model then write it to an SQLite database.
#
# To do:  - if a node has no coordinate systems it won't appear in node table
#           because the transformation will be done with null values
#         - make sure there is a coordinate system for each one called
#           out for in the node table
#         - append to .sql file all subsequent SQL commands
# 1}}}
use warnings;
use strict;
BEGIN {
    die "The environment variable TOPS_HOME is not defined; will not be\n",
        "able to find the TopsFEA.pm module file\n"
        unless $ENV{TOPS_HOME};
    1;
}
use lib "$ENV{TOPS_HOME}/apps/fea/util"; # for module TopsFEA
use TopsFEA qw( sql_insert build_empty_db compute_CSTM $TRANSACTION_SIZE );
# attempt to give useful error if can't find $TOPS_HOME {{{1
#BEGIN {
#unless (eval 'use lib "$ENV{TOPS_HOME}/apps/fea/util"; # for module TopsFEA
#        use TopsFEA qw( sql_insert build_empty_db
#                               compute_CSTM $TRANSACTION_SIZE )' ) {
#     die "\n  Unable to load Perl module TopsFEA.pm from directory " .
#         "$ENV{TOPS_HOME}/apps/fea/util\n" .
#         "  Is the environment variable TOPS_HOME set correctly?\n" .
#         "  (currently TOPS_HOME = '$ENV{TOPS_HOME}')\n\n";
#}
#}
# 1}}}
use Getopt::Std;
use vars qw ( $opt_f $opt_k $opt_p $opt_P $opt_s $opt_v );
use Time::HiRes qw( time );
use DBI;
use DBD::SQLite 1.00;
use YAML qw( LoadFile );

# Usage and option handling {{{1
$opt_p = 0;
$opt_P = 0;
getopts('f:kp:P:s:v');
# define a default DB schema if none was passed in
$opt_s = "$ENV{TOPS_HOME}/apps/fea/db/db_schema.yaml" unless $opt_s;
my $nPartitions = (0 or $opt_p or $opt_P);  # Note!  never equal to 1
die "Number of partitions must be an integer\n" if $nPartitions =~ /\D/;
my $ONMETIS     = "onmetis"; # vertex-based renumbering
my $KMETIS      = "pmetis";  # graph partitioning
   $KMETIS      = "kmetis" if $nPartitions > 8;
my $SQLITE      = "sqlite3"; # SQLite command line tool
my %Utility     = ( 
                    $SQLITE  => 1,
                    $KMETIS  => 1,
                    $ONMETIS => 1,
                  );

die "$0  [options]  <.csv file>

          Translates the .csv fea model data into an analogous SQLite
          database file.  The database file will have the same root name
          as the .csv file and will have a .db extension.  The .db file
          will be overwritten if one of the same name exists.

          Options:
             -f <partn file>   Use partitions defined in <partn file> instead
                               of from [kp]metis.  This file must have the same
                               format as the output file produced by kmetis (ie
                               a text file with a single column of integers
                               numbered 0..[#Partitions-1] defining the 
                               partition for the canonical element ID matching
                               the line number).
             -k                Keep the .sql file piped into sqlite.
             -s <schema file>  A db database schema in YAML format.
             -p <# partitions> Partition elements of the model in into the 
                               this many parts.  If -f is given, use the
                               partition data in that file.  Otherwise invoke 
                               kmetis to partition the model.
             -P <# partitions> Partition an existing model database which
                               was previously built with the .csv file.
             -v                Verbose output.
" unless @ARGV;
my $csv_file       = shift @ARGV;
# 1}}}
# check for external commands (sqlite3, onmetis, kmetis) {{{1
my @path_dir = split(/:/, $ENV{PATH});
foreach my $Util (keys %Utility) {  # eg, $Util = "sqlite3"
    foreach my $Dir (@path_dir) {
        if (-x "$Dir/$Util") {
            $Utility{$Util} = "Found";
            last;
        }
    }
}
die  "Could not find $SQLITE in path\n" unless $Utility{$SQLITE} eq "Found";
if  ($Utility{$ONMETIS} ne "Found") {
    warn "Could not find $ONMETIS in path\n" 
        unless $Utility{$ONMETIS} eq "Found";
    warn "Will not reorder the model; ordering by node\n" .
         "line number in $csv_file.\n";
}
if (($Utility{$KMETIS}  ne "Found") and $nPartitions) {
    warn "Could not find $KMETIS in path\n" 
        unless $Utility{$KMETIS}  eq "Found";
    warn "Will not partition the model.\n";
    $nPartitions = 0;
    $opt_p       = 0;
}
# 1}}}
# initialize variables {{{1
 
# start the clock
my $total_t  = 0;
my $start_t  = time;
my $start_ti = $start_t;
my $end_ti   = 0;

if (!-r $csv_file) {
    print "Could not read $csv_file; will try to use $csv_file.csv\n"
        if $opt_v;
    $csv_file .= ".csv";
}
die "Unable to read $csv_file\n" unless -r $csv_file;
die "Expecting .csv file to have a .csv extenstion (got $csv_file)\n"
    unless $csv_file =~ /\.csv$/i;
my %csv_model_data = ();
(my $model_db_file = $csv_file ) =~ s/\.csv$/.db/i;

my $partn_db_file;
if ($nPartitions) {
    # the model partition data goes in a separate database
    my $nPart       = sprintf("%03d", $nPartitions);
    ($partn_db_file = $csv_file ) =~ s/\.csv$/_P${nPart}.db/i;
    unlink $partn_db_file if -r $partn_db_file;
}
# 1}}}
# Partition an existing model database? If yes, do it, exit early.  {{{1
if ($opt_P) {
    my $model_dbh = DBI->connect("dbi:SQLite:dbname=$model_db_file","","");
    my $nElements;
    sanity_check($model_dbh, \$nElements);
    if ($nPartitions > $nElements) {
        my $st  = $model_dbh->disconnect;
        die "The model has only $nElements elements; cannot ",
            "partition it $nPartitions ways.\n";
    }
    my $partn_dbh= partition_model($partn_db_file, $model_dbh, $KMETIS, 
                                   $nPartitions  , # number of partitions
                                   $opt_f        , # user's partition file
                                   );
    renumber_partition_nodes($partn_dbh    ,
                             $nPartitions  , 
                             $model_db_file,
                            \%Utility      ,  # only needed to tell if
                                              # onmetis was found
                             $ONMETIS      ,
                            \$total_t
                            );
    if (-e $partn_db_file) {
        print "Wrote $partn_db_file\n" if -e $partn_db_file;
        show_partition_stats($model_db_file, $partn_db_file);
    } else {
        die "Partition failed; no $partn_db_file file\n";
    }
    my $st  = $model_dbh->disconnect;
       $st  = $partn_dbh->disconnect;
    exit;
}
# 1}}}
# open database or SQL file {{{1
(my $sql_file      = $csv_file ) =~ s/\.csv$/.sql/i;
my %set            = ();  # optional user-defined sets
my %spc            = ();  # SPC's

unlink $model_db_file if -r $model_db_file;
unlink $sql_file      if -r $sql_file;
my $schema   = LoadFile($opt_s);
die if schema_has_flaw($schema);
# use Data::Dumper; die Dumper($schema);
my @build_sql = build_empty_db($schema, $opt_s, $opt_v);
open  SQL, ">$sql_file" or die "Cannot write to $sql_file:  $!\n";
print SQL  @build_sql;
my $nInserts = 0;  # number of inserts done so far in this transaction
my $tot_ins  = 0;  # total number of inserts
my $E_seq    = 0;  # sequence number for element table
my $E_N_seq  = 0;  # sequence number for element_node table
my %table    = (); # keys = tables found in the csv file
$| = 1;  # flush STDOUT
# 1}}}
# load csv data, write equivalent SQL inserts to text file {{{1
my @coord_entry = ();
open  CSV, $csv_file or die "Cannot read $csv_file  $!\n";
print SQL "BEGIN TRANSACTION;\n";
my $line      = "";
my $nThisXAct = 0;
while (<CSV>) {
    next if /^\s*#/ or /^\s*$/ or /^\s*schema\b/i;
    chomp;
    if (m{\\\s*$}) {  # line ends with a continuation marker
        s{(\-\-)?\s+\\\s*$}{\n};  # strip it--and optional SQL comment--off
        $line .= $_;
        next;
    } else {
        $line .= $_;
    }
    if ($line =~ /^\s*(\w+)\s*,/) {
        ++$table{lc $1};

        # sets, spc's handled locally, not in TopsFEA.pm
        if      ($1 eq "set") {
            add_set($line, \%set);
            $line = "";
            next;
        } elsif ($1 eq "spc") {
            add_spc($line, \%spc);
            $line = "";
            next;
        } 
        
        # last three entries are for force vector components in the
        # basic coordinate system -- not known yet
        if ($1 eq "force") {
            $line .= " , , , ";
            # coordinate system transformation not yet implemented;
            # trap this if user's model has a CID entry
            (my $myline = $line) =~ s/\s*,\s*/,/g;
            if ( (split(/,/, $myline))[3] ) {
                die "'force' entry line $. of $csv_file,\n  $line\n" ,
                    "has a non null CID value.  Coordinate system \n" ,
                    "transformation not yet implemented on force card.\n" ,
                    "Remove the CID entry to continue.\n";
            }
        }

        my @ins = sql_insert($line, $schema, 
                             \$nInserts, \$E_seq, \$E_N_seq, $opt_v);
        $tot_ins   += scalar @ins;
        $nThisXAct += scalar @ins;
        if ($nThisXAct > $TRANSACTION_SIZE) {
            print SQL "COMMIT;\nBEGIN TRANSACTION;\n";
            $nThisXAct = 0;
        } 
        print SQL @ins;

    } else {
        die "Unrecognized input line $. of $csv_file:\n$line\n"
    }
    $line = "";
}
print SQL "COMMIT;\n";

my $end_t = time;
$total_t += ($end_t - $start_t);

printf "Card count:%s\n", ' ' x 60;  # clean up after the \r above
foreach my $T (sort keys %table) {
    printf "  %-12s %10d\n", $T, $table{$T};
}

$tot_ins += $nInserts;
# 1}}}
# sanity check:  any elements use undefined nodes?  any extra nodes? {{{1
$line = '
         create table problem_element as 
            select E.id,EN.nid from tmp_element_node EN, element E
                where EN.nid not in ( select id from node ) and
                E.seq_no = EN.eid;
         create table problem_node as
            select id from node where id not in (
                select nid from tmp_element_node
                );
        ';
print SQL $line ;
# 1}}}
# SQL commands to create element_node; index tables {{{1
print SQL "BEGIN TRANSACTION;\n";
$line = '
         create index idx_node on node (id);
         create index idx1_t_e_n on tmp_element_node (nid);
         create index idx2_t_e_n on tmp_element_node (eid);
         insert into element_node (seq_no, eid, nid)
             select TEN.seq_no, TEN.eid, N.seq_no from 
                 node N, tmp_element_node TEN where N.id = TEN.nid;
         drop table tmp_element_node;
        ';
print "Creating element_node    \n" if $opt_v;
print SQL $line ;

foreach my $T (sort keys %table) {
    next if $T =~ m{^(set|sql|node|tmp_element_node)$};
    my $index = "create index idx_$T on $T (id);\n";
    print SQL $index;
}
print "Indexing element_node eid\n" if $opt_v;
my $index = "create index idx_e_n on element_node (eid,nid);\n";
print SQL $index ;
print "Indexing element_node nid\n" if $opt_v;
$index = "create index idx_n_n on element_node (nid);\n";
print SQL $index ;
# 1}}}
# SQL commands to populate node_node, element_element tables {{{1
my $node_conn = '
    insert into node_node (nid_a, nid_b)
        select distinct EN1.nid, EN2.nid from 
             element_node EN1, 
             element_node EN2, 
             node         N 
             where EN1.nid =  N.seq_no and 
                   EN2.nid <> N.seq_no and 
                   EN1.eid =  EN2.eid
             order by EN1.nid, EN2.nid;
    ';
print SQL $node_conn;

# not clear if indexing these is worthwhile

my $elem_conn = '
    insert into element_element
            select distinct A.eid as eid_a, B.eid as eid_b
                from element_node A, element_node B
                where A.eid <> B.eid and A.nid = B.nid;
    ';
#               where A.eid < B.eid and A.nid = B.nid; # ignores upper triangle
print SQL $elem_conn;
# 1}}}
# close SQL text file, pipe it into sqlite {{{1
print SQL "COMMIT;\n";
close SQL;
$start_t = time;
system "cat $sql_file | $SQLITE $model_db_file";
$end_t = time;
unlink $sql_file unless $opt_k;
printf "insert, index %7d rows       %7.2f sec  (%.2f row/sec)\n", 
        $tot_ins, $end_t - $start_t, $tot_ins/($end_t - $start_t);
$total_t += ($end_t - $start_t);
# 1}}}

# do clean up, sanity check, then partition the model (if requested) {{{1
my $model_dbh = DBI->connect("dbi:SQLite:dbname=$model_db_file","","");
seq_no_cleanup($model_dbh);
my ($partn_dbh, $st, $nElements);
sanity_check($model_dbh, \$nElements);
if ($nPartitions > $nElements) {
    my $st  = $model_dbh->disconnect;
    die "The model has only $nElements elements; cannot ",
        "partition it $nPartitions ways.\n";
}
if ($Utility{$KMETIS} eq "Found" and $nPartitions) {
    $partn_dbh = partition_model($partn_db_file, $model_dbh, $KMETIS,
                                 $nPartitions  , # number of partitions
                                 $opt_f        , # user's partition file
                                 );
}
# 1}}}
# # renumber nodes on model db; SQL to insert renumbered node data {{{1
# printf "create renumbered_nid "; 
# $start_t  = time;   # connectivity I/O time counts towards node renumbering
# $start_ti = $start_t;
# 
# my $details    = ""; # extra information about the renumbering
# 
# if (!$nPartitions and                # only renumber entire model if it
#                                      # is not being partitioned
#     $Utility{$ONMETIS} eq "Found") {
# 
#     renumber_nodes($model_dbh       ,
#                    $ONMETIS         ,  # the renumbering program
#                    0                ,  # 0 -> entire model, no partitions
#                    0                ,  # 0 -> entire model, no levels
#                    "node_node"      ,  # has node to node connectivity info
#                    "renumbered_nid" ,  # populate this table
#                   \$details         ,
#                    ); 
# } else {
#     # No renumbering in the model database.  Make the new seq_no same 
#     # as the old seq_no.
#     my $insert = "insert into renumbered_nid select seq_no, seq_no " .
#                          "from node order by id;\n";
#     $st = $model_dbh->do( $insert );
# }
# $st    = $model_dbh->do( "create index idx_ren on renumbered_nid (orig_id);"
#                  );
# $end_t = time;
# $total_t += ($end_t - $start_t);
# printf "           %7.2f sec  %s\n", $end_t - $start_t, $details;
# 1}}}
# renumber nodes in each partition (if requested) {{{1
renumber_partition_nodes($partn_dbh    ,
                         $nPartitions  , 
                         $model_db_file,
                        \%Utility      ,
                         $ONMETIS      ,
                        \$total_t
                        ) if $nPartitions;
# 1}}}
# # populate renumbered_nid table {{{1
# printf "populate renumbered_nid         ";
# $start_t = time;
# $st = $model_dbh->do('
#   insert into renumbered_node_node
#     select R1.new_id, R2.new_id from node_node         NN,
#                                      renumbered_nid    R1,
#                                      renumbered_nid    R2
#             where  R1.orig_id  =  NN.nid_a and
#                    R2.orig_id  =  NN.nid_b and
#                    R1.new_id  <=  R2.new_id 
#     '          .  # only does lower half
#     'union '   .  # second select forces inclusion of diagonal terms
#     '
#      select R1.new_id, R1.new_id from renumbered_nid R1
#        order by R1.new_id, R2.new_id;
#     '
#               );
#  
# $end_t = time;
# $total_t += ($end_t - $start_t);
# printf " %7.2f sec\n", $end_t - $start_t;
# # 1}}}
# compute coordinate system transformations {{{1
printf "coord system transformations    ";
$start_t = time;
my   @cstm_sql  = ("begin transaction");
push @cstm_sql, compute_CSTM($model_dbh, $opt_v);
push @cstm_sql, "commit";
foreach (@cstm_sql) {
    $st = $model_dbh->do( $_ );
}

# compute locations of all nodes in the basic coordinate system and insert
# these into the node table
# tmp_node is a copy of node with values for coordinates in the basic system

my @xform_sql = (
    "begin transaction"                      ,
    "
    insert into tmp_node
    select N.seq_no    ,
           N.id        ,
           N.coord_in  ,
           N.x1_in     ,
           N.x2_in     ,
           N.x3_in     ,
           N.coord_out ,
           CX.T1 + CX.R11*N.x1_in + CX.R12*N.x2_in + CX.R13*N.x3_in,
           CX.T2 + CX.R21*N.x1_in + CX.R22*N.x2_in + CX.R23*N.x3_in,
           CX.T3 + CX.R31*N.x1_in + CX.R32*N.x2_in + CX.R33*N.x3_in
               from node as N,coord as C,coord_xfer as CX
               where N.coord_in = C.id and C.seq_no  = CX.seq_no
    union
    select N.seq_no    ,     -- add in nodes which had null for input
           N.id        ,     -- coordinate system
           N.coord_in  ,
           N.x1_in     ,
           N.x2_in     ,
           N.x3_in     ,
           N.coord_out ,
           N.x1_in     ,
           N.x2_in     ,
           N.x3_in     
               from node as N where N.coord_in is NULL
    order by N.seq_no;
    "                                        ,
    "delete from node"                       ,
    "insert into node select * from tmp_node",
    "drop table tmp_node;"                   ,
    "commit"                                 ,
);

foreach (@xform_sql) {
    $st = $model_dbh->do( $_ );
}
$end_t   = time;
$total_t += ($end_t - $start_t);
printf " %7.2f sec\n", $end_t - $start_t;
# 1}}}
# create dof table {{{1
printf "degree of freedom table         ";
$start_t = time;
#   create table tmp_dof(dof integer primary key, nid integer, type integer);
my $dof_sql = "
    create table tmp_type(type integer);   -- degrees of freedom at one node
    insert into tmp_type values(1);        -- Tx
    insert into tmp_type values(2);        -- Ty
    insert into tmp_type values(3);        -- Tz
    insert into tmp_type values(4);        -- Rx
    insert into tmp_type values(5);        -- Ry
    insert into tmp_type values(6);        -- Rz
    insert into tmp_dof select NULL, seq_no, type from node,tmp_type;
    insert into dof select dof-1, nid, type from tmp_dof;
    drop table tmp_dof;
    drop table tmp_type;
";
$dof_sql =~ s/(\s*--.*?)?\n//mg;
foreach ( split(/;/, $dof_sql) ) {
    $st = $model_dbh->do( $_ );
}
$end_t    = time;
$total_t += ($end_t - $start_t);
printf " %7.2f sec\n", $end_t - $start_t;
# 1}}}
$st = $model_dbh->begin_work;
# process sets {{{1
if (%set) {
    print "Creating sets\n" if $opt_v;
    $start_t = time;
    my $query;
    foreach my $set_name (sort keys %set) {
        my ($operation, @parameters) = @{$set{$set_name}};
        die "insufficient data for set $set_name" unless @parameters;
        if      ($operation eq "node_list") {
            $query = "select seq_no from node    where id in ('" .
                     join("','", @parameters) . "')";
        } elsif ($operation eq "elem_list") {
            $query = "select seq_no from element where id in ('" .
                     join("','", @parameters) . "')";
        } elsif ($operation eq "sql"      ) {
            $query = $parameters[0];
        } else {
            die "Unknown set operation '$operation'";
        }

        print "Creating set $set_name with this SQL statement:\n" .
              " [$query]\n" if $opt_v;

        $query =~ s/^"//;
        $query =~ s/"$//;

        # Can't figure out how to do the following with just one temp
        # table:  allow the user's query to produce nonunique ID's but
        # only populate the sets table with the distinct set of these
        # while at the same time inserting the constant set name into 
        # sets in the first field.
        $st = $model_dbh->do(
            "create table temp_1 (seq_no integer primary key, id integer);");
        $st = $model_dbh->do("create table temp_2 (id integer);");
        $st = $model_dbh->do("insert into temp_1 (id) $query;")
            or die "Set $set_name creation failed: $model_dbh->errstr\n";

        $st = $model_dbh->do(
            "insert into temp_2 (id) select distinct(id) from temp_1;");
        $st = $model_dbh->do(
            "insert into sets (sid, entity_id) " .
            "select '$set_name',id from temp_2;");
        $st = $model_dbh->do("drop table temp_1;");
        $st = $model_dbh->do("drop table temp_2;");

    }
    $end_t   = time;
    $total_t += ($end_t - $start_t);
    printf "creating sets                    %7.2f sec\n", $end_t - $start_t;
}
# 1}}}
# process SPC's {{{1
if (%spc) {
    print "Creating SPC's\n" if $opt_v;
    $start_t = time;
    foreach my $spc_name (sort keys %spc) {
        $st = $model_dbh->do("insert into spc (id,dof,sid) values " .
        "('$spc_name', $spc{$spc_name}{dof}, '$spc{$spc_name}{set}');");
    }
    $end_t   = time;
    $total_t += ($end_t - $start_t);
    printf "creating SPC's                   %7.2f sec\n", $end_t - $start_t;
}
# 1}}}
# create applied loads {{{1
printf "applied loads                   ";
$start_t = time;

# tmp_load = copy of nodal_load with values for coordinates in the basic system
$st = $model_dbh->do("
insert into nodal_load
select NULL, F.seq_no, N.seq_no, F.Mag, F.Fi1, F.Fi2,  F.Fi3, 0, 0, 0, 0
    from node N, force F, sets S
        where F.sid = S.sid and N.seq_no = S.entity_id;
");
#select N.id,
#       N.seq_no ,
#       N.coord_in,
#       N.x1_in   ,
#       N.x2_in   ,
#       N.x3_in   ,
#       N.coord_out,
#       CX.T1 + CX.R11*N.x1_in + CX.R12*N.x2_in + CX.R13*N.x3_in,
#       CX.T2 + CX.R21*N.x1_in + CX.R22*N.x2_in + CX.R23*N.x3_in,
#       CX.T3 + CX.R31*N.x1_in + CX.R32*N.x2_in + CX.R33*N.x3_in
#           from node as N,coord as C,coord_xfer as CX
#           where N.coord_in = C.id and C.seq_no  = CX.seq_no
#               order by N.seq_no;
#");
#$st = $model_dbh->do("delete from nodal_load");
#$st = $model_dbh->do("insert into nodal_load select * from tmp_nodal_load");
#$st = $model_dbh->do("drop table tmp_nodal_load;");
$end_t = time;
$total_t += ($end_t - $start_t);
printf " %7.2f sec\n", $end_t - $start_t;

# 1}}}
$st = $model_dbh->commit;
# finish {{{1

print  "--------------------------------------------\n";
printf "Total db time                    %7.2f sec\n", $total_t;
print "Wrote $model_db_file" if                  -e $model_db_file;
print ", $partn_db_file"     if $nPartitions and -e $partn_db_file;
print "\n";
$st  = $model_dbh->disconnect;
$st  = $partn_dbh->disconnect if $nPartitions;

show_partition_stats($model_db_file, $partn_db_file) if $nPartitions;
# 1}}}

sub sanity_check {       # {{{1
    my ( $model_dbh    , # in
         $rs_nElements , # out
       ) = @_;

    my $problem          = 0;

    my $query            = "select count(*) from element; ";
    my @row_ary          = $model_dbh->selectrow_array($query);
    ${$rs_nElements}     = $row_ary[0];

    $query               = "select * from problem_element; ";
    my $raa_bad_element  = $model_dbh->selectall_arrayref($query);
    if (@{$raa_bad_element}) {
        my $plural = "s have";
           $plural = " has" if scalar @{$raa_bad_element} == 1;
        printf "\nFatal error:  %d element%s one or more undefined nodes:\n",
               scalar @{$raa_bad_element}, $plural; 
        foreach my $pair (@{$raa_bad_element}) {  # pair->[0] = NID   [1]=seq_no
            printf "element: [%s] uses undefined node [%s]\n", 
                    $pair->[0], $pair->[1];
        }
        $problem = 1;
    }

       $query            = "select * from problem_node; ";
    my $raa_bad_node     = $model_dbh->selectall_arrayref($query);
    if (@{$raa_bad_node}) {
        my $plural = "s";
           $plural = "" if scalar @{$raa_bad_node} == 1;
        printf "\nFatal error:  %d node%s not used by any elements:\n",
               scalar @{$raa_bad_node}, $plural;
        foreach my $id (@{$raa_bad_node}) {
            printf " %-20s\n", $id->[0];
        }
        $problem = 1;
    }

    die "\n" if $problem;
}
# 1}}}
sub seq_no_cleanup {       # {{{1
    my ( $model_dbh    , # in
       ) = @_;

    my $query   = "select * from seq_no_cleanup; ";
    my $row_ref = $model_dbh->selectall_arrayref($query);

    foreach my $table_ref (@{$row_ref}) {
        my $table = $table_ref->[0];
        next if $table =~ /^tmp_/;  # don't bother with temporary tables
        # print "CLEANING UP $table\n";
        $model_dbh->do("delete from $table where seq_no = -1;");
    }
    $model_dbh->do("drop table seq_no_cleanup;");

}
# 1}}}
sub partition_model {       # {{{1
    my ($partn_db_file  ,  # in  partition database file to create
        $model_dbh      ,  # in  SQLite database handle to model file
        $KMETIS         ,  # in  path to kmetis executable
        $nParts         ,  # in  number of partitions to create
        $user_part_file ,  # in  if not null, a file to use instead of
                           #     ${tmp_metis_graph}.part.${nParts} produced
                           #     by kmetis
       ) = @_;

    my ($partn_dbh, $st);
    printf "partition elements"; 
    $start_t  = time;   # connectivity I/O time counts towards node renumbering
    $partn_dbh = DBI->connect("dbi:SQLite:dbname=$partn_db_file","","");

    # use SQLite's ATTACH feature to work with both model and
    # partition databases simultaneously
    $st = $model_dbh->do("attach '$partn_db_file' as PARTN_DB;");

    my $tmp_metis_graph = "temp_$KMETIS.graph";
    my $partition_file  = "";
    my $details         = "";

    if ($user_part_file) { # take user-provided partition data
        $partition_file = $user_part_file;
    } else {               # use kmetis to partition the model
        my $kmetis_log      = "$KMETIS.log";
           $details         = "(extra info in $kmetis_log)";
        write_metis_graph_file($model_dbh, $tmp_metis_graph, 
                               0, # entire model, not by partitions
                               "element_element", "eid_a,eid_b");
        $nParts =~ s/^0+//g;  # strip leading zeros
#       print  "$KMETIS $tmp_metis_graph $nParts > $kmetis_log", "\n";
        system "$KMETIS $tmp_metis_graph $nParts > $kmetis_log";
        # kmetis command creates file ${tmp_metis_graph}.part.${nParts}
        # containing a single column of numbers ranging from 0..($nParts - 1)
        # The number of rows is the number of nodes in the model.
        $partition_file = "${tmp_metis_graph}.part.${nParts}";
    }

    # Read the partition file and populate the element_partition table.
    # If line i contains value j it means "element i+1 belongs to partition
    # j+1".
    open  IN, $partition_file or die "Cannot read $partition_file:  $!\n";
    $st = $partn_dbh->begin_work;
    $st = $partn_dbh->do('create table element_partition (
                            -- Maps each element in the model to a partition.
                            eid integer primary key,  -- FK to element.seq_no
                            pid integer               -- partition ID
                            );'
                        );
    my $eid = 0;
    while (<IN>) {
        die "Bad file format for $partition_file at line $.:\n$_\n"
            unless /^\s*(\d+)\s*$/;
        my $pid = $1 + 1;
        $st = $partn_dbh->do(
                "insert into element_partition values ($eid, $pid);");
        ++$eid;
    }
    close IN;
    $st = $partn_dbh->commit;
#   warn "\nelement partition file '$partition_file' erased\n";
#   unlink $partition_file;

    $st = $partn_dbh->do("attach '$model_db_file' as MODEL_DB;");
    create_partition_tables($partn_dbh);
    $st = $partn_dbh->do("detach MODEL_DB;");

    $st = $model_dbh->do("detach PARTN_DB;");

    $end_t = time;
    $total_t += ($end_t - $start_t);
    printf "               %7.2f sec  %s\n", 
            $end_t - $start_t, $details;

    return $partn_dbh;
}
# 1}}}
sub write_metis_graph_file { # {{{1
    my ($dbh                ,  # in
        $file               ,  # in  file to create
        $pid                ,  # in  0=entire model;  >1=only this partition
        $connectivity_table ,  # in  node_node | prt_node_node | element_element
        $connectivity_fields,  # in  either "nid_a,nid_b" or "eid_a,eid_b"
       ) = @_;
    # returns number of connections

    # Note:  nid_a, nid_b, eid_a, eid_b are zero-based but Metis 
    #        needs 1-based values in the graph file.

    open  OUT, ">$file" or die "Cannot write to $file  $!\n";

    # SQL where-clause to limit queries to this partition--if using partitions
    my $in_this_partition = "";
       $in_this_partition = " where pid=$pid " if $pid;

    # determine the number of graph nodes
    my $key = (split(/,/, $connectivity_fields))[0];   # for example, "eid_a"
    $key =~ s/^\s+//;
    $key =~ s/\s+$//;
    # nNodes in the sense of graph nodes, not finite element nodes
    # If partitioning elements, the graph nodes are finite elements.
    my $raa_nNodes  = $dbh->selectall_arrayref(
                           "select max($key) from $connectivity_table " .
                            $in_this_partition); 
    if ($connectivity_table =~ /_node_node_i$/ and !@{$raa_nNodes}) {
        # no interior nodes in this partition
        return 0;
    }
    die "\nError: $connectivity_table table is empty\n" 
        unless scalar @{$raa_nNodes};

    # determine the number of graph edges
    my $raa_connect = $dbh->selectall_arrayref(
                           "select   $connectivity_fields from " .
                                     $connectivity_table   . 
                                     $in_this_partition    .
                           " order by $connectivity_fields");
    if ($connectivity_table =~ /_node_node_i$/ and !@{$raa_connect}) {
        # There are interior nodes in this partition (otherwise the
        # test on !@{$raa_nNodes} would have failed above) but no
        # connections between purely interior nodes.  In other words
        # all interior nodes are attached only to boundary nodes.
        return 0;
    }
    die "\nError: $connectivity_table table is empty\n" 
        unless scalar @{$raa_connect};
    my $raa_nEdges  = $dbh->selectall_arrayref(
                           "select count(*) from $connectivity_table " .
                            $in_this_partition); 
    # use Data::Dumper::Simple;
    # print Dumper($raa_nNodes, $raa_connect, $raa_nEdges);

    # 1st line of graph file:  <nNodes> <nEdges>
    # metis graph files show edges twice: a -> b and b -> a
    $raa_nEdges->[0][0] /= 2;
    printf OUT "%d %d ", $raa_nNodes->[0][0]+1, $raa_nEdges->[0][0];
    my $previous_id  = 0;
    my $nLines_out   = 1;  # Graph file entries at line number i+1 are
                           # the canonical ID's of nodes attached to node i
    # use Data::Dumper; die Dumper($raa_connect);
    my $do_new = 0;
    foreach my $pair (@{$raa_connect}) {
        # for $connectivity_table = "node_node"
        # $pair->[0] is node_node.nid_a     (repeated many times)
        # $pair->[1] is node_node.nid_b     (nid_a < nid_b)
        $do_new = 1 if $previous_id != ($pair->[0] + 1);
printf "write_metis_graph_file p[0,1] = %d %d,  #Lines out=%d  do_new=%d\n",
$pair->[0], $pair->[1], $nLines_out, $do_new if $opt_v;
        if ($do_new) {
            if ($nLines_out != ($pair->[0] + 1)) {
                die "\nFailure writing the $KMETIS graph file.  Expected to\n" .
                    "write node $nLines_out but database has me at " .
                    ($pair->[0] + 1) . ".\n" .
                    "It appears canonical node $nLines_out is not " .
                    "attached to any other node.\n";
            }
            ++$nLines_out;
            printf OUT "\n%d ", $pair->[1] + 1;
            $do_new = 0;
        } else {
            printf OUT "%d ", $pair->[1] + 1;
        }
        $previous_id  = $pair->[0] + 1;
    }
    print OUT "\n";
    close OUT;

    return scalar @{$raa_connect};
} # 1}}}
sub schema_has_flaw { # {{{1
    my ($schema, ) = @_;
    my $error = "";

    foreach my $table (keys %{$schema}) {

        $error = "Single quotes not allowed in table name:  $table\n"
            if $table =~ /'/;

        $error = "Missing desc: entry for table $table\n"
            unless defined $schema->{$table}{desc};

        $error = "Missing row: entry for table $table\n"
            unless defined $schema->{$table}{rows};

        $error = "Single quotes not allowed in desc: entry for table $table\n"
            if $schema->{$table}{desc} =~ /'/;

    }
    warn $error if $error;
    return $error;
} # 1}}}
sub add_set { # {{{1
    my ($line    ,  # in
        $rha_set ,  # out  set{name} = [set modification entries]
       ) = @_;

    $line =~ s/\s*,\s*/,/g;  # strip bounding whitespace around ,

    my @entry = split(/,/, $line);

    @{$rha_set->{$entry[1]}} = @entry[2..$#entry];

} # 1}}}
sub add_spc { # {{{1
    my ($line   ,  # in
        $rh_spc ,  # out  spc{name} = SPC definition
       ) = @_;

    $line =~ s/\s*,\s*/,/g;  # strip bounding whitespace around ,
    my @entry = split(/,/, $line);  # spc, <spc name>, <set name>, dof

    for (my $i = 1; $i < 4; $i++) {
        $entry[$i] =~ s/^\s*//m;
        $entry[$i] =~ s/\s*$//m;
    }

    $rh_spc->{$entry[1]}{set} = $entry[2];
    $rh_spc->{$entry[1]}{dof} = $entry[3];

} # 1}}}
sub create_partition_tables { # {{{1
    my ($dbh    ,  # in
       ) = @_;

    # create table boundary_node which contains a list of all the nodes
    # which fall on partition boundaries and the number of partitions
    # each of these nodes belongs to
    $st = $dbh->do("create table boundary_node (
                        -- Boundary nodes in entire model and count of
                        -- number of partitions each b. node belongs to.
                        nid   integer primary key, -- FK to node.seq_no
                        n_pid integer              -- # of partitions this node
                                                   --   is in
                            );
                  ");
    # note: pid in partition_bnode cannot be a primary key since it
    # repeats many times (once for each of its boundary node)
    $st = $dbh->do("create table partition_bnode (
                            -- has all the boundary nodes that belong to
                            -- a given partition
                            pid  integer ,  -- partition ID
                            nid  integer    -- FK to node.seq_no
                            );
                  ");

    $st = $dbh->do("
        insert into boundary_node (nid, n_pid) 
        select NID as nid, n_PID as n_pid from (
            select NID,count(*) as n_PID from (
                select distinct EN_1.nid as NID, EP.pid as PID from
                    element_node EN_1,                             
                    element_partition EP                           
                where EN_1.eid = EP.eid                            
                order by EN_1.nid)                                 
            group by NID)
        where n_PID > 1;
    ");

    # create table partition_bnode which lists all the partitions and
    # the boundary nodes in the partions
    $st = $dbh->do("
        insert into  partition_bnode (pid, nid)
        select distinct EP.pid as PID, EN.nid as NID from
            element_node      EN,
            element_partition EP
            where
                EN.nid in (select NID from boundary_node) and
                EN.eid = EP.eid
            order by EP.pid, EN.nid;
    ");

    # with the tables above can easily get interior nodes with
    my $interior_node_query = "
        select distinct EP.pid, EN.nid from
            element_node      EN,
            element_partition EP
            where
                EN.nid not in (select NID from boundary_node) and
                EN.eid = EP.eid
            order by EP.pid, EN.nid
            ;
    ";

    # similarly can make a table of partition to partition
    # (or superelement to superelement) connectivity
    $st = $dbh->do("
        create table selement_selement as
        select distinct PBN_1.pid as sid_a, PBN_2.pid sid_b from
            partition_bnode PBN_1,
            partition_bnode PBN_2
            where
                PBN_1.nid =  PBN_2.nid and
                PBN_1.pid <> PBN_2.pid
            order by PBN_1.pid, PBN_2.pid
            ;
    ");

} # 1}}}
sub show_partition_stats { # {{{1
    my ($model_db_file,
        $partn_db_file,
       ) = @_;

    my $model_dbh = DBI->connect("dbi:SQLite:dbname=$model_db_file","","");
    my $partn_dbh = DBI->connect("dbi:SQLite:dbname=$partn_db_file","","");

    my $st;
    $st = $partn_dbh->do("attach '$model_db_file' as MODEL_DB;");
    $st = $model_dbh->do("attach '$partn_db_file' as PARTN_DB;");

    my $interior_node_count = "
        select PID,count(NID) from (
            select distinct EP.pid as PID, EN.nid as NID from
                element_node      EN,
                element_partition EP
                where
                    EN.nid not in (select nid from boundary_node) and
                    EN.eid = EP.eid
                order by EP.pid, EN.nid
        ) group by PID order by PID
            ;
    ";

    my $boundary_node_count = "
            select PID, count(NID) from partition_bnode
            group by PID order by PID
            ;
    ";

    # Boundary nodes are shared between partitions.  Need to get
    # the total number of boundary nodes with a separate query:
    my $total_boundary_node_count = "
            select count(NID) from boundary_node;
    ";

    my $ref_interior = $partn_dbh->selectall_arrayref($interior_node_count);
    my $ref_boundary = $partn_dbh->selectall_arrayref($boundary_node_count);
    my $ref_tot_bdry = $partn_dbh->selectall_arrayref($total_boundary_node_count);
    $st  = $model_dbh->disconnect;
    $st  = $partn_dbh->disconnect;

    my $nPart_i = scalar @{$ref_interior};
    my $nPart_b = scalar @{$ref_boundary};
    if ($nPart_i != $nPart_b) {
        die "\nInconsistency in partition count check:\n" .
            "   interior partitions ($nPart_i) v. exterior ($nPart_b)\n" .
            "Possible cause:  model is too small to partition $opt_p ways\n";
    }

    my %partition_data = ();
    for (my $i = 0; $i < $nPart_i; $i++) {
        die "partition index mismatch at index $i\n"
            unless $ref_interior->[$i][0] == $ref_boundary->[$i][0];
        my $total_nodes = $ref_interior->[$i][1] + $ref_boundary->[$i][1];
        my $percentage  = 100 * $ref_interior->[$i][1]/$total_nodes;
        $partition_data{$ref_interior->[$i][0]} =  # key is partition ID
              [$ref_interior->[$i][1] ,            # number of interior nodes
               $ref_boundary->[$i][1] ,            # number of boundary nodes
               $total_nodes           ,            # sum interior+boundary
               $percentage            ,            # % in interior
              ];
    }

    printf " %10s %10s %10s %10s %14s\n",
           "Partition", "Interior", "Boundary", "Total", '% Interior';
    my $total_boundary = $ref_tot_bdry->[0][0];
    my $total_interior = 0;
    foreach my $part (sort {$partition_data{$a}[3] <=>  # sort on interior %age
                            $partition_data{$b}[3]}
                      keys %partition_data) {
        printf " %10d %10d %10d %10d         %6.2f\n",
               $part, @{$partition_data{$part}};
        $total_interior += $partition_data{$part}[0];
    }
    printf "%-10s %10d %10d %10d         %6.2f\n",
           "NODE TOTAL:",
           $total_interior      ,
           $total_boundary      ,
           $total_interior + $total_boundary,
           100 * $total_interior / ($total_interior + $total_boundary);


} # 1}}}
sub renumber_nodes { # {{{1
    my ($dbh                     , # database w/ the node connectivity table
        $ONMETIS                 , # the node renumbering program
        $partition_id            , #  0: no 'partn' field
                                   # >1: the partition number
        $level_id                , #  0: no 'level' field
                                   # >1: the level number
        $node_connectivity_table , # eg, "node_node" or "ptn_node_node"
        $renumbered_id_table     , # eg, "renumbered_nid"
        $rs_details              , # out  info on the renumbering
       ) = @_;

    my $tmp_metis_graph = "temp_onmetis.graph";
    my $permute_file    = "$tmp_metis_graph.iperm";
    my $metis_log       = "onmetis.log";
       $metis_log       = sprintf "onmetis_P%03d.log", $partition_id
        if $partition_id;
    unlink $permute_file if -r $permute_file;
    my $n_connections = write_metis_graph_file($dbh                     , 
                                               $tmp_metis_graph         , 
                                               $partition_id            ,
                                               $node_connectivity_table , 
                                               "nid_a,nid_b");
    return unless $n_connections; # don't try to renumber an empty set
    system "$ONMETIS $tmp_metis_graph > $metis_log";

    ${$rs_details} = "(extra info in $metis_log)";
    die "$ONMETIS failure: renumbered file '$permute_file' was not created\n"
        unless -r $permute_file;

    my @renumbered = (); # if $i == old canonical ID + 1 then
                         # $renumbered[$i] = renumbered canonical ID
    open  IN, $permute_file or die "Cannot read $permute_file:  $!\n";
    @renumbered = <IN>;
    close IN;
    # clean up the array:  strip white space; map 0..N-1 to 1..N
    @renumbered = map { chomp; s/\s+//g; $_ } @renumbered;

    # insert the metis renumbered node ID's into the db
    $tot_ins    = 0;
    $nInserts   = 0;
    my $p_field = "";
    my $p_value = "";
    if ($partition_id) {
        $p_field = " level   ,  pid         , ";
        $p_value = "$level_id, $partition_id, ";
    }
    # only two columns in renumbered_nid; increase xact
    my $MY_XACTION_SIZE = 4 * $TRANSACTION_SIZE;
    for (my $old_id = 0; $old_id < scalar @renumbered; $old_id++) {
        $st = $dbh->begin_work unless $nInserts;

        my $old = $old_id              + 1; # 0-based indexing to 1-based
        my $new = $renumbered[$old_id] + 1; # 0-based indexing to 1-based
        $st = $dbh->do( 
                "insert into $renumbered_id_table 
                         ($p_field  orig_id, new_id) " .
                 "values ($p_value  $old,    $new )"
                      );
        ++$nInserts;

        if ($nInserts >= $MY_XACTION_SIZE) {
            $st = $dbh->commit;
            $tot_ins += $nInserts;
            $end_ti   = time;
            printf "# inserts:  %12d  (%.2f ins/sec)\r", 
                    $tot_ins, $MY_XACTION_SIZE/($end_ti - $start_ti) if $opt_v;
            $start_ti = $end_ti;
            $nInserts = 0;
        }
    }
    $st = $dbh->commit if $nInserts;
#   unlink $tmp_metis_graph;
#   unlink $permute_file;
} # 1}}}
sub renumber_partition_nodes { # {{{1
# this version creates a separate node_node table for each partition
    my ($partn_dbh    ,
        $nPartitions  , 
        $model_db_file,
        $rh_Utility   ,
        $ONMETIS      ,
        $rs_total_t   ,
       ) = @_;

    my $st;
    my $details = "";

    $st = $partn_dbh->do("attach '$model_db_file' as MODEL_DB;");
    foreach (my $pid = 1; $pid <= $nPartitions; $pid++) {
        $start_t  = time();
        $start_ti = $start_t;

        # Create tables for this partition. {{{2
        my $table_prefix       = sprintf("P%02d", $pid)          ;
        my $T_canonical_nid    = "${table_prefix}_canonical_nid" ;
#       my $T_renumbered_nid   = "${table_prefix}_renumbered_nid";
        my $T_node_node_i      = "${table_prefix}_node_node_i"   ;
        my $T_node_node_b      = "${table_prefix}_node_node_b"   ;
        my $T_node_node        = "${table_prefix}_node_node"     ;

        $st = $partn_dbh->do("
                          create table $T_canonical_nid (
                          id     integer,  -- canonical node ID for this ptn
                          nid    integer   -- FK to node.seq_no
                          );
                             ");
#       $st = $partn_dbh->do("
#                         create table $T_renumbered_nid (
#                         -- A copy of _renumbered_nid_i supplemented with
#                         -- the boundary nodes at the end.
#                         orig_id integer,  -- FK to T_canonical_nid.id
#                         new_id  integer primary key
#                         );
#                            ");
        $st = $partn_dbh->do("
                          create table $T_node_node_i (
                          -- Nodal connectivity for interior nodes only.
                          nid_a integer,  -- FK to $T_canonical_nid.id
                          nid_b integer   -- FK to $T_canonical_nid.id
                          );
                             ");
        $st = $partn_dbh->do("
                          create table $T_node_node_b (
                          -- Nodal connectivity for boundary nodes and
                          -- the interior nodes they connect to; ie, all
                          -- connections for this partition which do not
                          -- appear in _node_node_i.
                          nid_a integer,  -- FK to $T_canonical_nid.id
                          nid_b integer   -- FK to $T_canonical_nid.id
                          );
                             ");
        # 2}}}

        # Remap node ID's for this partition to 1..nNtP {{{2
        # (nNtP = number of nodes in this partition).
        # Do it in two steps:
        #   1. renumber interior nodes with metis, map to 1..nInterior
        #   2. append boundary nodes, map to (nInterior+1)..nNtP
        # This sequencing is needed to allow a metis renumbering of
        # only the interior nodes which in turn is needed to create
        # assembled matrices which have the boundary terms grouped 
        # together as the last n rows/cols.

        # tmp_local_nodes.seq_no = canonical node ID within this partition
        # tmp_local_nodes.nid    = FK to node.seq_no
        $st = $partn_dbh->do("create table tmp_local_nodes (
                               seq_no integer primary key,
                               nid    integer            
                               );
                             ");
my $ST;
my $ET;
$ST = time();
        $st = $partn_dbh->do("insert into tmp_local_nodes  -- interior nodes
                  select distinct NULL, EN.nid
                        from element_partition EP,
                             element_node      EN
                             where 
                                EN.nid not in
                                    (select nid from boundary_node) and
                                EP.pid=$pid and EP.eid=EN.eid 
                             ;
                             ");
$ET = time();
printf "\n";
printf "insert into tmp_local_nodes (i)   (% .2f)\n", $ET - $ST;
$ST = time();
        $st = $partn_dbh->do("insert into tmp_local_nodes  -- boundary nodes
                  select distinct NULL, EN.nid
                        from element_partition EP,
                             element_node      EN
                             where 
                                EN.nid     in
                                    (select nid from boundary_node) and
                                EP.pid=$pid and EP.eid=EN.eid 
                             ;
                             ");
$ET = time();
printf "insert into tmp_local_nodes (b)   (% .2f)\n", $ET - $ST;

$ST = time();
        $st = $partn_dbh->do("
            insert into $T_canonical_nid (id, nid)
                select seq_no-1, nid from tmp_local_nodes;
                            ");
        $st = $partn_dbh->do("drop table tmp_local_nodes;
                             ");
$ET = time();
printf "insert into $T_canonical_nid     (% .2f)\n", $ET - $ST;

        # 2}}}

        # Determine node to node connectivities in this partition. {{{2
        # Do two sets:
        # 1. interior nodes only
        # 2. boundary nodes + the interior nodes they connect to.
        # This separation is needed because only interior connectivities
        # will be sent to metis for renumbering.
$ST = time();
        if (0) {  # slow method -- but why is it so slow?
                  # Need a fast, clean method of mapping two columns
                  # at once, ie,
                  #     A      J            1      8 
                  #     A      K            1      9
                  #     A      L            1     10
                  #     B      K    -to->   2      9
                  #     B      M            2     11
                  #     C      L            3     10
                  #     C      M            3     11
                  #     C      N            3     12
                  # The slow method does it at once, the fast method
                  # does one column at a time w/lots of temp tables.
        $st = $partn_dbh->do("
            create index idx_${T_canonical_nid} on
                             ${T_canonical_nid} (nid);
                             ");
        $st = $partn_dbh->do("
            insert into $T_node_node_i (nid_a, nid_b)
                select distinct PCN1.id, PCN2.id from 
                     element_node      EN1 , 
                     element_node      EN2 , 
                     node              N   ,
                     $T_canonical_nid  PCN1,
                     $T_canonical_nid  PCN2
                     where 
                           PCN1.nid not in (select nid from boundary_node) and
                           PCN2.nid not in (select nid from boundary_node) and
                           EN1.eid in ( select eid from element_partition 
                                            where pid = $pid) and
                           EN1.nid  =  N.seq_no and 
                           EN2.nid  <> N.seq_no and 
                           EN1.eid  =  EN2.eid  and
                           PCN1.nid =  EN1.nid  and
                           PCN2.nid =  EN2.nid
                     order by PCN1.id, PCN2.id;
                            ");
        } else {  # fast (but ugly) method
        $st = $partn_dbh->do("
                create table tmp_NN_1 (
                    seq_no integer primary key,
                    nid_a integer,    -- FK node.seq_no
                    nid_b integer     -- FK node.seq_no
                );
                            ");

        $st = $partn_dbh->do("
                create table tmp_NN_2 (
                    seq_no integer primary key,
                    cid_a integer,    -- FK _canonical_nid.id
                    nid_b integer     -- FK node.seq_no
                );
                            ");

        $st = $partn_dbh->do("
                insert into tmp_NN_1
                select distinct NULL            , 
                                EN1.nid as nid_a, 
                                EN2.nid as nid_b
                                from
                     element_node      EN1 , 
                     element_node      EN2 , 
                     node              N   
                     where 
                           EN1.nid not in (select nid from boundary_node) and
                           EN2.nid not in (select nid from boundary_node) and
                           EN1.eid in ( select eid from element_partition 
                                            where pid = $pid) and
                           EN1.nid  =  N.seq_no and 
                           EN2.nid  <> N.seq_no and 
                           EN1.eid  =  EN2.eid
                ;
                            ");

        $st = $partn_dbh->do("
            create index idx_tmp_NN_1 on
                             tmp_NN_1 (nid_a);
                             ");
        $st = $partn_dbh->do("
                insert into tmp_NN_2
                select NULL, PCN.id, tmp_NN_1.nid_b from 
                    $T_canonical_nid  PCN, 
                    tmp_NN_1
                        where tmp_NN_1.nid_a = PCN.nid
                ;
                            ");

        $st = $partn_dbh->do("
            create index idx_tmp_NN_2 on
                             tmp_NN_2 (nid_b);
                             ");
        $st = $partn_dbh->do("
                insert into $T_node_node_i (nid_a, nid_b)
                select tmp_NN_2.cid_a, PCN.id from 
                    $T_canonical_nid  PCN, 
                    tmp_NN_2
                        where tmp_NN_2.nid_b = PCN.nid
                ;
                            ");
        $st = $partn_dbh->do("drop index idx_tmp_NN_1;");
        $st = $partn_dbh->do("drop index idx_tmp_NN_2;");
        $st = $partn_dbh->do("drop table     tmp_NN_1;");
        $st = $partn_dbh->do("drop table     tmp_NN_2;");

        }
$ET = time();
printf "insert into $T_node_node_i       (% .2f)\n", $ET - $ST;

$ST = time();
        # Then make the table with all remaining node-to-node connectivies
        # in this partition.
        if (0) {  # slow method
        $st = $partn_dbh->do("
            insert into $T_node_node_b (nid_a, nid_b)
                select distinct PCN1.id, PCN2.id from 
                     element_node      EN1 , 
                     element_node      EN2 , 
                     node              N   ,
                     $T_canonical_nid  PCN1,
                     $T_canonical_nid  PCN2
                     where 
                          (PCN1.nid     in (select nid from boundary_node)  or
                           PCN2.nid     in (select nid from boundary_node)) and
                           EN1.eid in ( select eid from element_partition 
                                            where pid = $pid) and
                           EN1.nid  =  N.seq_no and 
                           EN2.nid  <> N.seq_no and 
                           EN1.eid  =  EN2.eid  and
                           PCN1.nid =  EN1.nid  and
                           PCN2.nid =  EN2.nid
                     order by PCN1.id, PCN2.id;
                            ");
        } else {
        $st = $partn_dbh->do("
                create table tmp_NN_1 (
                    seq_no integer primary key,
                    nid_a integer,    -- FK node.seq_no
                    nid_b integer     -- FK node.seq_no
                );
                            ");

        $st = $partn_dbh->do("
                create table tmp_NN_2 (
                    seq_no integer primary key,
                    cid_a integer,    -- FK _canonical_nid.id
                    nid_b integer     -- FK node.seq_no
                );
                            ");

        $st = $partn_dbh->do("
                insert into tmp_NN_1
                select distinct NULL            , 
                                EN1.nid as nid_a, 
                                EN2.nid as nid_b
                                from
                     element_node      EN1 , 
                     element_node      EN2 , 
                     node              N   
                     where 
                          (EN1.nid     in (select nid from boundary_node)  or
                           EN2.nid     in (select nid from boundary_node)) and
                           EN1.eid in ( select eid from element_partition 
                                            where pid = $pid) and
                           EN1.nid  =  N.seq_no and 
                           EN2.nid  <> N.seq_no and 
                           EN1.eid  =  EN2.eid
                ;
                            ");

        $st = $partn_dbh->do("
            create index idx_tmp_NN_1 on
                             tmp_NN_1 (nid_a);
                             ");
        $st = $partn_dbh->do("
                insert into tmp_NN_2
                select NULL, PCN.id, tmp_NN_1.nid_b from 
                    $T_canonical_nid  PCN, 
                    tmp_NN_1
                        where tmp_NN_1.nid_a = PCN.nid
                ;
                            ");

        $st = $partn_dbh->do("
            create index idx_tmp_NN_2 on
                             tmp_NN_2 (nid_b);
                             ");
        $st = $partn_dbh->do("
                insert into $T_node_node_b (nid_a, nid_b)
                select tmp_NN_2.cid_a, PCN.id from 
                    $T_canonical_nid  PCN, 
                    tmp_NN_2
                        where tmp_NN_2.nid_b = PCN.nid
                ;
                            ");
        $st = $partn_dbh->do("drop index idx_tmp_NN_1;");
        $st = $partn_dbh->do("drop index idx_tmp_NN_2;");
        $st = $partn_dbh->do("drop table     tmp_NN_1;");
        $st = $partn_dbh->do("drop table     tmp_NN_2;");
        }
$ET = time();
printf "insert into $T_node_node_b       (% .2f)\n", $ET - $ST;

        # 2}}}

#         # Renumber the interior nodes with metis. {{{2
#         if ($rh_Utility->{$ONMETIS} eq "Found") {
# 
#             # This only renumbers interior nodes:
# $ST = time();
#             renumber_nodes($partn_dbh           ,
#                            $ONMETIS             ,  # the renumbering program
#                            0                    ,  # the partition number
#                            0                    ,  # the level
#                            $T_node_node_i       ,  # node to node connectivity
#                            $T_renumbered_nid    ,  # populate this table
#                           \$details             ,
#                            ); 
# $ET = time();
# printf "call renumber_nodes             % .2f\n", $ET - $ST;
# 
#             # Add in the boundary nodes.  The "order by nid" clause is
#             # important--it guarantees neighboring partitions will have
#             # their boundary nodes in the same order meaning these rows/cols
#             # of the reduced matrices can be summed together directly.
#             # In this context a boundary node is anything which does
#             # not appear in the interior set, and that includes interior
#             # nodes which connect only to boundary nodes.
# $ST = time();
#             $st = $partn_dbh->do("
#                           insert into $T_renumbered_nid
#                               select id,NULL from $T_canonical_nid
#                                   where id not in
#                                      (select distinct nid_a from $T_node_node_i)
#                                   order by nid
#                                 ;
#                                 ");
# $ET = time();
# printf "insert into $T_renumbered_nid  % .2f\n", $ET - $ST;
#         } else {
#             # No renumbering in the partition database.  Make the new 
#             # seq_no same as the old seq_no.  Again, interior nodes
#             # first, then boundary nodes.
#             die "Missing code to populate $T_renumbered_nid without metis";
#             # queries below are wrong; should only work with nodes in
#             # this partition instead of the entire model.
#             $st = $partn_dbh->do("
#                           insert into $T_renumbered_nid
#                               select seq_no, NULL
#                               from node where 
#                                   node.seq_no not in 
#                                       (select nid from boundary_node)
#                                   order by seq_no
#                                 ");
#             $st = $partn_dbh->do("
#                           insert into $T_renumbered_nid
#                               select seq_no, NULL
#                               from node where 
#                                   node.seq_no     in 
#                                       (select nid from boundary_node)
#                                   order by seq_no
#                                 ");
# 
#         }
#         # 2}}}

        # Create the partitions' _node_node table. {{{2

$ST = time();
        $st = $partn_dbh->do("
                          create table $T_node_node (
                          nid_a integer,  -- FK to $T_canonical_nid.id
                          nid_b integer   -- FK to $T_canonical_nid.id
                          );
                             ");

        $st = $partn_dbh->do("
            create index idx_${T_canonical_nid}_1 on
                             ${T_canonical_nid}   (id);
                             ");
        $st = $partn_dbh->do("
            create index idx_${T_canonical_nid}_2 on
                             ${T_canonical_nid}   (nid);
                             ");
        $st = $partn_dbh->do("
            create index idx_${T_node_node_i}_a on
                             ${T_node_node_i}   (nid_a);
                             ");
        $st = $partn_dbh->do("
            create index idx_${T_node_node_i}_b on
                             ${T_node_node_i}   (nid_b);
                             ");
        $st = $partn_dbh->do("
            create index idx_${T_node_node_b}_a on
                             ${T_node_node_b}   (nid_a);
                             ");
        $st = $partn_dbh->do("
            create index idx_${T_node_node_b}_b on
                             ${T_node_node_b}   (nid_b);
                             ");

        $st = $partn_dbh->do("
          insert into $T_node_node  
            select R1.id, R2.id from $T_node_node_i      NN,
                                     $T_canonical_nid    R1,
                                     $T_canonical_nid    R2
                    where  R1.id  =  NN.nid_a and
                           R2.id  =  NN.nid_b and
                           R1.nid  <=  R2.nid 
           "           .  # only does lower half

           " union "   .  # add in the boundary connectivities
           "select R1.id, R2.id from $T_node_node_b      NN,
                                     $T_canonical_nid    R1,
                                     $T_canonical_nid    R2
                    where  R1.id  =  NN.nid_a and
                           R2.id  =  NN.nid_b and
                           R1.nid  <=  R2.nid 
            "          .
            "union "   .  # forces inclusion of diagonal terms
            "
             select R1.id, R1.id from $T_canonical_nid R1
               order by R1.id
            ;"
                      );
$ET = time();
printf "insert into $T_node_node         (% .2f)\n", $ET - $ST;

        # 2}}}

        $end_t = time;
        printf "create partition %2d tables    ", $pid; 
        ${$rs_total_t} += ($end_t - $start_t);
        printf "   %7.2f sec  %s\n", 
                $end_t - $start_t, $details;
    }
    $st = $partn_dbh->do("detach MODEL_DB;");
} # 1}}}
