| [778] | 1 | #include "machdefs.h"
 | 
|---|
 | 2 | 
 | 
|---|
 | 3 | #include <math.h>
 | 
|---|
 | 4 | #include <iostream.h>
 | 
|---|
 | 5 | 
 | 
|---|
| [857] | 6 | #include "srandgen.h"
 | 
|---|
| [778] | 7 | #include "tarrinit.h"
 | 
|---|
| [857] | 8 | #include "array.h"
 | 
|---|
| [778] | 9 | #include "timing.h"
 | 
|---|
 | 10 | #include "intflapack.h"
 | 
|---|
 | 11 | 
 | 
|---|
 | 12 | 
 | 
|---|
| [1248] | 13 | int lpk_tarr(int n);
 | 
|---|
 | 14 | int lpk_tmtx(int n);
 | 
|---|
| [812] | 15 | 
 | 
|---|
| [1248] | 16 | static double TOLERANCE = 1.e-6;
 | 
|---|
| [1100] | 17 | 
 | 
|---|
| [778] | 18 | int main(int narg, char* arg[])
 | 
|---|
 | 19 | {
 | 
|---|
 | 20 | 
 | 
|---|
 | 21 |   SophyaInit();
 | 
|---|
 | 22 |   InitTim();   // Initializing the CPU timer
 | 
|---|
 | 23 | 
 | 
|---|
 | 24 | 
 | 
|---|
| [812] | 25 | 
 | 
|---|
 | 26 |   if (narg < 2) {
 | 
|---|
 | 27 |     cout << " lpk - LinAlg/LapackServer test - Usage lpk t/s [size=5] [prtlev=0] [nprtmax=100]\n" 
 | 
|---|
 | 28 |          << " t:  lpk_tarr() rztest_lapack with TArray<r_4> \n" 
 | 
|---|
 | 29 |          << " s:  lpk_tmtx() LapackServer with TMatrix<r_8> \n" << endl;
 | 
|---|
 | 30 |     exit(0);
 | 
|---|
 | 31 |   }
 | 
|---|
| [778] | 32 |   int n = 5;
 | 
|---|
| [812] | 33 |   int opt = 's';
 | 
|---|
 | 34 |   opt = *(arg[1]);
 | 
|---|
 | 35 |   if (narg > 2) n = atoi(arg[2]);
 | 
|---|
 | 36 |   int nprt = 100;
 | 
|---|
 | 37 |   int prtlev = 1;
 | 
|---|
 | 38 |   if (narg > 3) prtlev = atoi(arg[3]);
 | 
|---|
 | 39 |   if (narg > 4) nprt = atoi(arg[4]);
 | 
|---|
 | 40 | 
 | 
|---|
| [1248] | 41 |   int rc = 0;
 | 
|---|
| [812] | 42 |   BaseArray::SetMaxPrint(nprt, prtlev);
 | 
|---|
 | 43 |   try {
 | 
|---|
| [1248] | 44 |     if (opt == 's') rc = lpk_tmtx(n);
 | 
|---|
 | 45 |     else rc = lpk_tarr(n);
 | 
|---|
| [812] | 46 |   }
 | 
|---|
 | 47 |   catch (PThrowable exc) {
 | 
|---|
 | 48 |     cerr << " catched Exception (lpk.cc) " << exc.Msg() << endl;
 | 
|---|
| [1248] | 49 |     rc = 77;
 | 
|---|
| [812] | 50 |   }  
 | 
|---|
 | 51 |   catch (...) {
 | 
|---|
 | 52 |     cerr << " catched unknown (...) exception (lpk.cc) " << endl; 
 | 
|---|
| [1248] | 53 |     rc = 78; 
 | 
|---|
| [812] | 54 |   } 
 | 
|---|
 | 55 |   
 | 
|---|
 | 56 |   PrtTim(" End of lpk LinAlg/Lapack test ");
 | 
|---|
 | 57 |   cout << " ---------------  END of Programme -------------- " << endl;
 | 
|---|
| [1248] | 58 |   return(rc);
 | 
|---|
| [812] | 59 | }
 | 
|---|
 | 60 | 
 | 
|---|
 | 61 | 
 | 
|---|
| [1248] | 62 | int lpk_tmtx(int n)
 | 
