| 1 | #include "sopnamsp.h"
 | 
|---|
| 2 | #include "machdefs.h"
 | 
|---|
| 3 | 
 | 
|---|
| 4 | #include <math.h>
 | 
|---|
| 5 | #include <iostream>
 | 
|---|
| 6 | 
 | 
|---|
| 7 | #include "srandgen.h"
 | 
|---|
| 8 | #include "tarrinit.h"
 | 
|---|
| 9 | #include "array.h"
 | 
|---|
| 10 | #include "timing.h"
 | 
|---|
| 11 | #include "intflapack.h"
 | 
|---|
| 12 | 
 | 
|---|
| 13 | 
 | 
|---|
| 14 | int lpk_linsolve_mtx(int n);                             // ErrorCode = 8
 | 
|---|
| 15 | int lpk_svd_mtx(int l, int c, int wsf, bool covu=true);  // ErrorCode = 16
 | 
|---|
| 16 | int lpk_leastsquare_mtx(int l, int c);                   // ErrorCode = 32   
 | 
|---|
| 17 | int lpk_inverse_mtx(int l);                              // ErrorCode = 64
 | 
|---|
| 18 | 
 | 
|---|
| 19 | static double TOLERANCE = 1.e-6;
 | 
|---|
| 20 | static int nprt = 100;
 | 
|---|
| 21 | static int prtlev = 1;
 | 
|---|
| 22 | 
 | 
|---|
| 23 | int main(int narg, char* arg[])
 | 
|---|
| 24 | {
 | 
|---|
| 25 | 
 | 
|---|
| 26 |   SophyaInit();
 | 
|---|
| 27 |   InitTim();   // Initializing the CPU timer
 | 
|---|
| 28 | 
 | 
|---|
| 29 | 
 | 
|---|
| 30 | 
 | 
|---|
| 31 |   if (narg < 2) {
 | 
|---|
| 32 |     cout << " lpk - LinAlg/LapackServer test \n" 
 | 
|---|
| 33 |          << " Usage: lpk select [sizeL,C=5,5] [prtlev=1] \n" 
 | 
|---|
| 34 |          << "             [nprtmax=100] [WorkSpaceSizeFactor=2] \n" 
 | 
|---|
| 35 |          << "   select= linsolve svd svds lss inverse / all= \n"
 | 
|---|
| 36 |          << "   linsolve:  lpk_linsolve_mtx() LapackServer::LinSolve with TMatrix<r_8> \n" 
 | 
|---|
| 37 |          << "   svd:  lpk_svd_mtx() LapackServer::SVD(a,s,u,vt) with TMatrix<r_8> \n" 
 | 
|---|
| 38 |          << "   svds:  lpk_svd_mtx() LapackServer::SVD(a,s); with TMatrix<r_8> \n"
 | 
|---|
| 39 |          << "   lss:  lpk_leastsquare_mtx() LapackServer::LeastSquareSolve() r_8 \n"
 | 
|---|
| 40 |          << "   inverse:  LapackServer::ComputeInverse() r_8 \n" << endl;
 | 
|---|
| 41 |     exit(0);
 | 
|---|
| 42 |   }
 | 
|---|
| 43 |   int l,c;
 | 
|---|
| 44 |   l = c = 5;
 | 
|---|
| 45 |   int wsf = 2;
 | 
|---|
| 46 |   string opt = arg[1];
 | 
|---|
| 47 |   if (narg > 2) sscanf(arg[2], "%d,%d", &l, &c); 
 | 
|---|
| 48 |   if (narg > 3) prtlev = atoi(arg[3]);
 | 
|---|
| 49 |   if (narg > 4) nprt = atoi(arg[4]);
 | 
|---|
| 50 |   if (narg > 5) wsf = atoi(arg[5]);
 | 
|---|
| 51 | 
 | 
|---|
| 52 |   cout << " lpk - LinAlg/LapackServer_Test sizeL,C=" << l << "," << c 
 | 
|---|
| 53 |        << " opt= " << opt << endl;
 | 
|---|
| 54 |   int rc = 0;
 | 
|---|
| 55 |   BaseArray::SetMaxPrint(nprt, prtlev);
 | 
|---|
| 56 |   try {
 | 
|---|
| 57 |     if (opt == "all") {
 | 
|---|
| 58 |       rc += lpk_linsolve_mtx(l);
 | 
|---|
| 59 |       rc += lpk_svd_mtx(l,c,wsf,true);
 | 
|---|
| 60 |       rc += lpk_leastsquare_mtx(l,c);
 | 
|---|
| 61 |       rc += lpk_inverse_mtx(l);
 | 
|---|
| 62 |     }
 | 
|---|
| 63 |     else if (opt == "linsolve") rc = lpk_linsolve_mtx(l);
 | 
|---|
| 64 |     else if (opt == "svd") rc = lpk_svd_mtx(l,c,wsf,true);
 | 
|---|
| 65 |     else if (opt == "svds") rc = lpk_svd_mtx(l,c,wsf,false);
 | 
|---|
| 66 |     else if (opt == "lss") rc = lpk_leastsquare_mtx(l,c);
 | 
|---|
| 67 |     else if (opt == "inverse") rc = lpk_inverse_mtx(l);
 | 
|---|
| 68 |     else { cout << " Unknown option " << opt << " ! " << endl; rc = 66; }
 | 
|---|
| 69 |   }
 | 
|---|
| 70 |   catch (PThrowable exc) {
 | 
|---|
| 71 |     cerr << " catched Exception (lpk.cc) " << exc.Msg() << endl;
 | 
|---|
| 72 |     rc = 77;
 | 
|---|
| 73 |   }  
 | 
|---|
| 74 |   catch (...) {
 | 
|---|
| 75 |     cerr << " catched unknown (...) exception (lpk.cc) " << endl; 
 | 
|---|
| 76 |     rc = 78; 
 | 
|---|
| 77 |   } 
 | 
|---|
| 78 |   
 | 
|---|
| 79 |   PrtTim(" End of lpk LinAlg/Lapack test ");
 | 
|---|
| 80 |   cout << " ---------------  END of Programme -------- (Rc= " 
 | 
|---|
| 81 |        << rc << ") --- " << endl;
 | 
|---|
| 82 |   return(rc);
 | 
|---|
| 83 | }
 | 
