src/gmxlib/gmx_lapack/dlange.c

   1 #include<math.h>
   2 #include<ctype.h>
   3 #include "gmx_lapack.h"
   4
   5
   6 double
   7 F77_FUNC(dlange,DLANGE)(const char *norm,
   8         int *m,
   9         int *n,
  10         double *a,
  11         int *lda,
  12         double *work)
  13 {
  14   const char ch=toupper(*norm);
  15   double dtemp,sum,max,val,scale;
  16   int i,j;
  17
  18   switch(ch) {
  19   case 'M':
  20     max = 0.0;
  21     for(j=0;j<*n;j++)
  22       for(i=0;i<*m;i++) {
  23         dtemp = fabs(a[j*(*lda)+i]);
  24         if(dtemp>max)
  25           max = dtemp;
  26       }
  27     val = max;
  28     break;
  29
  30   case 'O':
  31   case '1':
  32     max = 0.0;
  33     for(j=0;j<*n;j++) {
  34       sum = 0.0;
  35       for(i=0;i<*m;i++)
  36         sum += fabs(a[j*(*lda)+i]);
  37       if(sum>max)
  38         max = sum;
  39     }
  40     val = max;
  41     break;
  42
  43   case 'I':
  44     for(i=0;i<*m;i++)
  45       work[i] = 0.0;
  46     for(j=0;j<*n;j++)
  47       for(i=0;i<*m;i++)
  48         work[i] += fabs(a[j*(*lda)+i]);
  49     max = 0;
  50     for(i=0;i<*m;i++)
  51       if(work[i]>max)
  52         max=work[i];
  53     val = max;
  54     break;
  55
  56   case 'F':
  57   case 'E':
  58     scale = 0.0;
  59     sum   = 1.0;
  60     i = 1;
  61     for(j=0;j<*n;j++)
  62       F77_FUNC(dlassq,DLASSQ)(m,&(a[j*(*lda)+0]),&i,&scale,&sum);
  63     val = scale*sqrt(sum);
  64     break;
  65
  66   default:
  67     val = 0.0;
  68     break;
  69   }
  70   return val;
  71 }