#include "includes.h"

/* simple matrix multiply for square matrices */
/* if trana, then transpose of a, if tranb, transpose of b, etc... */

static int keep_a=0;
static int keep_b=0;
static double **atmp,**btmp;

void mmult(a,trana,b,tranb,c,tranc,size)
   double **a, **b, **c;
   int trana,tranb,tranc,size;

   {
      register int i,j,k,odd_even;
      double t,t1=0.0;
      double *aa, *bb;
      double *aa2,*bb2,t2,t3;
      double t4,t5,t6,t7;
      double **aatmp,**bbtmp;

      if(trana) {
         if(size > keep_a) {
            if(keep_a) free_matrix(keep_a);
            atmp = (double **) init_matrix(size,size);
            keep_a=size;
            }

         for (i=0; i < size ; i++)
            for (j=0; j < size ; j++)
               atmp[i][j] = a[j][i];
         aatmp=atmp;
         }
      else aatmp = a;

      if(!tranb) {
         if(size > keep_b) {
            if(keep_b) free_matrix(keep_b);
            btmp = (double **) init_matrix(size,size);
            keep_b=size;
            }

         for (i=0; i < size ; i++)
            for (j=0; j < size ; j++)
               btmp[i][j] = b[j][i];
         bbtmp=btmp;
         }
      else bbtmp = b;

      odd_even = (size%2) ? 1 : 0;

      if(odd_even) odd_mmult(aatmp,bbtmp,c,tranc,size);
      else {
         for (i=0; i < size ; i+=2) {
            for (j=0; j < size; j+=2) {
               aa = aatmp[i];
               aa2 = aatmp[i+1];
               bb = bbtmp[j];
               bb2 = bbtmp[j+1];
               t2=t3=t4=t5=t6=t7=0.0;
               for (k=size/2,t=t1=0.0; k ; k--,aa+=2,bb+=2,aa2+=2,bb2+=2) {
                  t += *aa * *bb;
                  t2 += *aa * *bb2;
                  t4 += *aa2 * *bb;
                  t6 += *aa2 * *bb2;
                  t1 += *(aa+1) * *(bb+1);
                  t3 += *(aa+1) * *(bb2+1);
                  t5 += *(aa2+1) * *(bb+1);
                  t7 += *(aa2+1) * *(bb2+1);
                  }
               if(tranc) {
                  c[j][i] = t+t1;
                  c[j+1][i] = t2+t3;
                  c[j][i+1] = t4+t5;
                  c[j+1][i+1] = t6+t7;
                  }
               else {
                  c[i][j] = t+t1;
                  c[i][j+1] = t2+t3;
                  c[i+1][j] = t4+t5;
                  c[i+1][j+1] = t6+t7;
                  }
               }
            }
         }
      }
#include "includes.h"

/* simple matrix multiply for square matrices */
/* if trana, then transpose of a, if tranb, transpose of b, etc... */

static int keep_a=0;
static int keep_b=0;
static double **atmp,**btmp;

void mmult(a,trana,b,tranb,c,tranc,size)
   double **a, **b, **c;
   int trana,tranb,tranc,size;

   {
      register int i,j,k,odd_even;
      double t,t1=0.0;
      double *aa, *bb;
      double **aatmp,**bbtmp;

      if(trana) {
         if(size > keep_a) {
            if(keep_a) free_matrix(keep_a);
            atmp = (double **) init_matrix(size,size);
            keep_a=size;
            }

         for (i=0; i < size ; i++)
            for (j=0; j < size ; j++)
               atmp[i][j] = a[j][i];
         aatmp=atmp;
         }
      else aatmp = a;

      if(!tranb) {
         if(size > keep_b) {
            if(keep_b) free_matrix(keep_b);
            btmp = (double **) init_matrix(size,size);
            keep_b=size;
            }

         for (i=0; i < size ; i++)
            for (j=0; j < size ; j++)
               btmp[i][j] = b[j][i];
         bbtmp=btmp;
         }
      else bbtmp = b;

      odd_even = (size%2) ? 1 : 0;

      for (i=0; i < size ; i++)
         for (j=0; j < size; j++) {
            aa = aatmp[i];
            bb = bbtmp[j];
#if 0
            for (k=size,t=0.0; k ; k--,aa++,bb++)
               t += *aa * *bb;
#else
            for (k=size/2,t=t1=0.0; k ; k--,aa+=2,bb+=2) {
               t += *aa * *bb;
               t1 += *(aa+1) * *(bb+1);
               }
            if(odd_even)
               t += *aa * *bb;
#endif
            if(tranc) c[j][i] = t+t1;
            else c[i][j] = t+t1;
            }
    
      }