|---|
| 84 | 
 | 
|---|
| 85 | // -----------------------------------------------------------------------
 | 
|---|
| 86 | /* Nouvelle-Fonction */
 | 
|---|
| 87 | int lpk_linsolve_mtx(int n)
 | 
|---|
| 88 | {
 | 
|---|
| 89 |   int i,j;
 | 
|---|
| 90 |   BaseArray::SetDefaultMemoryMapping(BaseArray::FortranMemoryMapping);
 | 
|---|
| 91 |   cout << " lpk_linsolve_mtx() - Test of LapackServer::LinSolve()  " << endl;
 | 
|---|
| 92 |   Matrix a(n,n);
 | 
|---|
| 93 |   for(i=0; i<n; i++)
 | 
|---|
| 94 |     for(j=0; j<n; j++)  a(j,i) = GaussianRand(1.,0.);
 | 
|---|
| 95 |   
 | 
|---|
| 96 |   Vector x(n), b;
 | 
|---|
| 97 |   //  Matrix  x(n,1), b;
 | 
|---|
| 98 |   if (prtlev > 0) 
 | 
|---|
| 99 |     cout << " ------------ Vector X = \n " << x << "\n" << endl; 
 | 
|---|
| 100 |   for(i=0; i<n; i++) x(i) = GaussianRand(1.5,2.);
 | 
|---|
| 101 |   b = a*x;
 | 
|---|
| 102 | 
 | 
|---|
| 103 |   if (prtlev > 0) {
 | 
|---|
| 104 |     cout << " ---- lpk_tmtx() LapackServer::LinSolve Test Using TMatrix<r_8> ----- " << endl; 
 | 
|---|
| 105 |     cout << " ------------ Matrix A = \n " << a << "\n" << endl; 
 | 
|---|
| 106 |     cout << " ------------ Matrix X = \n " << x << "\n" << endl; 
 | 
|---|
| 107 |     cout << " ------------ Matrix B = \n " << b << "\n" << endl; 
 | 
|---|
| 108 |   }
 | 
|---|
| 109 |   cout << "\n   Calling LapackLinSolve(a,b) .... " << endl;
 | 
|---|
| 110 |   PrtTim(" Calling LapackLinSolve(a,b) ");
 | 
|---|
| 111 |   LapackLinSolve(a,b);
 | 
|---|
| 112 |   PrtTim(" End LapackLinSolve(a,b) ");
 | 
|---|
| 113 | 
 | 
|---|
| 114 |   if (prtlev > 0) 
 | 
|---|
| 115 |     cout << " ------------ Result B(=X ?) = \n " << b << "\n" << endl; 
 | 
|---|
| 116 |   Vector diff = b-x;
 | 
|---|
| 117 |   PrtTim(" End of Compute(diff)");
 | 
|---|
| 118 |   if (prtlev > 0) 
 | 
|---|
| 119 |     cout << " ------------ Vector diff B-X = \n " << diff << "\n" << endl; 
 | 
|---|
| 120 |   double min,max;
 | 
|---|
| 121 |   diff.MinMax(min, max);
 | 
|---|
| 122 |   cout << " Min/Max difference Vector (?=0) , Min= " << min 
 | 
|---|
| 123 |        << " Max= " << max << endl;
 | 
|---|
| 124 |   if ((fabs(min) > TOLERANCE) || (fabs(max) > TOLERANCE)) {
 | 
|---|
| 125 |     cout << " !!! Difference exceeding tolerance (=" << TOLERANCE << ") !!!" 
 | 
|---|
| 126 |          << endl;
 | 
|---|
| 127 |     return(8);
 | 
|---|
| 128 |   } 
 | 
|---|
| 129 |   return(0);
 | 
|---|
| 130 | 
 | 
|---|
| 131 | }
 | 