|---|
| [812] | 63 | {
 | 
|---|
| [778] | 64 |   int i,j,k;
 | 
|---|
| [812] | 65 |   BaseArray::SetDefaultMemoryMapping(BaseArray::FortranMemoryMapping);
 | 
|---|
 | 66 |   Matrix a(n,n);
 | 
|---|
 | 67 |   for(i=0; i<n; i++)
 | 
|---|
 | 68 |     for(j=0; j<n; j++)  a(j,i) = GauRnd(0., 1.);
 | 
|---|
 | 69 |   cout << " ------------ Matrix A = \n " << a << "\n" << endl; 
 | 
|---|
 | 70 |   
 | 
|---|
 | 71 |   Vector x(n), b;
 | 
|---|
 | 72 |   //  Matrix  x(n,1), b;
 | 
|---|
 | 73 |   cout << " ------------ Vector X = \n " << x << "\n" << endl; 
 | 
|---|
 | 74 |   for(i=0; i<n; i++) x(i) = GauRnd(2., 1.5);
 | 
|---|
 | 75 |   b = a*x;
 | 
|---|
| [778] | 76 | 
 | 
|---|
| [812] | 77 |   //  cout << ":::::::: rztest_lapack - Size=" << n << "  ::::::::: " << endl;
 | 
|---|
 | 78 |   cout << " ------- lpk_tmtx() LapackServerTest Using TMatrix<r_8> -------- " << endl; 
 | 
|---|
 | 79 |   cout << " ------------ Matrix A = \n " << a << "\n" << endl; 
 | 
|---|
 | 80 |   cout << " ------------ Matrix X = \n " << x << "\n" << endl; 
 | 
|---|
 | 81 |   cout << " ------------ Matrix B = \n " << b << "\n" << endl; 
 | 
|---|
 | 82 | 
 | 
|---|
 | 83 |   cout << "\n   Calling LapackLinSolve(a,b) .... " << endl;
 | 
|---|
| [1100] | 84 |   PrtTim(" Calling LapackLinSolve(a,b) ");
 | 
|---|
| [812] | 85 |   LapackLinSolve(a,b);
 | 
|---|
| [1100] | 86 |   PrtTim(" End LapackLinSolve(a,b) ");
 | 
|---|
| [812] | 87 | 
 | 
|---|
 | 88 |   cout << " ------------ Result B(=X ?) = \n " << b << "\n" << endl; 
 | 
|---|
 | 89 |   Vector diff = b-x;
 | 
|---|
 | 90 |   cout << " ------------ Vector diff B-X = \n " << diff << "\n" << endl; 
 | 
|---|
| [1248] | 91 |   double min,max;
 | 
|---|
 | 92 |   diff.MinMax(min, max);
 | 
|---|
 | 93 |   cout << " Min/Max difference Vector (?=0) , Min= " << min 
 | 
|---|
 | 94 |        << " Max= " << max << endl;
 | 
|---|
 | 95 |   if ((fabs(min) > TOLERANCE) || (fabs(max) > TOLERANCE)) {
 | 
|---|
 | 96 |     cout << " !!! Difference exceeding tolerance (=" << TOLERANCE << ") !!!" 
 | 
|---|
 | 97 |          << endl;
 | 
|---|
 | 98 |     return(99);
 | 
|---|
 | 99 |   } 
 | 
|---|
 | 100 |   return(0);
 | 
|---|
| [812] | 101 | 
 | 
|---|
 | 102 | }
 | 
|---|
 | 103 | 
 | 
|---|
| [1248] | 104 | int  lpk_tarr(int n)
 | 
|---|
| [812] | 105 | {
 | 
|---|
 | 106 |   int i,j,k;
 | 
|---|
| [778] | 107 |   TArray<r_4> a(n,n);
 | 
|---|
 | 108 |   for(i=0; i<n; i++)
 | 
|---|
 | 109 |     for(j=0; j<n; j++)  a(i,j,0) = GauRnd(0., 1.);
 | 
|---|
 | 110 |   
 | 
|---|
| [789] | 111 |   TArray<r_4> x(n,1), b(n,1);
 | 
|---|
| [778] | 112 |   r_4 sum ;
 | 
|---|
| [789] | 113 |   for(i=0; i<n; i++) x(i,0,0) = GauRnd(2., 1.5);
 | 
|---|
| [778] | 114 |   for(i=0; i<n; i++) {
 | 
|---|
 | 115 |     sum = 0.;
 | 
|---|
| [789] | 116 |     for(j=0; j<n; j++) sum +=  a(i,j,0)*x(j,0,0);
 | 
|---|
 | 117 |     b(i,0,0) = sum;
 | 
|---|
| [778] | 118 |   }
 | 
|---|
 | 119 | 
 | 
|---|
| [812] | 120 |   //  cout << ":::::::: rztest_lapack - Size=" << n << "  ::::::::: " << endl;
 | 
|---|
 | 121 |   cout << " ------- lpk_tarr() LapaackTest Using TArray<r_4> -------- " << endl; 
 | 
|---|
| [807] | 122 |   cout << " ------------ Array A = \n " << a << "\n" << endl; 
 | 
|---|
 | 123 |   cout << " ------------ Array X = \n " << x << "\n" << endl; 
 | 
|---|
 | 124 |   cout << " ------------ Array B = \n " << b << "\n" << endl; 
 | 
|---|
| [778] | 125 | 
 | 
|---|
 | 126 |   cout << "\n     Calling rztest_lapack ... " << endl;
 | 
|---|
 | 127 | 
 | 
|---|
 | 128 |   rztest_lapack(a, b);
 | 
|---|
 | 129 | 
 | 
|---|
 | 130 |   cout << " ------------ Result B(=X ?) = \n " << b << "\n" << endl; 
 | 
|---|
| [1248] | 131 |   return(0);
 | 
|---|
| [778] | 132 | }
 | 
|---|