#include "includes.h"

/* multiplies two square matrices together */
/* if in (n=a,b,c) = 1, then normal multiply */
/* if jn (n=a,b,c) = 1, then multiply by transpose of n */

void mxmb(a,ia,ja, b,ib,jb, c,ic,jc, nrow, nlnk, ncol)
   double **a, **b, **c;
   int ia, ja, ib, jb, ic, jc, nrow, nlnk, ncol;

   {
      if (ic == 1) {
         if (ia == 1) {
            if (ib == 1) {
               mmult(a,0,b,0,c,0,nrow);
               }
            else {
               if (jb == 1) {
                  mmult(a,0,b,1,c,0,nrow);
                  }
               else {
                  mxmbol(a,ia,ja,b,ib,jb,c,ic,jc,nrow,nlnk,ncol);
                  }
               }
            }
         else {
            if (ja == 1) {
               if (ib == 1) {
                  mmult(a,1,b,0,c,0,nrow);
                  }
               else {
                  if (jb == 1) {
                     mmult(a,1,b,1,c,0,nrow);
                     }
                  else {
                     mxmbol(a,ia,ja,b,ib,jb,c,ic,jc,nrow,nlnk,ncol);
                     }
                  }
               }
            else {
               mxmbol(a,ia,ja,b,ib,jb,c,ic,jc,nrow,nlnk,ncol);
               }
            }
         }
      else {
         if (jc == 1) {
            if (ia == 1) {
               if (ib == 1) {
                  mmult(a,0,b,0,c,1,nrow);
                  }
               else {
                  if (jb == 1) {
                     mmult(a,0,b,1,c,1,nrow);
                     }
                  else {
                     mxmbol(a,ia,ja,b,ib,jb,c,ic,jc,nrow,nlnk,ncol);
                     }
                  }
               }
            else {
               if (ja == 1) {
                  if (ib == 1) {
                     mmult(a,1,b,0,c,1,nrow);
                     }
                  else {
                     if (jb == 1) {
                        mmult(a,1,b,1,c,1,nrow);
                        }
                     else {
                        mxmbol(a,ia,ja,b,ib,jb,c,ic,jc,nrow,nlnk,ncol);
                        }
                     }
                  }
               else {
                  mxmbol(a,ia,ja,b,ib,jb,c,ic,jc,nrow,nlnk,ncol);
                  }
               }
            }
         else {
            mxmbol(a,ia,ja,b,ib,jb,c,ic,jc,nrow,nlnk,ncol);
            }
         }
      }
#include "includes.h"

/* multiplies two square matrices together */
/* if in (n=a,b,c) = 1, then normal multiply */
/* if jn (n=a,b,c) = 1, then multiply by transpose of n */

mxmb(a,ia,ja, b,ib,jb, c,ic,jc, nrow, nlnk, ncol)
   double **a, **b, **c;
   int ia, ja, ib, jb, ic, jc, nrow, nlnk, ncol;

   {
      if (ic == 1) {
         if (ia == 1) {
            if (ib == 1) {
               mxmnn(a,ja,b,jb,c,jc,nrow,nlnk,ncol);
               }
            else {
               if (jb == 1) {
                  mxmnt(a,ja,b,ib,c,jc,nrow,nlnk,ncol);
                  }
               else {
                  mxmbol(a,ia,ja,b,ib,jb,c,ic,jc,nrow,nlnk,ncol);
                  }
               }
            }
         else {
            if (ja == 1) {
               if (ib == 1) {
                  mxmtn(a,ia,b,jb,c,jc,nrow,nlnk,ncol);
                  }
               else {
                  if (jb == 1) {
                     mxmtt(a,ia,b,ib,c,jc,nrow,nlnk,ncol);
                     }
                  else {
                     mxmbol(a,ia,ja,b,ib,jb,c,ic,jc,nrow,nlnk,ncol);
                     }
                  }
               }
            else {
               mxmbol(a,ia,ja,b,ib,jb,c,ic,jc,nrow,nlnk,ncol);
               }
            }
         }
      else {
         if (jc == 1) {
            if (ia == 1) {
               if (ib == 1) {
                  mxmtt(b,jb,a,ja,c,ic,ncol,nlnk,nrow);
                  }
               else {
                  if (jb == 1) {
                     mxmnt(b,ib,a,ja,c,ic,ncol,nlnk,nrow);
                     }
                  else {
                     mxmbol(a,ia,ja,b,ib,jb,c,ic,jc,nrow,nlnk,ncol);
                     }
                  }
               }
            else {
               if (ja == 1) {
                  if (ib == 1) {
                     mxmtn(b,jb,a,ia,c,ic,ncol,nlnk,nrow);
                     }
                  else {
                     if (jb == 1) {
                        mxmnn(b,ib,a,ia,c,ic,ncol,nlnk,nrow);
                        }
                     else {
                        mxmbol(a,ia,ja,b,ib,jb,c,ic,jc,nrow,nlnk,ncol);
                        }
                     }
                  }
               else {
                  mxmbol(a,ia,ja,b,ib,jb,c,ic,jc,nrow,nlnk,ncol);
                  }
               }
            }
         else {
            mxmbol(a,ia,ja,b,ib,jb,c,ic,jc,nrow,nlnk,ncol);
            }
         }
      }