|---|
| 132 | 
 | 
|---|
| 133 | // -----------------------------------------------------------------------
 | 
|---|
| 134 | /* Nouvelle-Fonction */
 | 
|---|
| 135 | int lpk_svd_mtx(int m, int n, int wsf, bool covu)
 | 
|---|
| 136 | {
 | 
|---|
| 137 |   BaseArray::SetDefaultMemoryMapping(BaseArray::FortranMemoryMapping);
 | 
|---|
| 138 |   cout << " lpk_svd_mtx() - Test of LapackServer::SVD " << endl;
 | 
|---|
| 139 |   
 | 
|---|
| 140 |   Matrix a(m , n), aa;
 | 
|---|
| 141 |   a = RandomSequence(RandomSequence::Gaussian, 0., 4.);
 | 
|---|
| 142 |   aa = a;
 | 
|---|
| 143 |   Vector s;
 | 
|---|
| 144 |   Matrix u, vt;
 | 
|---|
| 145 |   cout << " ---- lpk_svd_tmtx() LapackServer::SVD Test Using TMatrix<r_8> ---- " << endl; 
 | 
|---|
| 146 |   if (prtlev > 0) 
 | 
|---|
| 147 |     cout << " ------------ Matrix A = \n " << a << "\n" << endl; 
 | 
|---|
| 148 | 
 | 
|---|
| 149 |   cout << "\n   Calling LapackSVD(a,s,u,vt) .... " << endl;
 | 
|---|
| 150 |   PrtTim(" Calling LapackSVD() ");
 | 
|---|
| 151 |   LapackServer<r_8> lpks;
 | 
|---|
| 152 |   lpks.SetWorkSpaceSizeFactor(wsf);
 | 
|---|
| 153 |   if (covu) lpks.SVD(aa, s, u, vt);
 | 
|---|
| 154 |   else lpks.SVD(aa, s);
 | 
|---|
| 155 |   PrtTim(" End LapackSVD() ");
 | 
|---|
| 156 | 
 | 
|---|
| 157 |   if (prtlev > 0) 
 | 
|---|
| 158 |     cout << " ------------ Result S  = \n " << s << "\n" << endl; 
 | 
|---|
| 159 |   if (!covu) return(0);
 | 
|---|
| 160 |   if (prtlev > 0) {
 | 
|---|
| 161 |     cout << " ------------ Result U  = \n " << u << "\n" << endl; 
 | 
|---|
| 162 |     cout << " ------------ Result VT = \n " << vt << "\n" << endl; 
 | 
|---|
| 163 |   }
 | 
|---|
| 164 |   Matrix sm(m,n);
 | 
|---|
| 165 |   int minmn = (m<n) ? m : n ;
 | 
|---|
| 166 |   for(int k=0; k< minmn ; k++) sm(k,k) = s(k);
 | 
|---|
| 167 |   Matrix diff = u*(sm*vt) - a;
 | 
|---|
| 168 |   PrtTim(" End of Compute(diff)");
 | 
|---|
| 169 |   if (prtlev > 0) 
 | 
|---|
| 170 |     cout << " ------------ Matrix diff U*S*Vt - A = \n " << diff << "\n" << endl; 
 | 
|---|
| 171 |   double min,max;
 | 
|---|
| 172 |   diff.MinMax(min, max);
 | 
|---|
| 173 |   cout << " Min/Max difference Matrix (?=0) , Min= " << min 
 | 
|---|
| 174 |        << " Max= " << max << endl;
 | 
|---|
| 175 |   if ((fabs(min) > TOLERANCE) || (fabs(max) > TOLERANCE)) {
 | 
|---|
| 176 |     cout << " !!! Difference exceeding tolerance (=" << TOLERANCE << ") !!!" 
 | 
|---|
| 177 |          << endl;
 | 
|---|
| 178 |     return(16);
 | 
|---|
| 179 |   } 
 | 
|---|
| 180 |   return(0);
 | 
|---|
| 181 | 
 | 
|---|
| 182 | }
 | 
