src/gmxlib/gmx_lapack/dlacpy.c

   1 #include<ctype.h>
   2 #include "gmx_lapack.h"
   3
   4 /* LAPACK */
   5 void
   6 F77_FUNC(dlacpy,DLACPY)(const char *uplo,
   7         int *m,
   8         int *n,
   9         double *a,
  10         int *lda,
  11         double *b,
  12         int *ldb)
  13 {
  14   int i,j,minjm;
  15   const char ch=toupper(*uplo);
  16
  17   if(ch=='U') {
  18     for(j=0;j<*n;j++) {
  19       minjm = (j < (*m-1)) ? j : (*m-1);
  20       for(i=0;i<=minjm;i++)
  21         b[j*(*ldb)+i] = a[j*(*lda)+i];
  22     }
  23   } else if(ch=='L') {
  24     for(j=0;j<*n;j++) {
  25       for(i=j;i<*m;i++)
  26         b[j*(*ldb)+i] = a[j*(*lda)+i];
  27     }
  28   } else {
  29     for(j=0;j<*n;j++) {
  30       for(i=0;i<*m;i++)
  31         b[j*(*ldb)+i] = a[j*(*lda)+i];
  32     }
  33   }
  34 }