#include "includes.h"

#define IVEC 128
#define IVEC1 127
#define KVEC 48
#define KVEC1 47

static double *aa, *bb, *cc, **ascr;
static int sizea=0;
static int sizeb=0;
static int sizec=0;

void mxmnn(a,ia,b,ib,c,ic,l,m,n)
   double **a, **b, **c;
   int ia, ib, ic, l, m, n;

   {
      int ii, kk, i2, k2;

      if (ia > sizea) {
         if (sizea) {
            free(aa);
            free_matrix(ascr,sizea);
            }
         sizea = ia;
         aa = (double *) init_array(sizea*sizea);
         ascr = (double **) init_matrix(sizea,sizea);
         }
      if (ib > sizeb) {
         if (sizeb) free(bb);
         sizeb = ib;
         bb = (double *) init_array(sizeb*sizeb);
         }
      if (ic > sizec) {
         if (sizec) free(cc);
         sizec = ic;
         cc = (double *) init_array(sizec*sizec);
         }
      else {
         bzero(cc,sizeof(double)*sizec*sizec);
         }

      mat_to_arr(b,bb,ib,ib);

      for (ii = 0; ii < l ; ii += IVEC) {
         for (kk = 0; kk < m ; kk += KVEC) {
            i2 = MIN0(ii+IVEC,l);
            k2 = MIN0(kk+KVEC,m);
            mxmtrn(a,ia,ascr,KVEC,ii,i2,kk,k2);
            mat_to_arr(ascr,aa,ia,ia);
            mxmtnd(aa,ia,bb,ib,cc,ic,ii,i2,1,n,kk,k2);
            }
         }
      arr_to_mat(c,cc,ic,ic);
      }

void mxmnt(a,ia,b,ib,c,ic,l,m,n)
   double **a, **b, **c;
   int ia, ib,ic,l,m,n;

   {
      int ii,kk,i2,k2;

      if (ia > sizea) {
         if (sizea) {
            free(aa);
            free_matrix(ascr,sizea);
            }
         sizea = ia;
         aa = (double *) init_array(sizea*sizea);
         ascr = (double **) init_matrix(sizea,sizea);
         }
      if (ib > sizeb) {
         if (sizeb) free(bb);
         sizeb = ib;
         bb = (double *) init_array(sizeb*sizeb);
         }
      if (ic > sizec) {
         if (sizec) free(cc);
         sizec = ic;
         cc = (double *) init_array(sizec*sizec);
         }
      else {
         bzero(cc,sizeof(double)*sizec*sizec);
         }

      mat_to_arr(b,bb,ib,ib);

      for (ii = 0; ii < l ; ii += IVEC) {
         for (kk = 0; kk < m ; kk += KVEC) {
            i2 = MIN0(ii+IVEC,l);
            k2 = MIN0(kk+KVEC,m);
            mxmtrn(a,ia,ascr,KVEC,ii,i2,kk,k2);
            mat_to_arr(ascr,aa,ia,ia);
            mxmttd(aa,ia,bb,ib,cc,ic,ii,i2,1,n,kk,k2);
            }
         }
      arr_to_mat(c,cc,ic,ic);
      }