|---|
| 183 | 
 | 
|---|
| 184 | // -----------------------------------------------------------------------
 | 
|---|
| 185 | /* Nouvelle-Fonction */
 | 
|---|
| 186 | int lpk_leastsquare_mtx(int m, int n)
 | 
|---|
| 187 | {
 | 
|---|
| 188 |   BaseArray::SetDefaultMemoryMapping(BaseArray::FortranMemoryMapping);
 | 
|---|
| 189 |   cout << " lpk_leastsquare_mtx() - Test of LapackLeastSquareSolve " << endl;
 | 
|---|
| 190 |   
 | 
|---|
| 191 |   Matrix a(m , n), aa;
 | 
|---|
| 192 |   a = RandomSequence(RandomSequence::Gaussian, 0., 4.);
 | 
|---|
| 193 |   aa = a;
 | 
|---|
| 194 |   Vector x(n),noise(m),b,bx;
 | 
|---|
| 195 |   x = RandomSequence(RandomSequence::Gaussian, 2., 1.);
 | 
|---|
| 196 |   double signoise = 0.1;
 | 
|---|
| 197 |   noise = RandomSequence(RandomSequence::Gaussian, 0., 0.1);
 | 
|---|
| 198 |   b = a*x;
 | 
|---|
| 199 |   bx = b+noise;
 | 
|---|
| 200 |  
 | 
|---|
| 201 |   cout << " ---- lpk_leastsquare_tmtx() LapackLeastSquareSolve<r_8> ---- " << endl; 
 | 
|---|
| 202 |   if (prtlev > 0) {
 | 
|---|
| 203 |     cout << " ------------ Matrix A = \n " << a << "\n" << endl; 
 | 
|---|
| 204 |     cout << " ------------ Vector B = \n " << bx << "\n" << endl; 
 | 
|---|
| 205 |     cout << " ------------ Vector X = \n " << x << "\n" << endl; 
 | 
|---|
| 206 |   }
 | 
|---|
| 207 |   cout << "\n   Calling  LapackLeastSquareSolve(a,bx) .... " << endl;
 | 
|---|
| 208 |   PrtTim(" Calling LapackLeastSquareSolve() ");
 | 
|---|
| 209 |   LapackLeastSquareSolve(aa, bx);
 | 
|---|
| 210 |   PrtTim(" End LapackLeastSquareSolve() ");
 | 
|---|
| 211 |   bx.Share(bx(Range(0,0,n)));
 | 
|---|
| 212 |   if (prtlev > 0) {
 | 
|---|
| 213 |     cout << " ------------ Result X  = \n " << bx << "\n" << endl; 
 | 
|---|
| 214 |     cout << " ------------ X-X_Real  = \n " << bx-x << "\n" << endl; 
 | 
|---|
| 215 |   }
 | 
|---|
| 216 |   Vector diff = b-a*bx;
 | 
|---|
| 217 |   PrtTim(" End of Compute(diff)");
 | 
|---|
| 218 |   if (prtlev > 0) 
 | 
|---|
| 219 |     cout << " ------------ Matrix diff b-a*x = \n " << diff << "\n" << endl; 
 | 
|---|
| 220 |   double mean,sigma;
 | 
|---|
| 221 |   MeanSigma(diff, mean, sigma);
 | 
|---|
| 222 |   cout << " MeanSigma(diff) , Mean= " << mean << " Sigma=" << sigma
 | 
|---|
| 223 |        << " SigNoise= " << signoise << endl;
 | 
|---|
| 224 |   if ((fabs(mean) > signoise) || (fabs(sigma-signoise) > signoise)) {
 | 
|---|
| 225 |     cout << " !!! Difference exceeding tolerance (=" << TOLERANCE << ") !!!" 
 | 
|---|
| 226 |          << endl;
 | 
|---|
| 227 |     return 32;
 | 
|---|
| 228 |   } 
 | 
|---|
| 229 |   return 0;
 | 
|---|
| 230 | 
 | 
|---|
| 231 | }
 | 
