share/contrib/state/sortem.mac

   1 /*
   2 This subroutine computes pade approximants of multivariable functions
   3 Copyright (C) 1999  Dan Stanger
   4
   5 This library is free software; you can redistribute it and/or modify it
   6 under the terms of the GNU Library General Public License as published
   7 by the Free Software Foundation; either version 2 of the License, or (at
   8 your option) any later version.
   9
  10 This library is distributed in the hope that it will be useful, but
  11 WITHOUT ANY WARRANTY; without even the implied warranty of
  12 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  13 Library General Public License for more details.
  14
  15 You should have received a copy of the GNU Library General Public
  16 License along with this library; if not, write to the Free Software
  17 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA
  18
  19 Dan Stanger dan.stanger@ieee.org
  20
  21 */
  22 /* this function uses the pt_D matrix for temp storage */
  23 sortem(MN, MB):=block([
  24     tkl:makelist(pt_aJT[i],i, 1, MN), /* make a list of tree element types */
  25     lkl:makelist(pt_aJT[i],i,MN+1, MB), /* make a list of link element types */
  26     lt:1..MN, /* make a list of the tree branch numbers */
  27     ll:MN+1..MB,l], /* and the link branch numbers */
  28     l:append(
  29         sort_with_keylist(lt,tkl,
  30             lambda([x,y],getTreeElementIndex(x)<getTreeElementIndex(y))),
  31         sort_with_keylist(ll,lkl,
  32             lambda([x,y],getLinkElementIndex(x)<getLinkElementIndex(y)))),
  33     block([ii],
  34         ii:0,
  35         for i in l do (
  36             ii:ii+1,
  37             pt_D[0,ii]:pt_aJT[i],
  38             for j:1 thru MN do pt_D[j,ii]:pt_A[j,i]),
  39         for i:1 thru MB do (
  40             pt_aJT[i]:pt_D[0,i],
  41             /* copy back to pt_A matrix just in case */
  42             for j:1 thru MN do pt_A[j,i]:pt_D[j,i]),
  43         ii:0,
  44         for i in l do (ii:ii+1, pt_D[0,ii]:pt_name[i]),
  45         for i:1 thru MB do (pt_name[i]:pt_D[0,i]),
  46         ii:0,
  47         for i in l do (ii:ii+1, pt_D[0,ii]:pt_V[i]),
  48         for i:1 thru MB do (pt_V[i]:pt_D[0,i])
  49     ),
  50
  51     [genmatrix(pt_A,MN,MN,1,1),
  52      genmatrix(pt_A,MN,MB,1,MN+1)] /* could use pt_D here instead */
  53 )
  54 $