void mxmtn(a,ia,b,ib,c,ic,l,m,n)
   double **a, **b, **c;
   int ia, ib,ic,l,m,n;

   {
      int ii,kk,i2,k2;

      if (ia > sizea) {
         if (sizea) {
            free(aa);
            free_matrix(ascr,sizea);
            }
         sizea = ia;
         aa = (double *) init_array(sizea*sizea);
         ascr = (double **) init_matrix(sizea,sizea);
         }
      if (ib > sizeb) {
         if (sizeb) free(bb);
         sizeb = ib;
         bb = (double *) init_array(sizeb*sizeb);
         }
      if (ic > sizec) {
         if (sizec) free(cc);
         sizec = ic;
         cc = (double *) init_array(sizec*sizec);
         }
      else {
         bzero(cc,sizeof(double)*sizec*sizec);
         }

      mat_to_arr(a,aa,ia,ia);
      mat_to_arr(b,bb,ib,ib);

      for (ii = 0; ii < l ; ii += IVEC) {
         for (kk = 0; kk < m ; kk += KVEC) {
            i2 = MIN0(ii+IVEC,l);
            k2 = MIN0(kk+KVEC,m);
            mxmtnc(aa,ia,bb,ib,cc,ic,ii,i2,1,n,kk,k2);
            }
         }
      arr_to_mat(c,cc,ic,ic);
      }

void mxmtt(a,ia,b,ib,c,ic,l,m,n)
   double **a, **b, **c;
   int ia, ib,ic,l,m,n;

   {
      int ii,kk,i2,k2;
      double *aa, *bb, *cc;

      if (ia > sizea) {
         if (sizea) {
            free(aa);
            free_matrix(ascr,sizea);
            }
         sizea = ia;
         aa = (double *) init_array(sizea*sizea);
         ascr = (double **) init_matrix(sizea,sizea);
         }
      if (ib > sizeb) {
         if (sizeb) free(bb);
         sizeb = ib;
         bb = (double *) init_array(sizeb*sizeb);
         }
      if (ic > sizec) {
         if (sizec) free(cc);
         sizec = ic;
         cc = (double *) init_array(sizec*sizec);
         }
      else {
         bzero(cc,sizeof(double)*sizec*sizec);
         }

      mat_to_arr(a,aa,ia,ia);
      mat_to_arr(b,bb,ib,ib);

      for (ii = 0; ii < l ; ii += IVEC) {
         for (kk = 0; kk < m ; kk += KVEC) {
            i2 = MIN0(ii+IVEC,l);
            k2 = MIN0(kk+KVEC,m);
            mxmttc(aa,ia,bb,ib,cc,ic,ii,i2,1,n,kk,k2);
            }
         }
      arr_to_mat(c,cc,ic,ic);
      }

void mxmtnc(a,ia,b,ib,c,ic,i1,i2,j1,j2,k1,k2)
   double *a, *b, *c;
   int ia,ib,ic,i1,i2,j1,j2,k1,k2;

   {
      register int boff;
      int aoffs,boffs,coffs,kinc,boffst,coff;
      int i,j;
      double t;
      double *atmp, *btmp;

      aoffs = (i1)*ia + k1;
      boffs = (j1-1)*ib + k1;
      coffs = (j1-1)*ic + i1;

      kinc = k2 - k1;

      for(i=i1; i < i2; i++) {
         boffst = boffs;
         coff = coffs;
         for (j = j1; j <= j2; j++) {
            t = c[coff];
            atmp = &a[aoffs];
            btmp = &b[boffst];
            for (boff = boffst; boff < boffst+kinc ; boff++,atmp++,btmp++)
               t += (*atmp)*(*btmp);
            c[coff]=t;
            boffst += ib;
            coff += ic;
            }
         aoffs += ia;
         coffs++;
         }
      }