|---|
| 232 | // -----------------------------------------------------------------------
 | 
|---|
| 233 | /* Nouvelle-Fonction */
 | 
|---|
| 234 | int lpk_inverse_mtx(int m)
 | 
|---|
| 235 | {
 | 
|---|
| 236 |   BaseArray::SetDefaultMemoryMapping(BaseArray::FortranMemoryMapping);
 | 
|---|
| 237 |   cout << " lpk_inverse_mtx() - Test of LapackComputeInverse<r_8> " << endl;
 | 
|---|
| 238 |   
 | 
|---|
| 239 |   Matrix a(m , m), aa, ainv, idmx(m,m), mxprod, diff;
 | 
|---|
| 240 |   a = RandomSequence(RandomSequence::Gaussian, 0., 4.);
 | 
|---|
| 241 |   aa = a;  // We make a copy of a, as it is modified by LapackServer
 | 
|---|
| 242 |   PrtTim(" End of a_inint");
 | 
|---|
| 243 | 
 | 
|---|
| 244 |   cout << "\n   Calling  LapackInverse() .... " << endl;
 | 
|---|
| 245 |   ainv = LapackInverse(aa);
 | 
|---|
| 246 |   PrtTim(" End of LapackInverse(a)");
 | 
|---|
| 247 |   mxprod = a*ainv;
 | 
|---|
| 248 |   PrtTim(" End of mxprod = a*ainv");
 | 
|---|
| 249 |   idmx = IdentityMatrix();
 | 
|---|
| 250 |   PrtTim(" End of idmx = IdentityMatrix()");
 | 
|---|
| 251 |   diff = mxprod-idmx;
 | 
|---|
| 252 |   PrtTim(" End of Compute(diff)");
 | 
|---|
| 253 | 
 | 
|---|
| 254 |   if (prtlev > 0) {
 | 
|---|
| 255 |     cout << " ------------ Matrix A = \n " << a << "\n" << endl; 
 | 
|---|
| 256 |     cout << " ------------ Matrix Inverse(A) = \n " << ainv << "\n" << endl; 
 | 
|---|
| 257 |     cout << " ------------ Matrix mxprod = A*Inverse(A) = \n " << mxprod << "\n" << endl; 
 | 
|---|
| 258 |   }
 | 
|---|
| 259 |   double min,max;
 | 
|---|
| 260 |   diff.MinMax(min, max);
 | 
|---|
| 261 |   PrtTim(" End of diffCheck");
 | 
|---|
| 262 |   cout << " Min/Max difference Matrix (?=0) , Min= " << min 
 | 
|---|
| 263 |        << " Max= " << max << endl;
 | 
|---|
| 264 |   if ((fabs(min) > TOLERANCE) || (fabs(max) > TOLERANCE)) {
 | 
|---|
| 265 |     cout << " !!! Difference exceeding tolerance (=" << TOLERANCE << ") !!!" 
 | 
|---|
| 266 |          << endl;
 | 
|---|
| 267 |     return 64;
 | 
|---|
| 268 |   }
 | 
|---|
| 269 |   return 0;
 | 
|---|
| 270 | 
 | 
|---|
| 271 | }
 | 
|---|
| 272 | 
 | 
|---|