| 1 | // | 
|---|
| 2 | // localsymm.cc | 
|---|
| 3 | // | 
|---|
| 4 | // Copyright (C) 1996 Limit Point Systems, Inc. | 
|---|
| 5 | // | 
|---|
| 6 | // Author: Curtis Janssen <cljanss@limitpt.com> | 
|---|
| 7 | // Maintainer: LPS | 
|---|
| 8 | // | 
|---|
| 9 | // This file is part of the SC Toolkit. | 
|---|
| 10 | // | 
|---|
| 11 | // The SC Toolkit is free software; you can redistribute it and/or modify | 
|---|
| 12 | // it under the terms of the GNU Library General Public License as published by | 
|---|
| 13 | // the Free Software Foundation; either version 2, or (at your option) | 
|---|
| 14 | // any later version. | 
|---|
| 15 | // | 
|---|
| 16 | // The SC Toolkit is distributed in the hope that it will be useful, | 
|---|
| 17 | // but WITHOUT ANY WARRANTY; without even the implied warranty of | 
|---|
| 18 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the | 
|---|
| 19 | // GNU Library General Public License for more details. | 
|---|
| 20 | // | 
|---|
| 21 | // You should have received a copy of the GNU Library General Public License | 
|---|
| 22 | // along with the SC Toolkit; see the file COPYING.LIB.  If not, write to | 
|---|
| 23 | // the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. | 
|---|
| 24 | // | 
|---|
| 25 | // The U.S. Government is granted a limited license as per AL 91-7. | 
|---|
| 26 | // | 
|---|
| 27 |  | 
|---|
| 28 | #include <math.h> | 
|---|
| 29 |  | 
|---|
| 30 | #include <util/misc/formio.h> | 
|---|
| 31 | #include <util/keyval/keyval.h> | 
|---|
| 32 | #include <math/scmat/local.h> | 
|---|
| 33 | #include <math/scmat/cmatrix.h> | 
|---|
| 34 | #include <math/scmat/elemop.h> | 
|---|
| 35 | #include <math/scmat/offset.h> | 
|---|
| 36 |  | 
|---|
| 37 | #include <math/scmat/mops.h> | 
|---|
| 38 |  | 
|---|
| 39 | using namespace std; | 
|---|
| 40 | using namespace sc; | 
|---|
| 41 |  | 
|---|
| 42 | ///////////////////////////////////////////////////////////////////////////// | 
|---|
| 43 | // LocalSymmSCMatrix member functions | 
|---|
| 44 |  | 
|---|
| 45 | static ClassDesc LocalSymmSCMatrix_cd( | 
|---|
| 46 | typeid(LocalSymmSCMatrix),"LocalSymmSCMatrix",1,"public SymmSCMatrix", | 
|---|
| 47 | 0, 0, 0); | 
|---|
| 48 |  | 
|---|
| 49 | static double ** | 
|---|
| 50 | init_symm_rows(double *data, int n) | 
|---|
| 51 | { | 
|---|
| 52 | double** r = new double*[n]; | 
|---|
| 53 | for (int i=0; i<n; i++) r[i] = &data[(i*(i+1))/2]; | 
|---|
| 54 | return r; | 
|---|
| 55 | } | 
|---|
| 56 |  | 
|---|
| 57 | LocalSymmSCMatrix::LocalSymmSCMatrix(const RefSCDimension&a, | 
|---|
| 58 | LocalSCMatrixKit *kit): | 
|---|
| 59 | SymmSCMatrix(a,kit), | 
|---|
| 60 | rows(0) | 
|---|
| 61 | { | 
|---|
| 62 | resize(a->n()); | 
|---|
| 63 | } | 
|---|
| 64 |  | 
|---|
| 65 | LocalSymmSCMatrix::~LocalSymmSCMatrix() | 
|---|
| 66 | { | 
|---|
| 67 | if (rows) delete[] rows; | 
|---|
| 68 | } | 
|---|
| 69 |  | 
|---|
| 70 | int | 
|---|
| 71 | LocalSymmSCMatrix::compute_offset(int i,int j) const | 
|---|
| 72 | { | 
|---|
| 73 | if (i<0 || j<0 || i>=d->n() || j>=d->n()) { | 
|---|
| 74 | ExEnv::errn() << indent << "LocalSymmSCMatrix: index out of bounds\n"; | 
|---|
| 75 | abort(); | 
|---|
| 76 | } | 
|---|
| 77 | return ij_offset(i,j); | 
|---|
| 78 | } | 
|---|
| 79 |  | 
|---|
| 80 | void | 
|---|
| 81 | LocalSymmSCMatrix::resize(int n) | 
|---|
| 82 | { | 
|---|
| 83 | block = new SCMatrixLTriBlock(0,n); | 
|---|
| 84 | rows = init_symm_rows(block->data,n); | 
|---|
| 85 | } | 
|---|
| 86 |  | 
|---|
| 87 | double * | 
|---|
| 88 | LocalSymmSCMatrix::get_data() | 
|---|
| 89 | { | 
|---|
| 90 | return block->data; | 
|---|
| 91 | } | 
|---|
| 92 |  | 
|---|
| 93 | double ** | 
|---|
| 94 | LocalSymmSCMatrix::get_rows() | 
|---|
| 95 | { | 
|---|
| 96 | return rows; | 
|---|
| 97 | } | 
|---|
| 98 |  | 
|---|
| 99 | double | 
|---|
| 100 | LocalSymmSCMatrix::get_element(int i,int j) const | 
|---|
| 101 | { | 
|---|
| 102 | return block->data[compute_offset(i,j)]; | 
|---|
| 103 | } | 
|---|
| 104 |  | 
|---|
| 105 | void | 
|---|
| 106 | LocalSymmSCMatrix::set_element(int i,int j,double a) | 
|---|
| 107 | { | 
|---|
| 108 | block->data[compute_offset(i,j)] = a; | 
|---|
| 109 | } | 
|---|
| 110 |  | 
|---|
| 111 | void | 
|---|
| 112 | LocalSymmSCMatrix::accumulate_element(int i,int j,double a) | 
|---|
| 113 | { | 
|---|
| 114 | block->data[compute_offset(i,j)] += a; | 
|---|
| 115 | } | 
|---|
| 116 |  | 
|---|
| 117 | SCMatrix * | 
|---|
| 118 | LocalSymmSCMatrix::get_subblock(int br, int er, int bc, int ec) | 
|---|
| 119 | { | 
|---|
| 120 | int nsrow = er-br+1; | 
|---|
| 121 | int nscol = ec-bc+1; | 
|---|
| 122 |  | 
|---|
| 123 | if (nsrow > n() || nscol > n()) { | 
|---|
| 124 | ExEnv::errn() << indent | 
|---|
| 125 | << "LocalSymmSCMatrix::get_subblock: trying to get too big a " | 
|---|
| 126 | << "subblock (" << nsrow << "," << nscol | 
|---|
| 127 | << ") from (" << n() << "," << n() << ")\n"; | 
|---|
| 128 | abort(); | 
|---|
| 129 | } | 
|---|
| 130 |  | 
|---|
| 131 | RefSCDimension dnrow = (nsrow==n()) ? dim().pointer():new SCDimension(nsrow); | 
|---|
| 132 | RefSCDimension dncol = (nscol==n()) ? dim().pointer():new SCDimension(nscol); | 
|---|
| 133 |  | 
|---|
| 134 | SCMatrix * sb = kit()->matrix(dnrow,dncol); | 
|---|
| 135 | sb->assign(0.0); | 
|---|
| 136 |  | 
|---|
| 137 | LocalSCMatrix *lsb = | 
|---|
| 138 | require_dynamic_cast<LocalSCMatrix*>(sb, "LocalSymmSCMatrix::get_subblock"); | 
|---|
| 139 |  | 
|---|
| 140 | for (int i=0; i < nsrow; i++) | 
|---|
| 141 | for (int j=0; j < nscol; j++) | 
|---|
| 142 | lsb->rows[i][j] = get_element(i+br,j+bc); | 
|---|
| 143 |  | 
|---|
| 144 | return sb; | 
|---|
| 145 | } | 
|---|
| 146 |  | 
|---|
| 147 | SymmSCMatrix * | 
|---|
| 148 | LocalSymmSCMatrix::get_subblock(int br, int er) | 
|---|
| 149 | { | 
|---|
| 150 | int nsrow = er-br+1; | 
|---|
| 151 |  | 
|---|
| 152 | if (nsrow > n()) { | 
|---|
| 153 | ExEnv::errn() << indent | 
|---|
| 154 | << "LocalSymmSCMatrix::get_subblock: trying to get too big a " | 
|---|
| 155 | << "subblock (" << nsrow << "," << nsrow | 
|---|
| 156 | << ") from (" << n() << "," << n() << ")\n"; | 
|---|
| 157 | abort(); | 
|---|
| 158 | } | 
|---|
| 159 |  | 
|---|
| 160 | RefSCDimension dnrow = new SCDimension(nsrow); | 
|---|
| 161 |  | 
|---|
| 162 | SymmSCMatrix * sb = kit()->symmmatrix(dnrow); | 
|---|
| 163 | sb->assign(0.0); | 
|---|
| 164 |  | 
|---|
| 165 | LocalSymmSCMatrix *lsb = | 
|---|
| 166 | require_dynamic_cast<LocalSymmSCMatrix*>(sb, "LocalSymmSCMatrix::get_subblock"); | 
|---|
| 167 |  | 
|---|
| 168 | for (int i=0; i < nsrow; i++) | 
|---|
| 169 | for (int j=0; j <= i; j++) | 
|---|
| 170 | lsb->rows[i][j] = get_element(i+br,j+br); | 
|---|
| 171 |  | 
|---|
| 172 | return sb; | 
|---|
| 173 | } | 
|---|
| 174 |  | 
|---|
| 175 | void | 
|---|
| 176 | LocalSymmSCMatrix::assign_subblock(SCMatrix*sb, int br, int er, int bc, int ec) | 
|---|
| 177 | { | 
|---|
| 178 | LocalSCMatrix *lsb = | 
|---|
| 179 | require_dynamic_cast<LocalSCMatrix*>(sb, "LocalSCMatrix::assign_subblock"); | 
|---|
| 180 |  | 
|---|
| 181 | int nsrow = er-br+1; | 
|---|
| 182 | int nscol = ec-bc+1; | 
|---|
| 183 |  | 
|---|
| 184 | if (nsrow > n() || nscol > n()) { | 
|---|
| 185 | ExEnv::errn() << indent | 
|---|
| 186 | << "LocalSymmSCMatrix::assign_subblock: trying to assign too big a " | 
|---|
| 187 | << "subblock (" << nsrow << "," << nscol | 
|---|
| 188 | << ") from (" << n() << "," << n() << ")\n"; | 
|---|
| 189 | abort(); | 
|---|
| 190 | } | 
|---|
| 191 |  | 
|---|
| 192 | for (int i=0; i < nsrow; i++) | 
|---|
| 193 | for (int j=0; j < nscol; j++) | 
|---|
| 194 | set_element(i+br,j+bc,lsb->rows[i][j]); | 
|---|
| 195 | } | 
|---|
| 196 |  | 
|---|
| 197 | void | 
|---|
| 198 | LocalSymmSCMatrix::assign_subblock(SymmSCMatrix*sb, int br, int er) | 
|---|
| 199 | { | 
|---|
| 200 | LocalSymmSCMatrix *lsb = require_dynamic_cast<LocalSymmSCMatrix*>(sb, | 
|---|
| 201 | "LocalSymmSCMatrix::assign_subblock"); | 
|---|
| 202 |  | 
|---|
| 203 | int nsrow = er-br+1; | 
|---|
| 204 |  | 
|---|
| 205 | if (nsrow > n()) { | 
|---|
| 206 | ExEnv::errn() << indent | 
|---|
| 207 | << "LocalSymmSCMatrix::assign_subblock: trying to assign too big a " | 
|---|
| 208 | << "subblock (" << nsrow << "," << nsrow | 
|---|
| 209 | << ") from (" << n() << "," << n() << ")\n"; | 
|---|
| 210 | abort(); | 
|---|
| 211 | } | 
|---|
| 212 |  | 
|---|
| 213 | for (int i=0; i < nsrow; i++) | 
|---|
| 214 | for (int j=0; j <= i; j++) | 
|---|
| 215 | set_element(i+br,j+br,lsb->rows[i][j]); | 
|---|
| 216 | } | 
|---|
| 217 |  | 
|---|
| 218 | void | 
|---|
| 219 | LocalSymmSCMatrix::accumulate_subblock(SCMatrix*sb, int br, int er, int bc, int ec) | 
|---|
| 220 | { | 
|---|
| 221 | LocalSCMatrix *lsb = require_dynamic_cast<LocalSCMatrix*>(sb, | 
|---|
| 222 | "LocalSymmSCMatrix::accumulate_subblock"); | 
|---|
| 223 |  | 
|---|
| 224 | int nsrow = er-br+1; | 
|---|
| 225 | int nscol = ec-bc+1; | 
|---|
| 226 |  | 
|---|
| 227 | if (nsrow > n() || nscol > n()) { | 
|---|
| 228 | ExEnv::errn() << indent | 
|---|
| 229 | << "LocalSymmSCMatrix::accumulate_subblock: trying to " | 
|---|
| 230 | << "accumulate too big a " | 
|---|
| 231 | << "subblock (" << nsrow << "," << nscol | 
|---|
| 232 | << ") from (" << n() << "," << n() << ")\n"; | 
|---|
| 233 | abort(); | 
|---|
| 234 | } | 
|---|
| 235 |  | 
|---|
| 236 | for (int i=0; i < nsrow; i++) | 
|---|
| 237 | for (int j=0; j < nscol; j++) | 
|---|
| 238 | set_element(i+br,j+br,get_element(i+br,j+br)+lsb->rows[i][j]); | 
|---|
| 239 | } | 
|---|
| 240 |  | 
|---|
| 241 | void | 
|---|
| 242 | LocalSymmSCMatrix::accumulate_subblock(SymmSCMatrix*sb, int br, int er) | 
|---|
| 243 | { | 
|---|
| 244 | LocalSCMatrix *lsb = require_dynamic_cast<LocalSCMatrix*>(sb, | 
|---|
| 245 | "LocalSymmSCMatrix::accumulate_subblock"); | 
|---|
| 246 |  | 
|---|
| 247 | int nsrow = er-br+1; | 
|---|
| 248 |  | 
|---|
| 249 | if (nsrow > n()) { | 
|---|
| 250 | ExEnv::errn() << indent | 
|---|
| 251 | << "LocalSymmSCMatrix::accumulate_subblock: trying to " | 
|---|
| 252 | << "accumulate too big a " | 
|---|
| 253 | << "subblock (" << nsrow << "," << nsrow | 
|---|
| 254 | << ") from (" << n() << "," << n() << ")\n"; | 
|---|
| 255 | abort(); | 
|---|
| 256 | } | 
|---|
| 257 |  | 
|---|
| 258 | for (int i=0; i < nsrow; i++) | 
|---|
| 259 | for (int j=0; j <= i; j++) | 
|---|
| 260 | set_element(i+br,j+br,get_element(i+br,j+br)+lsb->rows[i][j]); | 
|---|
| 261 | } | 
|---|
| 262 |  | 
|---|
| 263 | SCVector * | 
|---|
| 264 | LocalSymmSCMatrix::get_row(int i) | 
|---|
| 265 | { | 
|---|
| 266 | if (i >= n()) { | 
|---|
| 267 | ExEnv::errn() << indent | 
|---|
| 268 | << "LocalSymmSCMatrix::get_row: trying to get invalid row " | 
|---|
| 269 | << i << " max " << n() << endl; | 
|---|
| 270 | abort(); | 
|---|
| 271 | } | 
|---|
| 272 |  | 
|---|
| 273 | SCVector * v = kit()->vector(dim()); | 
|---|
| 274 |  | 
|---|
| 275 | LocalSCVector *lv = | 
|---|
| 276 | require_dynamic_cast<LocalSCVector*>(v, "LocalSymmSCMatrix::get_row"); | 
|---|
| 277 |  | 
|---|
| 278 | for (int j=0; j < n(); j++) | 
|---|
| 279 | lv->set_element(j,get_element(i,j)); | 
|---|
| 280 |  | 
|---|
| 281 | return v; | 
|---|
| 282 | } | 
|---|
| 283 |  | 
|---|
| 284 | void | 
|---|
| 285 | LocalSymmSCMatrix::assign_row(SCVector *v, int i) | 
|---|
| 286 | { | 
|---|
| 287 | if (i >= n()) { | 
|---|
| 288 | ExEnv::errn() << indent | 
|---|
| 289 | << "LocalSymmSCMatrix::assign_row: trying to assign invalid row " | 
|---|
| 290 | << i << " max " << n() << endl; | 
|---|
| 291 | abort(); | 
|---|
| 292 | } | 
|---|
| 293 |  | 
|---|
| 294 | if (v->n() != n()) { | 
|---|
| 295 | ExEnv::errn() << indent | 
|---|
| 296 | << "LocalSymmSCMatrix::assign_row: vector is wrong size " | 
|---|
| 297 | << "is " << v->n() << ", should be " << n() << endl; | 
|---|
| 298 | abort(); | 
|---|
| 299 | } | 
|---|
| 300 |  | 
|---|
| 301 | LocalSCVector *lv = | 
|---|
| 302 | require_dynamic_cast<LocalSCVector*>(v, "LocalSymmSCMatrix::assign_row"); | 
|---|
| 303 |  | 
|---|
| 304 | for (int j=0; j < n(); j++) | 
|---|
| 305 | set_element(i,j,lv->get_element(j)); | 
|---|
| 306 | } | 
|---|
| 307 |  | 
|---|
| 308 | void | 
|---|
| 309 | LocalSymmSCMatrix::accumulate_row(SCVector *v, int i) | 
|---|
| 310 | { | 
|---|
| 311 | if (i >= n()) { | 
|---|
| 312 | ExEnv::errn() << indent | 
|---|
| 313 | << "LocalSymmSCMatrix::accumulate_row: trying to " | 
|---|
| 314 | << "accumulate invalid row " | 
|---|
| 315 | << i << " max " << n() << endl; | 
|---|
| 316 | abort(); | 
|---|
| 317 | } | 
|---|
| 318 |  | 
|---|
| 319 | if (v->n() != n()) { | 
|---|
| 320 | ExEnv::errn() << indent | 
|---|
| 321 | << "LocalSymmSCMatrix::accumulate_row: vector is wrong size" | 
|---|
| 322 | << "is " << v->n() << ", should be " << n() << endl; | 
|---|
| 323 | abort(); | 
|---|
| 324 | } | 
|---|
| 325 |  | 
|---|
| 326 | LocalSCVector *lv = | 
|---|
| 327 | require_dynamic_cast<LocalSCVector*>(v, "LocalSymmSCMatrix::accumulate_row"); | 
|---|
| 328 |  | 
|---|
| 329 | for (int j=0; j < n(); j++) | 
|---|
| 330 | set_element(i,j,get_element(i,j)+lv->get_element(j)); | 
|---|
| 331 | } | 
|---|
| 332 |  | 
|---|
| 333 | void | 
|---|
| 334 | LocalSymmSCMatrix::accumulate(const SymmSCMatrix*a) | 
|---|
| 335 | { | 
|---|
| 336 | // make sure that the arguments is of the correct type | 
|---|
| 337 | const LocalSymmSCMatrix* la | 
|---|
| 338 | = require_dynamic_cast<const LocalSymmSCMatrix*>(a,"LocalSymmSCMatrix::accumulate"); | 
|---|
| 339 |  | 
|---|
| 340 | // make sure that the dimensions match | 
|---|
| 341 | if (!dim()->equiv(la->dim())) { | 
|---|
| 342 | ExEnv::errn() << indent | 
|---|
| 343 | << "LocalSymmSCMatrix::accumulate(SCMatrix*a): " | 
|---|
| 344 | << "dimensions don't match\n"; | 
|---|
| 345 | abort(); | 
|---|
| 346 | } | 
|---|
| 347 |  | 
|---|
| 348 | int nelem = (this->n() * (this->n() + 1))/2; | 
|---|
| 349 | for (int i=0; i<nelem; i++) block->data[i] += la->block->data[i]; | 
|---|
| 350 | } | 
|---|
| 351 |  | 
|---|
| 352 | double | 
|---|
| 353 | LocalSymmSCMatrix::invert_this() | 
|---|
| 354 | { | 
|---|
| 355 | return cmat_invert(rows,1,n()); | 
|---|
| 356 | } | 
|---|
| 357 |  | 
|---|
| 358 | double | 
|---|
| 359 | LocalSymmSCMatrix::determ_this() | 
|---|
| 360 | { | 
|---|
| 361 | return cmat_determ(rows,1,n()); | 
|---|
| 362 | } | 
|---|
| 363 |  | 
|---|
| 364 | double | 
|---|
| 365 | LocalSymmSCMatrix::trace() | 
|---|
| 366 | { | 
|---|
| 367 | double ret=0; | 
|---|
| 368 | for (int i=0; i < n(); i++) ret += rows[i][i]; | 
|---|
| 369 | return ret; | 
|---|
| 370 | } | 
|---|
| 371 |  | 
|---|
| 372 | double | 
|---|
| 373 | LocalSymmSCMatrix::solve_this(SCVector*v) | 
|---|
| 374 | { | 
|---|
| 375 | LocalSCVector* lv = | 
|---|
| 376 | require_dynamic_cast<LocalSCVector*>(v,"LocalSymmSCMatrix::solve_this"); | 
|---|
| 377 |  | 
|---|
| 378 | // make sure that the dimensions match | 
|---|
| 379 | if (!dim()->equiv(lv->dim())) { | 
|---|
| 380 | ExEnv::errn() << indent | 
|---|
| 381 | << "LocalSymmSCMatrix::solve_this(SCVector*v): " | 
|---|
| 382 | << "dimensions don't match\n"; | 
|---|
| 383 | abort(); | 
|---|
| 384 | } | 
|---|
| 385 |  | 
|---|
| 386 | return cmat_solve_lin(rows,1,lv->block->data,n()); | 
|---|
| 387 | } | 
|---|
| 388 |  | 
|---|
| 389 | void | 
|---|
| 390 | LocalSymmSCMatrix::gen_invert_this() | 
|---|
| 391 | { | 
|---|
| 392 | if (n() == 0) return; | 
|---|
| 393 |  | 
|---|
| 394 | double *evals = new double[n()]; | 
|---|
| 395 | double **evecs = cmat_new_square_matrix(n()); | 
|---|
| 396 |  | 
|---|
| 397 | cmat_diag(rows,evals,evecs,n(),1,1.0e-15); | 
|---|
| 398 |  | 
|---|
| 399 | for (int i=0; i < n(); i++) { | 
|---|
| 400 | if (fabs(evals[i]) > 1.0e-8) | 
|---|
| 401 | evals[i] = 1.0/evals[i]; | 
|---|
| 402 | else | 
|---|
| 403 | evals[i] = 0; | 
|---|
| 404 | } | 
|---|
| 405 |  | 
|---|
| 406 | cmat_transform_diagonal_matrix(rows, n(), evals, n(), evecs, 0); | 
|---|
| 407 |  | 
|---|
| 408 | delete[] evals; | 
|---|
| 409 | cmat_delete_matrix(evecs); | 
|---|
| 410 | } | 
|---|
| 411 |  | 
|---|
| 412 | void | 
|---|
| 413 | LocalSymmSCMatrix::diagonalize(DiagSCMatrix*a,SCMatrix*b) | 
|---|
| 414 | { | 
|---|
| 415 | if (n() == 0) return; | 
|---|
| 416 |  | 
|---|
| 417 | const char* name = "LocalSymmSCMatrix::diagonalize"; | 
|---|
| 418 | // make sure that the arguments is of the correct type | 
|---|
| 419 | LocalDiagSCMatrix* la = require_dynamic_cast<LocalDiagSCMatrix*>(a,name); | 
|---|
| 420 | LocalSCMatrix* lb = require_dynamic_cast<LocalSCMatrix*>(b,name); | 
|---|
| 421 |  | 
|---|
| 422 | if (!dim()->equiv(la->dim()) || | 
|---|
| 423 | !dim()->equiv(lb->coldim()) || !dim()->equiv(lb->rowdim())) { | 
|---|
| 424 | ExEnv::errn() << indent | 
|---|
| 425 | << "LocalSymmSCMatrix::" | 
|---|
| 426 | << "diagonalize(DiagSCMatrix*a,SCMatrix*b): bad dims"; | 
|---|
| 427 | abort(); | 
|---|
| 428 | } | 
|---|
| 429 |  | 
|---|
| 430 | double *eigvals; | 
|---|
| 431 | double **eigvecs; | 
|---|
| 432 | if (!la) { | 
|---|
| 433 | eigvals = new double[n()]; | 
|---|
| 434 | } | 
|---|
| 435 | else { | 
|---|
| 436 | eigvals = la->block->data; | 
|---|
| 437 | } | 
|---|
| 438 |  | 
|---|
| 439 | if (!lb) { | 
|---|
| 440 | eigvecs = cmat_new_square_matrix(n()); | 
|---|
| 441 | } | 
|---|
| 442 | else { | 
|---|
| 443 | eigvecs = lb->rows; | 
|---|
| 444 | } | 
|---|
| 445 |  | 
|---|
| 446 | cmat_diag(rows,eigvals,eigvecs,n(),1,1.0e-15); | 
|---|
| 447 |  | 
|---|
| 448 | if (!la) delete[] eigvals; | 
|---|
| 449 | if (!lb) cmat_delete_matrix(eigvecs); | 
|---|
| 450 | } | 
|---|
| 451 |  | 
|---|
| 452 | // computes this += a * a.t | 
|---|
| 453 | void | 
|---|
| 454 | LocalSymmSCMatrix::accumulate_symmetric_product(SCMatrix*a) | 
|---|
| 455 | { | 
|---|
| 456 | // make sure that the argument is of the correct type | 
|---|
| 457 | LocalSCMatrix* la | 
|---|
| 458 | = require_dynamic_cast<LocalSCMatrix*>(a,"LocalSymmSCMatrix::" | 
|---|
| 459 | "accumulate_symmetric_product"); | 
|---|
| 460 |  | 
|---|
| 461 | if (!dim()->equiv(la->rowdim())) { | 
|---|
| 462 | ExEnv::errn() << indent | 
|---|
| 463 | << "LocalSymmSCMatrix::" | 
|---|
| 464 | << "accumulate_symmetric_product(SCMatrix*a): bad dim"; | 
|---|
| 465 | abort(); | 
|---|
| 466 | } | 
|---|
| 467 |  | 
|---|
| 468 | cmat_symmetric_mxm(rows,n(),la->rows,la->ncol(),1); | 
|---|
| 469 | } | 
|---|
| 470 |  | 
|---|
| 471 | // computes this += a + a.t | 
|---|
| 472 | void | 
|---|
| 473 | LocalSymmSCMatrix::accumulate_symmetric_sum(SCMatrix*a) | 
|---|
| 474 | { | 
|---|
| 475 | // make sure that the argument is of the correct type | 
|---|
| 476 | LocalSCMatrix* la | 
|---|
| 477 | = require_dynamic_cast<LocalSCMatrix*>(a,"LocalSymmSCMatrix::" | 
|---|
| 478 | "accumulate_symmetric_sum"); | 
|---|
| 479 |  | 
|---|
| 480 | if (!dim()->equiv(la->rowdim()) || !dim()->equiv(la->coldim())) { | 
|---|
| 481 | ExEnv::errn() << indent | 
|---|
| 482 | << "LocalSymmSCMatrix::" | 
|---|
| 483 | << "accumulate_symmetric_sum(SCMatrix*a): bad dim"; | 
|---|
| 484 | abort(); | 
|---|
| 485 | } | 
|---|
| 486 |  | 
|---|
| 487 | int n = dim().n(); | 
|---|
| 488 | double** tdat = this->rows; | 
|---|
| 489 | double** adat = la->rows; | 
|---|
| 490 | for (int i=0; i<n; i++) { | 
|---|
| 491 | for (int j=0; j<=i; j++) { | 
|---|
| 492 | tdat[i][j] += adat[i][j] + adat[j][i]; | 
|---|
| 493 | } | 
|---|
| 494 | } | 
|---|
| 495 | } | 
|---|
| 496 |  | 
|---|
| 497 | void | 
|---|
| 498 | LocalSymmSCMatrix::accumulate_symmetric_outer_product(SCVector*a) | 
|---|
| 499 | { | 
|---|
| 500 | // make sure that the argument is of the correct type | 
|---|
| 501 | LocalSCVector* la | 
|---|
| 502 | = require_dynamic_cast<LocalSCVector*>(a,"LocalSymmSCMatrix::" | 
|---|
| 503 | "accumulate_symmetric_outer_product"); | 
|---|
| 504 |  | 
|---|
| 505 | if (!dim()->equiv(la->dim())) { | 
|---|
| 506 | ExEnv::errn() << indent | 
|---|
| 507 | << "LocalSymmSCMatrix::" | 
|---|
| 508 | << "accumulate_symmetric_outer_product(SCMatrix*a): bad dim"; | 
|---|
| 509 | abort(); | 
|---|
| 510 | } | 
|---|
| 511 |  | 
|---|
| 512 | int n = dim().n(); | 
|---|
| 513 | double** tdat = this->rows; | 
|---|
| 514 | double* adat = la->block->data; | 
|---|
| 515 | for (int i=0; i<n; i++) { | 
|---|
| 516 | for (int j=0; j<=i; j++) { | 
|---|
| 517 | tdat[i][j] += adat[i]*adat[j]; | 
|---|
| 518 | } | 
|---|
| 519 | } | 
|---|
| 520 | } | 
|---|
| 521 |  | 
|---|
| 522 | // this += a * b * transpose(a) | 
|---|
| 523 | void | 
|---|
| 524 | LocalSymmSCMatrix::accumulate_transform(SCMatrix*a,SymmSCMatrix*b, | 
|---|
| 525 | SCMatrix::Transform t) | 
|---|
| 526 | { | 
|---|
| 527 | int i,j,k; | 
|---|
| 528 | int ii,jj; | 
|---|
| 529 | int nc, nr; | 
|---|
| 530 |  | 
|---|
| 531 | // do the necessary castdowns | 
|---|
| 532 | LocalSCMatrix*la | 
|---|
| 533 | = require_dynamic_cast<LocalSCMatrix*>(a,"%s::accumulate_transform", | 
|---|
| 534 | class_name()); | 
|---|
| 535 | LocalSymmSCMatrix*lb = require_dynamic_cast<LocalSymmSCMatrix*>( | 
|---|
| 536 | b,"%s::accumulate_transform", class_name()); | 
|---|
| 537 |  | 
|---|
| 538 | // check the dimensions | 
|---|
| 539 | if (t == SCMatrix::NormalTransform) { | 
|---|
| 540 | if (!dim()->equiv(la->rowdim()) || !lb->dim()->equiv(la->coldim())) { | 
|---|
| 541 | ExEnv::errn() << indent << "LocalSymmSCMatrix::accumulate_transform: bad dim\n"; | 
|---|
| 542 | abort(); | 
|---|
| 543 | } | 
|---|
| 544 |  | 
|---|
| 545 | nc = lb->n(); | 
|---|
| 546 | nr = la->nrow(); | 
|---|
| 547 | } else { | 
|---|
| 548 | if (!dim()->equiv(la->coldim()) || !lb->dim()->equiv(la->rowdim())) { | 
|---|
| 549 | ExEnv::errn() << indent << "LocalSymmSCMatrix::accumulate_transform: bad dim\n"; | 
|---|
| 550 | abort(); | 
|---|
| 551 | } | 
|---|
| 552 |  | 
|---|
| 553 | nc = lb->n(); | 
|---|
| 554 | nr = la->ncol(); | 
|---|
| 555 | } | 
|---|
| 556 |  | 
|---|
| 557 | if (nr==0 || nc==0) | 
|---|
| 558 | return; | 
|---|
| 559 |  | 
|---|
| 560 | int nproc = messagegrp()->n(); | 
|---|
| 561 |  | 
|---|
| 562 | double **ablock = cmat_new_square_matrix(D1); | 
|---|
| 563 | double **bblock = cmat_new_square_matrix(D1); | 
|---|
| 564 | double **cblock = cmat_new_square_matrix(D1); | 
|---|
| 565 |  | 
|---|
| 566 | double **temp = cmat_new_rect_matrix(D1,nc); | 
|---|
| 567 |  | 
|---|
| 568 | for (i=0; i < nr; i += D1) { | 
|---|
| 569 | int ni = nr-i; | 
|---|
| 570 | if (ni > D1) ni = D1; | 
|---|
| 571 |  | 
|---|
| 572 | memset(temp[0], 0, sizeof(double)*D1*nc); | 
|---|
| 573 |  | 
|---|
| 574 | for (j=0; j < nc; j+= D1) { | 
|---|
| 575 | int nj = nc-j; | 
|---|
| 576 | if (nj > D1) nj = D1; | 
|---|
| 577 |  | 
|---|
| 578 | for (k=0; k < nc; k += D1) { | 
|---|
| 579 |  | 
|---|
| 580 | int nk = nc-k; | 
|---|
| 581 | if (nk > D1) nk = D1; | 
|---|
| 582 |  | 
|---|
| 583 | if (t == SCMatrix::NormalTransform) | 
|---|
| 584 | copy_block(ablock, la->rows, i, ni, k, nk); | 
|---|
| 585 | else | 
|---|
| 586 | copy_trans_block(ablock, la->rows, i, ni, k, nk); | 
|---|
| 587 |  | 
|---|
| 588 | copy_sym_block(bblock, lb->rows, j, nj, k, nk); | 
|---|
| 589 | copy_block(cblock, temp, 0, ni, j, nj); | 
|---|
| 590 | mult_block(ablock, bblock, cblock, ni, nj, nk); | 
|---|
| 591 | return_block(temp, cblock, 0, ni, j, nj); | 
|---|
| 592 | } | 
|---|
| 593 | } | 
|---|
| 594 |  | 
|---|
| 595 | // now do ab * a~ | 
|---|
| 596 | for (j=0; j <= i; j+= D1) { | 
|---|
| 597 | int nj = nr-j; | 
|---|
| 598 | if (nj > D1) nj = D1; | 
|---|
| 599 |  | 
|---|
| 600 | memset(cblock[0], 0, sizeof(double)*D1*D1); | 
|---|
| 601 |  | 
|---|
| 602 | for (k=0; k < nc; k += D1) { | 
|---|
| 603 |  | 
|---|
| 604 | int nk = nc-k; | 
|---|
| 605 | if (nk > D1) nk = D1; | 
|---|
| 606 |  | 
|---|
| 607 | copy_block(ablock, temp, 0, ni, k, nk); | 
|---|
| 608 | if (t == SCMatrix::NormalTransform) | 
|---|
| 609 | copy_block(bblock, la->rows, j, nj, k, nk); | 
|---|
| 610 | else | 
|---|
| 611 | copy_trans_block(bblock, la->rows, j, nj, k, nk); | 
|---|
| 612 |  | 
|---|
| 613 | mult_block(ablock, bblock, cblock, ni, nj, nk); | 
|---|
| 614 | } | 
|---|
| 615 |  | 
|---|
| 616 | // copy cblock(i,j) into result | 
|---|
| 617 | if (j==i) { | 
|---|
| 618 | for (ii=0; ii < ni; ii++) | 
|---|
| 619 | for (jj=0; jj <= ii; jj++) | 
|---|
| 620 | rows[i+ii][j+jj] += cblock[ii][jj]; | 
|---|
| 621 | } else { | 
|---|
| 622 | for (ii=0; ii < ni; ii++) | 
|---|
| 623 | for (jj=0; jj < nj; jj++) | 
|---|
| 624 | rows[i+ii][j+jj] += cblock[ii][jj]; | 
|---|
| 625 | } | 
|---|
| 626 | } | 
|---|
| 627 | } | 
|---|
| 628 |  | 
|---|
| 629 | cmat_delete_matrix(temp); | 
|---|
| 630 |  | 
|---|
| 631 | cmat_delete_matrix(ablock); | 
|---|
| 632 | cmat_delete_matrix(bblock); | 
|---|
| 633 | cmat_delete_matrix(cblock); | 
|---|
| 634 | } | 
|---|
| 635 |  | 
|---|
| 636 | // this += a * b * transpose(a) | 
|---|
| 637 | void | 
|---|
| 638 | LocalSymmSCMatrix::accumulate_transform(SCMatrix*a,DiagSCMatrix*b, | 
|---|
| 639 | SCMatrix::Transform t) | 
|---|
| 640 | { | 
|---|
| 641 | // do the necessary castdowns | 
|---|
| 642 | LocalSCMatrix*la | 
|---|
| 643 | = require_dynamic_cast<LocalSCMatrix*>(a,"%s::accumulate_transform", | 
|---|
| 644 | class_name()); | 
|---|
| 645 | LocalDiagSCMatrix*lb | 
|---|
| 646 | = require_dynamic_cast<LocalDiagSCMatrix*>(b,"%s::accumulate_transform", | 
|---|
| 647 | class_name()); | 
|---|
| 648 |  | 
|---|
| 649 | // check the dimensions | 
|---|
| 650 | if (!dim()->equiv(la->rowdim()) || !lb->dim()->equiv(la->coldim())) { | 
|---|
| 651 | ExEnv::errn() << indent | 
|---|
| 652 | << "LocalSymmSCMatrix::accumulate_transform: bad dim\n"; | 
|---|
| 653 | abort(); | 
|---|
| 654 | } | 
|---|
| 655 |  | 
|---|
| 656 | cmat_transform_diagonal_matrix(rows,n(),lb->block->data,lb->n(),la->rows,1); | 
|---|
| 657 | } | 
|---|
| 658 |  | 
|---|
| 659 | void | 
|---|
| 660 | LocalSymmSCMatrix::accumulate_transform(SymmSCMatrix*a,SymmSCMatrix*b) | 
|---|
| 661 | { | 
|---|
| 662 | SymmSCMatrix::accumulate_transform(a,b); | 
|---|
| 663 | } | 
|---|
| 664 |  | 
|---|
| 665 | double | 
|---|
| 666 | LocalSymmSCMatrix::scalar_product(SCVector*a) | 
|---|
| 667 | { | 
|---|
| 668 | // make sure that the argument is of the correct type | 
|---|
| 669 | LocalSCVector* la | 
|---|
| 670 | = require_dynamic_cast<LocalSCVector*>(a,"LocalSCVector::scalar_product"); | 
|---|
| 671 |  | 
|---|
| 672 | // make sure that the dimensions match | 
|---|
| 673 | if (!dim()->equiv(la->dim())) { | 
|---|
| 674 | ExEnv::errn() << indent | 
|---|
| 675 | << "LocalSCVector::scalar_product(SCVector*a): " | 
|---|
| 676 | << "dimensions don't match\n"; | 
|---|
| 677 | abort(); | 
|---|
| 678 | } | 
|---|
| 679 |  | 
|---|
| 680 | int nelem = n(); | 
|---|
| 681 | double* adat = la->block->data; | 
|---|
| 682 | double result = 0.0; | 
|---|
| 683 | for (int i=0; i<nelem; i++) { | 
|---|
| 684 | for (int j=0; j<i; j++) { | 
|---|
| 685 | result += 2.0 * rows[i][j] * adat[i] * adat[j]; | 
|---|
| 686 | } | 
|---|
| 687 | result += rows[i][i] * adat[i] * adat[i]; | 
|---|
| 688 | } | 
|---|
| 689 | return result; | 
|---|
| 690 | } | 
|---|
| 691 |  | 
|---|
| 692 | void | 
|---|
| 693 | LocalSymmSCMatrix::element_op(const Ref<SCElementOp>& op) | 
|---|
| 694 | { | 
|---|
| 695 | op->process_spec_ltri(block.pointer()); | 
|---|
| 696 | } | 
|---|
| 697 |  | 
|---|
| 698 | void | 
|---|
| 699 | LocalSymmSCMatrix::element_op(const Ref<SCElementOp2>& op, | 
|---|
| 700 | SymmSCMatrix* m) | 
|---|
| 701 | { | 
|---|
| 702 | LocalSymmSCMatrix *lm | 
|---|
| 703 | = require_dynamic_cast<LocalSymmSCMatrix*>(m,"LocalSymSCMatrix::element_op"); | 
|---|
| 704 |  | 
|---|
| 705 | if (!dim()->equiv(lm->dim())) { | 
|---|
| 706 | ExEnv::errn() << indent << "LocalSymmSCMatrix: bad element_op\n"; | 
|---|
| 707 | abort(); | 
|---|
| 708 | } | 
|---|
| 709 | op->process_spec_ltri(block.pointer(), lm->block.pointer()); | 
|---|
| 710 | } | 
|---|
| 711 |  | 
|---|
| 712 | void | 
|---|
| 713 | LocalSymmSCMatrix::element_op(const Ref<SCElementOp3>& op, | 
|---|
| 714 | SymmSCMatrix* m,SymmSCMatrix* n) | 
|---|
| 715 | { | 
|---|
| 716 | LocalSymmSCMatrix *lm | 
|---|
| 717 | = require_dynamic_cast<LocalSymmSCMatrix*>(m,"LocalSymSCMatrix::element_op"); | 
|---|
| 718 | LocalSymmSCMatrix *ln | 
|---|
| 719 | = require_dynamic_cast<LocalSymmSCMatrix*>(n,"LocalSymSCMatrix::element_op"); | 
|---|
| 720 |  | 
|---|
| 721 | if (!dim()->equiv(lm->dim()) || !dim()->equiv(ln->dim())) { | 
|---|
| 722 | ExEnv::errn() << indent << "LocalSymmSCMatrix: bad element_op\n"; | 
|---|
| 723 | abort(); | 
|---|
| 724 | } | 
|---|
| 725 | op->process_spec_ltri(block.pointer(), | 
|---|
| 726 | lm->block.pointer(), ln->block.pointer()); | 
|---|
| 727 | } | 
|---|
| 728 |  | 
|---|
| 729 | // from Ed Seidl at the NIH (with a bit of hacking) | 
|---|
| 730 | void | 
|---|
| 731 | LocalSymmSCMatrix::vprint(const char *title, ostream& os, int prec) const | 
|---|
| 732 | { | 
|---|
| 733 | int ii,jj,kk,nn; | 
|---|
| 734 | int i,j; | 
|---|
| 735 | int lwidth,width; | 
|---|
| 736 | double max=this->maxabs(); | 
|---|
| 737 |  | 
|---|
| 738 | max = (max==0.0) ? 1.0 : log10(max); | 
|---|
| 739 | if (max < 0.0) max=1.0; | 
|---|
| 740 |  | 
|---|
| 741 | lwidth = prec + 5 + (int) max; | 
|---|
| 742 | width = 75/(lwidth+SCFormIO::getindent(os)); | 
|---|
| 743 |  | 
|---|
| 744 | if (title) | 
|---|
| 745 | os << endl << indent << title << endl; | 
|---|
| 746 | else | 
|---|
| 747 | os << endl; | 
|---|
| 748 |  | 
|---|
| 749 | if (n()==0) { | 
|---|
| 750 | os << indent << "empty matrix\n"; | 
|---|
| 751 | return; | 
|---|
| 752 | } | 
|---|
| 753 |  | 
|---|
| 754 | for (ii=jj=0;;) { | 
|---|
| 755 | ii++; jj++; | 
|---|
| 756 | kk=width*jj; | 
|---|
| 757 | nn = (n() > kk) ? kk : n(); | 
|---|
| 758 |  | 
|---|
| 759 | // print column indices | 
|---|
| 760 | os << indent; | 
|---|
| 761 | for (i=ii; i <= nn; i++) | 
|---|
| 762 | os << scprintf("%*d",lwidth,i); | 
|---|
| 763 | os << endl; | 
|---|
| 764 |  | 
|---|
| 765 | // print the rows | 
|---|
| 766 | for (i=ii-1; i < n() ; i++) { | 
|---|
| 767 | os << indent << scprintf("%5d",i+1); | 
|---|
| 768 | for (j=ii-1; j<nn && j<=i; j++) | 
|---|
| 769 | os << scprintf("%*.*f",lwidth,prec,rows[i][j]); | 
|---|
| 770 | os << endl; | 
|---|
| 771 | } | 
|---|
| 772 | os << endl; | 
|---|
| 773 |  | 
|---|
| 774 | if (n() <= kk) { | 
|---|
| 775 | os.flush(); | 
|---|
| 776 | return; | 
|---|
| 777 | } | 
|---|
| 778 | ii=kk; | 
|---|
| 779 | } | 
|---|
| 780 | } | 
|---|
| 781 |  | 
|---|
| 782 | Ref<SCMatrixSubblockIter> | 
|---|
| 783 | LocalSymmSCMatrix::local_blocks(SCMatrixSubblockIter::Access access) | 
|---|
| 784 | { | 
|---|
| 785 | if (messagegrp()->n() > 1) { | 
|---|
| 786 | ExEnv::errn() << indent | 
|---|
| 787 | << "LocalSymmSCMatrix::local_blocks: not valid for local matrices" | 
|---|
| 788 | << endl; | 
|---|
| 789 | abort(); | 
|---|
| 790 | } | 
|---|
| 791 | Ref<SCMatrixSubblockIter> iter | 
|---|
| 792 | = new SCMatrixSimpleSubblockIter(access, block.pointer()); | 
|---|
| 793 | return iter; | 
|---|
| 794 | } | 
|---|
| 795 |  | 
|---|
| 796 | Ref<SCMatrixSubblockIter> | 
|---|
| 797 | LocalSymmSCMatrix::all_blocks(SCMatrixSubblockIter::Access access) | 
|---|
| 798 | { | 
|---|
| 799 | if (access == SCMatrixSubblockIter::Write) { | 
|---|
| 800 | ExEnv::errn() << indent << "LocalSymmSCMatrix::all_blocks: " | 
|---|
| 801 | << "Write access permitted for local blocks only" | 
|---|
| 802 | << endl; | 
|---|
| 803 | abort(); | 
|---|
| 804 | } | 
|---|
| 805 | return local_blocks(access); | 
|---|
| 806 | } | 
|---|
| 807 |  | 
|---|
| 808 | ///////////////////////////////////////////////////////////////////////////// | 
|---|
| 809 |  | 
|---|
| 810 | // Local Variables: | 
|---|
| 811 | // mode: c++ | 
|---|
| 812 | // c-file-style: "CLJ" | 
|---|
| 813 | // End: | 
|---|