void mxmtnd(a,ia,b,ib,c,ic,i1,i2,j1,j2,k1,k2)
   double *a, *b, *c;
   int ia,ib,ic,i1,i2,j1,j2,k1,k2;

   {
      register int boff;
      int aoffs,boffs,coffs,kinc,boffst,coff;
      int i,j;
      double t;
      double *atmp, *btmp;

      aoffs = 0;
      boffs = (j1-1)*ib + k1;
      coffs = (j1-1)*ic + i1;

      kinc = k2 - k1;

      for(i=i1; i < i2; i++) {
         boffst = boffs;
         coff = coffs;
         for (j = j1; j <= j2; j++) {
            t = c[coff];
            atmp = &a[aoffs];
            btmp = &b[boffst];
            for (boff = boffst; boff < boffst+kinc ; boff++,atmp++,btmp++)
               t += (*atmp)*(*btmp);
            c[coff]=t;
            boffst += ib;
            coff += ic;
            }
         aoffs += ia;
         coffs++;
         }
      }

void mxmtrn(a,ia,b,ib,i1,i2,j1,j2)
   double **a, **b;
   int ia,ib,i1,i2,j1,j2;

   {
      int i,j,ii,jj;

      ii=0;
      for(i=i1; i < i2; i++) {
         jj=0;
         for (j = j1; j < j2; j++) {
            b[jj++][ii]=a[i][j];
            }
         ii++;
         }
      }

void mxmttc(a,ia,b,ib,c,ic,i1,i2,j1,j2,k1,k2)
   double *a, *b, *c;
   int ia,ib,ic,i1,i2,j1,j2,k1,k2;

   {
      register int boff;
      int aoffs,boffs,coffs,kinc,boffst,coff;
      int boffl, boffls;
      int i,j;
      double t;
      double *atmp;

      aoffs = (i1)*ia + k1;
      boffs = (k1)*ib + j1-1;
      coffs = (j1-1)*ic + i1;
      boffls = (k2)*ib + j1-1;

      kinc = k2 - k1;

      for(i=i1; i < i2; i++) {
         boffst = boffs;
         boffl = boffls;
         coff = coffs;
         for (j = j1; j <= j2; j++) {
            t = c[coff];
            atmp = &a[aoffs];
            for (boff = boffst; boff < boffl ; boff += ib, atmp++)
               t += (*atmp)*b[boff];
            c[coff]=t;
            boffst++;
            boffl++;
            coff += ic;
            }
         aoffs += ia;
         coffs++;
         }
      }

void mxmttd(a,ia,b,ib,c,ic,i1,i2,j1,j2,k1,k2)
   double *a, *b, *c;
   int ia,ib,ic,i1,i2,j1,j2,k1,k2;

   {
      register int boff;
      int aoffs,boffs,coffs,kinc,boffst,coff;
      int boffl, boffls;
      int i,j;
      double t, *atmp;

      aoffs = 0;
      boffs = (k1)*ib + j1-1;
      coffs = (j1-1)*ic + i1;
      boffls = (k2)*ib + j1-1;

      kinc = k2 - k1;

      for(i=i1; i < i2; i++) {
         boffst = boffs;
         boffl = boffls;
         coff = coffs;
         for (j = j1; j <= j2; j++) {
            t = c[coff];
            atmp = &a[aoffs];
            for (boff = boffst; boff < boffl ; boff += ib, atmp++)
               t += (*atmp)*b[boff];
            c[coff]=t;
            boffst++;
            boffl++;
            coff += ic;
            }
         aoffs += ia;
         coffs++;
         }
      }
#include "includes.h"

/* simple matrix multiply for square matrices */
/* if trana, then transpose of a, if tranb, transpose of b, etc... */

void odd_mmult(aatmp,bbtmp,c,tranc,size)
   double **aatmp, **bbtmp, **c;
   int tranc,size;

   {
      register int i,j,k;
      double t,t1;
      double *aa, *bb;
      double *aa2,*bb2,t2,t3;
      double t4,t5,t6,t7;

      for (i=0; i < size-1 ; i+=2) {
         for (j=0; j < size-1 ; j+=2) {
            aa = aatmp[i];
            aa2 = aatmp[i+1];
            bb = bbtmp[j];
            bb2 = bbtmp[j+1];
            t2=t3=t4=t5=t6=t7=0.0;
            for (k=size/2,t=t1=0.0; k ; k--,aa+=2,bb+=2,aa2+=2,bb2+=2) {
               t += *aa * *bb;
               t2 += *aa * *bb2;
               t4 += *aa2 * *bb;
               t6 += *aa2 * *bb2;
               t1 += *(aa+1) * *(bb+1);
               t3 += *(aa+1) * *(bb2+1);
               t5 += *(aa2+1) * *(bb+1);
               t7 += *(aa2+1) * *(bb2+1);
               }
            t += *aa * *bb;
            t2 += *aa * *bb2;
            t4 += *aa2 * *bb;
            t6 += *aa2 * *bb2;
            if(tranc) {
               c[j][i] = t+t1;
               c[j+1][i] = t2+t3;
               c[j][i+1] = t4+t5;
               c[j+1][i+1] = t6+t7;
               }
            else {
               c[i][j] = t+t1;
               c[i][j+1] = t2+t3;
               c[i+1][j] = t4+t5;
               c[i+1][j+1] = t6+t7;
               }
            }
         aa = aatmp[i];
         aa2 = aatmp[i+1];
         bb = bbtmp[j];
         t4=t5=0.0;
         for (k=size/2,t=t1=0.0; k ; k--,aa+=2,bb+=2,aa2+=2) {
            t += *aa * *bb;
            t4 += *aa2 * *bb;
            t1 += *(aa+1) * *(bb+1);
            t5 += *(aa2+1) * *(bb+1);
            }
         t += *aa * *bb;
         t4 += *aa2 * *bb;
         if(tranc) {
            c[j][i] = t+t1;
            c[j][i+1] = t4+t5;
            }
         else {
            c[i][j] = t+t1;
            c[i+1][j] = t4+t5;
            }
         }

      for (j=0; j < size-1 ; j+=2) {
         aa = aatmp[i];
         bb = bbtmp[j];
         bb2 = bbtmp[j+1];
         t2=t3=0.0;
         for (k=size/2,t=t1=0.0; k ; k--,aa+=2,bb+=2,bb2+=2) {
            t += *aa * *bb;
            t2 += *aa * *bb2;
            t1 += *(aa+1) * *(bb+1);
            t3 += *(aa+1) * *(bb2+1);
            }
         t += *aa * *bb;
         t2 += *aa * *bb2;
         if(tranc) {
            c[j][i] = t+t1;
            c[j+1][i] = t2+t3;
            }
         else {
            c[i][j] = t+t1;
            c[i][j+1] = t2+t3;
            }
         }
      aa = aatmp[i];
      bb = bbtmp[j];
      for (k=size/2,t=t1=0.0; k ; k--,aa+=2,bb+=2) {
         t += *aa * *bb;
         t1 += *(aa+1) * *(bb+1);
         }
      t += *aa * *bb;
      if(tranc) {
         c[j][i] = t+t1;
         }
      else {
         c[i][j] = t+t1;
         }           
      }

#include "includes.h"
#include "param.h"
#include "types.h"
#if SUN == 1
#include "unistd.h"
#endif

#define DEBUG 0

static char open_name[] = "sequential_ioopen";

sequential_t *
sequential_ioopen(baseparam,unit)
char *baseparam;
int unit;
{
  int i;
  sequential_t *ud;
  char param[MAX_STRING];
  char volid[MAX_STRING];
  char name[MAX_STRING];
  char volpath[MAX_STRING];
  char path[MAX_STRING];
  char *mode;
  struct stat statjunk;
  char name_format[3];

  strcpy(name_format,"%s");

  /* Allocate memory for the unit descriptor. */
  ud = (sequential_t *) malloc(sizeof(sequential_t));
  malloc_check(open_name,ud);

  /* Find out if we want extra information to be printed about this
   * unit.  name is used as a temporary buffer here. */
  strcpy(param,baseparam);
  strcat(param,"verbose");
  if (get_param(param,"%s",name)== -1) ud->verbose = 0;
  else {
    if (!strcmp(name,"on")) ud->verbose = 1;
    else if (!strcmp(name,"yes")) ud->verbose = 1;
    else if (!strcmp(name,"y")) ud->verbose = 1;
    else ud->verbose = 0;
    }

  /* Find out how many volumes to place the unit across. */
  strcpy(param,baseparam);
  strcat(param,"n");
  if (get_param(param,"%d",&ud->n) == -1) ud->n = 1;
  if (ud->n == 0) ud->n = 1;

  /* Set up the block size for this file system. */
  strcpy(param,baseparam);
  strcat(param,"blocksize");
  if (get_param(param,"%d",&ud->blocksize) == -1) ud->blocksize = 8192;
  if (ud->blocksize == 0) ud->blocksize = 8192;

  /* Find out how the files are to be named. */
  if (get_param("FILES:name",name_format,name) == -1) strcpy(name,"sequential");
  for (i=0; i<ud->n; i++) {
    sprintf(param,"%s%d",baseparam,i);
    if (get_param(param,"%s",volpath) == -1) {
      if (ud->n > 1) no_path_given(open_name);
      else volpath[0] = '\0';
      }
    sprintf(path,"%s%s%c%d",volpath,name,'.',unit);
    ud->v[i].path = (char *) malloc(strlen(path)+1);
    malloc_check(open_name,ud->v[i].path);
    strcpy(ud->v[i].path,path);
    if (stat(ud->v[i].path,&statjunk)==0) mode = "r+";
    else mode = "a+";
    ud->v[i].stream = fopen(ud->v[i].path,mode);
    fopen_check(open_name,ud->v[i].path,ud->v[i].stream);
    }
  ud->next = -1;
  ud->unit = unit;

  if (ud->verbose) {
    fprintf(stderr,"SEQ_IO: opened unit %d {\n",unit);
    fprintf(stderr,"  blocksize = %d\n",ud->blocksize);
    for (i=0; i<ud->n; i++) {
      fprintf(stderr,"  v[%d].path = \"%s\"\n",i,ud->v[i].path);
      }
    fprintf(stderr,"  }\n");
    }
  return(ud);
  }

void
sequential_ioclos(ud,status)
sequential_t *ud;
int status;
{
  int i;

  for (i=0; i<ud->n; i++) {
    fclose(ud->v[i].stream);
    if (status == 4) unlink(ud->v[i].path);
    free(ud->v[i].path);
    ud->v[i].path = NULL;
    }
  if (ud->verbose) {
    fprintf(stderr,"SEQ_IO: closed unit %d {\n",ud->unit);
    fprintf(stderr,"  incount = %u\n",ud->incount);
    fprintf(stderr,"  outcount = %u\n",ud->outcount);
    fprintf(stderr,"  }\n");
    }
  }

void
sequential_iordr(ud,buffer,first,length)
sequential_t *ud;
char *buffer;
int first, length;
{
  ud->incount += length;
  sequential_iordwrr("sequential_iordr",IOOP_READ,ud,buffer,first,length);
  }

void
sequential_iowrr(ud,buffer,first,length)
sequential_t *ud;
char *buffer;
int first, length;
{
  ud->outcount += length;
  sequential_iordwrr("sequential_iowrr",IOOP_WRITE,ud,buffer,first,length);
  }

void
sequential_iordwrr(caller,ioop,ud,buffer,first,length)
char *caller;
int ioop;
sequential_t *ud;
char *buffer;
int first, length;
{
  int i;
  long firstbyte, lastbyte;
  long firstblock, lastblock;
  long offset;
  long ncycles;
  long remainingbytes;
  long remainingseek;
  long fullvol;
  long offset1, offset2;
  long ibuf;
  int len;

  firstbyte = first;
  lastbyte = first + length - 1;

  ncycles = firstbyte/(ud->n*ud->blocksize);
  remainingseek = firstbyte - ncycles*ud->n*ud->blocksize;
  fullvol = remainingseek/ud->blocksize;

  offset2 = ncycles * ud->blocksize;
  offset1 = offset2 + ud->blocksize;

  /* Seek all volumes to the appropiate positions. */
  if ((ud->next != firstbyte)||(ud->last_ioop != ioop)) {
    for (i=0; i<ud->n; i++) {
      long offset;
      if (i < fullvol) offset = offset1;
      else if (i == fullvol) offset = offset2 + remainingseek%ud->blocksize;
      else offset = offset2;
#if DEBUG
      fprintf(stdout,"seeking volume %d to %ld\n",i,offset);
#endif
      if (fseek(ud->v[i].stream, offset, SEEK_SET)) {
        fprintf(stderr,"%s: fseek: offset = %ld, vol = %d\n",caller,offset,i);
        perror(caller);
        ioabort();
        }
      }
    if (length > 0) ud->last_ioop = ioop;
    }
  ud->next = lastbyte + 1;

  /* Do the io. */
  i = fullvol;
  len = ud->blocksize - remainingseek%ud->blocksize;
  remainingbytes = lastbyte - firstbyte + 1;
#if DEBUG
  fprintf(stdout,"%s: len=%d,remainingbytes=%ld,firstbyte=%ld,lastbyte=%ld,i=%d\n",
          caller,len,remainingbytes,firstbyte,lastbyte,i);
#endif
  ibuf = 0;
  while (remainingbytes > 0) {
    if (len > remainingbytes) len = remainingbytes;
#if DEBUG
    fprintf(stdout,"       len=%d,remainingbytes=%ld,i=%d\n",
          len,remainingbytes,i);
#endif
    if (ioop == IOOP_READ) {
      if (fread(&buffer[ibuf],len,1,ud->v[i].stream)!=1) {
        fprintf(stderr,"%s: len = %d, volume = %d\n",caller,len,i);
        if (ferror(ud->v[i].stream)) fread_error(caller);
        }
      }
    else if (ioop == IOOP_WRITE) {
      if (fwrite(&buffer[ibuf],len,1,ud->v[i].stream)!=1) {
        fprintf(stderr,"%s: len = %d, volume = %d\n",caller,len,i);
        if (ferror(ud->v[i].stream)) fwrite_error(caller);
        }
      }
    else {
      fprintf(stderr,"%s: illegal ioop = %d\n",caller,ioop);
      ioabort();
      }
    i++;
    if (i == ud->n) i=0;
    remainingbytes -= len;
    ibuf += len;
    len = ud->blocksize;
    }
  }
# include "includes.h"

/* diagonalizes tridiagonal matrix output by tred2 */
/* gives only eigenvalues if matz = 0, both eigenvalues and eigenvectors */
/* if matz = 1 */

int tqli(n,d,z,e,matz,toler)
   int n, matz;
   double *d, **z, *e;
   double toler;

   {
      register int k;
      int i,j,l,m,iter;
      double dd,g,r,s,c,p,f,b,h;
      double azi,azi2;

      f=0.0;
      if (n == 1) {
         d[0]=z[0][0];
         z[0][0] = 1.0;
         return;
         }

      for (i=1; i < n ; i++) {
         e[i-1] = e[i];
         }
      e[n-1] = 0.0;
      for (l=0; l < n; l++) {
         iter = 0;
L1:
         for (m=l; m < n-1;m++) {
            dd = fabs(d[m]) + fabs(d[m+1]);
#if 0
            if (fabs(e[m])+dd == dd) goto L2;
#else
            if (fabs(e[m]) < toler) goto L2;
#endif
            }
         m=n-1;
L2:
         if (m != l) {
            if (iter++ == 30) {
               fprintf (stderr,"tqli not converging\n");
               exit(30);
               }

            g = (d[l+1]-d[l])/(2.0*e[l]);
            r = sqrt(g*g + 1.0);
            g = d[m] - d[l] + e[l]/((g + DSIGN(r,g)));
            s=1.0;
            c=1.0;
            p=0.0;
            for (i=m-1; i >= l; i--) {
               f = s*e[i];
               b = c*e[i];
               if (fabs(f) >= fabs(g)) {
                  c = g/f;
                  r = sqrt(c*c + 1.0);
                  e[i+1] = f*r;
                  s=1.0/r;
                  c *= s;
                  }
               else {
                  s = f/g;
                  r = sqrt(s*s + 1.0);
                  e[i+1] = g*r;
                  c = 1.0/r;
                  s *= c;
                  }
               g = d[i+1] - p;
               r = (d[i]-g)*s + 2.0*c*b;
               p = s*r;
               d[i+1] = g+p;
               g = c*r-b;

               if (matz) {
                  double f2;
                  double *zi = z[i];
                  double *zi1 = z[i+1];
                  int odd = (n%2) ? 1 : 0;
                  for (k=n/2; k ; k--,zi+=2,zi1+=2) {
                     f = *zi1;
                     f2 = *(zi1+1);
                     azi = *zi;
                     azi2 = *(zi+1);
                     *zi1 = azi*s + c*f;
                     *zi = azi*c - s*f;
                     *(zi1+1) = azi2*s + c*f2;
                     *(zi+1) = azi2*c - s*f2;
                     }
                  if (odd) {
                     f = *zi1;
                     azi = *zi;
                     *zi1 = azi*s + c*f;
                     *zi = azi*c - s*f;
                     }
                  }
               }

            d[l] -= p;
            e[l] = g;
            e[m] = 0.0;
            goto L1;
            }
         }
   }
