コード例 #1
0
int
BandArpackSolver::solve(int numModes, bool generalized, bool findSmallest)
{
  if (generalized == false) {
    opserr << "BandArpackSolver::solve(int numMode, bool generalized) - only solves generalized problem\n";
    return -1;
  }

    if (theSOE == 0) {
	opserr << "WARNING BandGenLinLapackSolver::solve(void)- ";
	opserr << " No LinearSOE object has been set\n";
	return -1;
    }

    int n = theSOE->size;    
    
    // check iPiv is large enough
    if (iPivSize < n) {
	opserr << "WARNING BandGenLinLapackSolver::solve(void)- ";
	opserr << " iPiv not large enough - has setSize() been called?\n";
	return -1;
    }	    

    // set some variables
    int kl = theSOE->numSubD;
    int ku = theSOE->numSuperD;
    int ldA = 2*kl + ku +1;
    int nrhs = 1;
    int ldB = n;
    int info;
    double *Aptr = theSOE->A;
    int    *iPIV = iPiv;

    int nev = numModes;;
    int ncv = getNCV(n, nev);

    // set up the space for ARPACK functions.
    // this is done each time method is called!! .. this needs to be cleaned up
    int ldv = n;
    int lworkl = ncv*ncv + 8*ncv;
    double *v = new double[ldv * ncv];
    double *workl = new double[lworkl + 1];
    double *workd = new double[3 * n + 1];
    double *d = new double[nev];
    double *z= new double[n * nev];
    double *resid = new double[n];
    int *iparam = new int[11];
    int *ipntr = new int[11];
    logical *select = new logical[ncv];

    static char which[3]; 
    if (findSmallest == true) {
      strcpy(which, "LM");
    }  else {
      strcpy(which, "SM");
    }

    char bmat = 'G';
    char howmy = 'A';

    // some more variables
    int maxitr, mode;
    double tol = 0.0;
    info = 0;
    maxitr = 1000;
    mode = 3;

    iparam[0] = 1;
    iparam[2] = maxitr;
    iparam[6] = mode; 

    bool rvec = true;

    int ido = 0;

    int ierr = 0;

    // Do the factorization of Matrix (A-dM) here.
#ifdef _WIN32
    DGBTRF(&n, &n, &kl, &ku, Aptr, &ldA, iPiv, &ierr); 
#else
    dgbtrf_(&n, &n, &kl, &ku, Aptr, &ldA, iPiv, &ierr); 
#endif

    if ( ierr != 0 ) {
       opserr << " BandArpackSolver::Error in dgbtrf_ " << endln;
       return -1;
    }

    while (1) { 

#ifdef _WIN32
      unsigned int sizeWhich =2;
      unsigned int sizeBmat =1;
      unsigned int sizeHowmany =1;
      unsigned int sizeOne = 1;
      /*
	DSAUPD(&ido, &bmat, &sizeBmat, &n, which, &sizeWhich, &nev, &tol, resid, 
	&ncv, v, &ldv,
	iparam, ipntr, workd, workl, &lworkl, &info);
      */
      
      DSAUPD(&ido, &bmat, &n, which, &nev, &tol, resid, 
	     &ncv, v, &ldv,
	     iparam, ipntr, workd, workl, &lworkl, &info);
#else

      dsaupd_(&ido, &bmat, &n, which, &nev, &tol, resid, &ncv, v, &ldv,
	      iparam, ipntr, workd, workl, &lworkl, &info);
#endif
      
      if (ido == -1) {

	  myMv(n, &workd[ipntr[0]-1], &workd[ipntr[1]-1]); 
#ifdef _WIN32
	  /*
	  DGBTRS("N", &sizeOne, &n, &kl, &ku, &nrhs, Aptr, &ldA, iPIV, 
		 &workd[ipntr[1] - 1], &ldB, &ierr);
		 */
	  DGBTRS("N", &n, &kl, &ku, &nrhs, Aptr, &ldA, iPIV, 
		 &workd[ipntr[1] - 1], &ldB, &ierr);
#else
	  dgbtrs_("N", &n, &kl, &ku, &nrhs, Aptr, &ldA, iPIV, 
		  &workd[ipntr[1] - 1], &ldB, &ierr);
#endif

	  if (ierr != 0) {
	      opserr << "BandArpackSolver::Error with dgbtrs_ 1" <<endln;
	      exit(0);
	  }
	  continue;
      } else if (ido == 1) {

	//          double ratio = 1.0;
	  myCopy(n, &workd[ipntr[2]-1], &workd[ipntr[1]-1]);

#ifdef _WIN32
	  /*
	  DGBTRS("N", &sizeOne, &n, &kl, &ku, &nrhs, Aptr, &ldA, iPIV, 
		 &workd[ipntr[1] - 1], &ldB, &ierr);
		 */
	  DGBTRS("N", &n, &kl, &ku, &nrhs, Aptr, &ldA, iPIV, 
		 &workd[ipntr[1] - 1], &ldB, &ierr);
#else
	  dgbtrs_("N", &n, &kl, &ku, &nrhs, Aptr, &ldA, iPIV, 
		  &workd[ipntr[1] - 1], &ldB, &ierr);
#endif

	  if (ierr != 0) {
	      opserr << "BandArpackSolver::Error with dgbtrs_ 2" <<endln;
	      exit(0);
	  }
	  continue;
      } else if (ido == 2) {     

	  myMv(n, &workd[ipntr[0]-1], &workd[ipntr[1]-1]);
	  continue;
      }

      break;
    }

    if (info < 0) {
      opserr << "BandArpackSolver::Error with _saupd info = " << info << endln;
      switch(info) {

         case -1: 
	   opserr << "N must be positive.\n";
	   break;
         case -2: 
	   opserr << "NEV must be positive.\n";
	   break;
         case -3: 
	   opserr << "NCV must be greater than NEV and less than or equal to N.\n";
	   break;
         case -4:
	   opserr << "The maximum number of Arnoldi update iterations allowed";
	   break;
         case -5: 
	   opserr << "WHICH must be one of 'LM', 'SM', 'LA', 'SA' or 'BE'.\n";
	   break;
         case -6: 
	   opserr << "BMAT must be one of 'I' or 'G'.\n";
	   break;
         case -7: 
	   opserr << "Length of private work array WORKL is not sufficient.\n";
	   break;
         case -8: 
	   opserr << "Error return from trid. eigenvalue calculation";
	   opserr << "Informatinal error from LAPACK routine dsteqr.\n";
	   break;
         case -9: 
	   opserr << "Starting vector is zero.\n";
	   break;
         case -10: 
	   opserr << "IPARAM(7) must be 1,2,3,4,5.\n";
	   break;
         case -11: 
	   opserr << "IPARAM(7) = 1 and BMAT = 'G' are incompatable.\n";
	   break;
         case -12: 
	   opserr << "IPARAM(1) must be equal to 0 or 1.\n";
	   break;
         case -13:
	   opserr << "NEV and WHICH = 'BE' are incompatable.\n";
	   break;
         case -9999:
	   opserr << "Could not build an Arnoldi factorization.";
	   opserr << "IPARAM(5) returns the size of the current Arnoldi\n";
	   opserr << "factorization. The user is advised to check that";
	   opserr << "enough workspace and array storage has been allocated.\n";
	   break;
         default:
	   opserr << "unrecognised return value\n";
      }

      // clean up the memory
      delete [] workl;
      delete [] workd;
      delete [] resid;
      delete [] iparam;
      delete [] v;
      delete [] select;
      delete [] ipntr;
      delete [] d;
      delete [] z;

      value = 0;
      eigenvector = 0;
		
      return info;
    } else {
        if (info == 1) {
	  opserr << "BandArpackSolver::Maximum number of iteration reached." << endln;
	} else if (info == 3) {
	  opserr << "BandArpackSolver::No Shifts could be applied during implicit,";
	  opserr << "Arnoldi update, try increasing NCV." << endln;
	}

	double sigma = theSOE->shift;
	if (iparam[4] > 0) {
	    rvec = true;
	    n = theSOE->size;    
	    ldv = n;

#ifdef _WIN32
	    unsigned int sizeWhich =2;
	    unsigned int sizeBmat =1;
	    unsigned int sizeHowmany =1;
		/*
	    DSEUPD(&rvec, &howmy, &sizeHowmany, select, d, z, &ldv, &sigma, &bmat,
		   &sizeBmat, &n, which, &sizeWhich,
		   &nev, &tol, resid, &ncv, v, &ldv, iparam, ipntr, workd,
		   workl, &lworkl, &info);
		   */
		DSEUPD(&rvec, &howmy, select, d, z, &ldv, &sigma, &bmat, &n, which,
		   &nev, &tol, resid, &ncv, v, &ldv, iparam, ipntr, workd,
		   workl, &lworkl, &info);
#else
	    dseupd_(&rvec, &howmy, select, d, z, &ldv, &sigma, &bmat, &n, which,
		    &nev, &tol, resid, &ncv, v, &ldv, iparam, ipntr, workd,
		    workl, &lworkl, &info);
#endif
	    if (info != 0) {
	        opserr << "BandArpackSolver::Error with dseupd_" << info;
		switch(info) {

		case -1: 
		   opserr << " N must be positive.\n";
		   break;
		case -2: 
		   opserr << " NEV must be positive.\n";
		   break;
		case -3: 
		   opserr << " NCV must be greater than NEV and less than or equal to N.\n";
		   break;
		case -5: 
		   opserr << " WHICH must be one of 'LM', 'SM', 'LA', 'SA' or 'BE'.\n";
		   break;
		case -6: 
                   opserr << " BMAT must be one of 'I' or 'G'.\n";
		   break;
		case -7: 
		   opserr << " Length of private work WORKL array is not sufficient.\n";
		   break;
		case -8: 
                   opserr << " Error return from trid. eigenvalue calculation";
		   opserr << "Information error from LAPACK routine dsteqr.\n";
		   break;
		case -9: 
                   opserr << " Starting vector is zero.\n";
		   break;
		case -10: 
                   opserr << " IPARAM(7) must be 1,2,3,4,5.\n";
		   break;
		case -11: 
                   opserr << " IPARAM(7) = 1 and BMAT = 'G' are incompatibl\n";
		   break;
		case -12: 
		   opserr << " NEV and WHICH = 'BE' are incompatible.\n";
		   break;
		case -14: 
		   opserr << " DSAUPD did not find any eigenvalues to sufficient accuracy.\n";
		   break;
		case -15: 
		   opserr << " HOWMNY must be one of 'A' or 'S' if RVEC = .true.\n";
		   break;
		case -16: 
		   opserr << " HOWMNY = 'S' not yet implemented\n";
		   break;
		default:
		  ;
		}

		// clean up the memory
		delete [] workl;
		delete [] workd;
		delete [] resid;
		delete [] iparam;
		delete [] v;
		delete [] select;
		delete [] ipntr;
		delete [] d;
		delete [] z;

		value = 0;
		eigenvector = 0;

		return info;

	    }
	}
    }


    value = d;
    eigenvector = z;

    theSOE->factored = true;

    // clean up the memory
    delete [] workl;
    delete [] workd;
    delete [] resid;
    delete [] iparam;
    delete [] v;
    delete [] select;
    delete [] ipntr;

    return 0;
}
コード例 #2
0
ファイル: ArpackSolver.cpp プロジェクト: lge88/OpenSees
int
ArpackSolver::solve(int numModes, bool generalized)
{
  if (generalized == false) {
    opserr << "ArpackSolver::solve() - at moment only solves generalized problem\n";
    return -1;
  }

  theSOE = theArpackSOE->theSOE;

  if (theSOE == 0) {
    opserr << "ArpackSolver::setSize() - no LinearSOE set\n";
    return -1;
  }
  
  // set up the space for ARPACK functions.
  // this is done each time method is called!! .. this needs to be cleaned up
  
  int n = size;
  int nev = numModes;
  int ncv = getNCV(n, nev);
  int ldv = n;
  int lworkl = ncv*ncv + 8*ncv;

  int processID = theArpackSOE->processID;
  
  
  // set up the space for ARPACK functions.
  // this is done each time method is called!! .. this needs to be cleaned up
  if (numModes > numModesMax) {
    
    if (v != 0) delete [] v;
    if (workl != 0) delete [] workl;
    if (workd != 0) delete [] workd;
    if (eigenvalues != 0) delete [] eigenvalues;
    if (eigenvectors != 0) delete [] eigenvectors;
    if (resid != 0) delete [] resid;
    if (select != 0) delete [] select;
    
    v = new double[ldv * ncv];
    workl = new double[lworkl + 1];
    workd = new double[3 * n + 1];
    eigenvalues = new double[nev];
    eigenvectors = new double[n * nev];
    resid = new double[n];
    select = new logical[ncv];

    for (int i=0; i<lworkl+1; i++)
	   workl[i] = 0;
    for (int i=0; i<3*n+1; i++)
      workd[i] = 0;

    for (int i=0; i<ldv*ncv; i++)
      v[i] = 0;
    
    numModesMax = numModes;
  }

  static char which[3]; strcpy(which, "LM");
  char bmat = 'G';
  char howmy = 'A';
  
  // some more variables
  double tol = 0.0;
  int info = 0;
  int maxitr = 1000;
  int mode = 3;
  
  iparam[0] = 1;
  iparam[2] = maxitr;
  iparam[6] = mode; 

  
  bool rvec = true;
  
  int ido = 0;
  int ierr = 0;
  
  while (1) { 


#ifdef _WIN32
    unsigned int sizeWhich =2;
    unsigned int sizeBmat =1;
    unsigned int sizeHowmany =1;
    unsigned int sizeOne = 1;

    DSAUPD(&ido, &bmat, &n, which, &nev, &tol, resid, 
	   &ncv, v, &ldv,
	   iparam, ipntr, workd, workl, &lworkl, &info);
#else
    dsaupd_(&ido, &bmat, &n, which, &nev, &tol, resid, &ncv, v, &ldv,
	    iparam, ipntr, workd, workl, &lworkl, &info);
#endif

    if (ido == -1) {

      myMv(n, &workd[ipntr[0]-1], &workd[ipntr[1]-1]); 
      
      theVector.setData(&workd[ipntr[1] - 1], size);
      theSOE->setB(theVector);
      ierr = theSOE->solve();
      const Vector &X = theSOE->getX();
      theVector = X;
      
      continue;
      
    } else if (ido == 1) {
      
      //  double ratio = 1.0;
      myCopy(n, &workd[ipntr[2]-1], &workd[ipntr[1]-1]);
      
      theVector.setData(&workd[ipntr[1] - 1], size);
      if (processID > 0)
	theSOE->zeroB();
      else
	theSOE->setB(theVector);

      theSOE->solve();
      const Vector &X = theSOE->getX();
      theVector = X;
      //      theVector.setData(&workd[ipntr[1] - 1], size);

      continue;
      
    } else if (ido == 2) {     

      myMv(n, &workd[ipntr[0]-1], &workd[ipntr[1]-1]);

      continue;
    }
    
    break;
  }
  
  if (info < 0) {
    opserr << "ArpackSolver::Error with _saupd info = " << info << endln;
    switch(info) {
      
    case -1: 
      opserr << "N must be positive.\n";
      break;
    case -2: 
      opserr << "NEV must be positive.\n";
      break;
    case -3: 
      opserr << "NCV must be greater than NEV and less than or equal to N.\n";
      break;
    case -4:
      opserr << "The maximum number of Arnoldi update iterations allowed";
      break;
    case -5: 
      opserr << "WHICH must be one of 'LM', 'SM', 'LA', 'SA' or 'BE'.\n";
      break;
    case -6: 
      opserr << "BMAT must be one of 'I' or 'G'.\n";
      break;
    case -7: 
      opserr << "Length of private work array WORKL is not sufficient.\n";
      break;
    case -8: 
      opserr << "Error return from trid. eigenvalue calculation";
      opserr << "Informatinal error from LAPACK routine dsteqr.\n";
      break;
    case -9: 
      opserr << "Starting vector is zero.\n";
      break;
    case -10: 
      opserr << "IPARAM(7) must be 1,2,3,4,5.\n";
      break;
    case -11: 
      opserr << "IPARAM(7) = 1 and BMAT = 'G' are incompatable.\n";
      break;
    case -12: 
      opserr << "IPARAM(1) must be equal to 0 or 1.\n";
      break;
    case -13:
      opserr << "NEV and WHICH = 'BE' are incompatable.\n";
      break;
    case -9999:
      opserr << "Could not build an Arnoldi factorization.";
      opserr << "IPARAM(5) the size of the current Arnoldi factorization: is ";
      opserr << iparam[4];
      opserr << "factorization. The user is advised to check that";
      opserr << "enough workspace and array storage has been allocated.\n";
      break;
    default:
      opserr << "unrecognised return value\n";
    }
    
    eigenvalues = 0;
    eigenvectors = 0;
    
    return info;
  } else {
    if (info == 1) {
      opserr << "ArpackSolver::Maximum number of iteration reached." << endln;
    } else if (info == 3) {
      opserr << "ArpackSolver::No Shifts could be applied during implicit,";
      opserr << "Arnoldi update, try increasing NCV." << endln;
    }
    
    double sigma = shift;
    if (iparam[4] > 0) {
      rvec = true;
      n = size;    
      ldv = n;
      
#ifdef _WIN32
      unsigned int sizeWhich =2;
      unsigned int sizeBmat =1;
      unsigned int sizeHowmany =1;
      
      DSEUPD(&rvec, &howmy, select, eigenvalues, eigenvectors, &ldv, &sigma, &bmat, &n, which,
	     &nev, &tol, resid, &ncv, v, &ldv, iparam, ipntr, workd,
	     workl, &lworkl, &info);
#else
      dseupd_(&rvec, &howmy, select, eigenvalues, eigenvectors, &ldv, &sigma, &bmat, &n, which,
	      &nev, &tol, resid, &ncv, v, &ldv, iparam, ipntr, workd,
	      workl, &lworkl, &info);
#endif
      if (info != 0) {
	opserr << "ArpackSolver::Error with dseupd_" << info;
	switch(info) {
	  
	case -1: 
	  opserr << " N must be positive.\n";
	  break;
	case -2: 
	  opserr << " NEV must be positive.\n";
	  break;
	case -3: 
	  opserr << " NCV must be greater than NEV and less than or equal to N.\n";
	  break;
	case -5: 
	  opserr << " WHICH must be one of 'LM', 'SM', 'LA', 'SA' or 'BE'.\n";
	  break;
	case -6: 
	  opserr << " BMAT must be one of 'I' or 'G'.\n";
	  break;
	case -7: 
	  opserr << " Length of private work WORKL array is not sufficient.\n";
	  break;
	case -8: 
	  opserr << " Error return from trid. eigenvalue calculation";
	  opserr << "Information error from LAPACK routine dsteqr.\n";
	  break;
	case -9: 
	  opserr << " Starting vector is zero.\n";
	  break;
	case -10: 
	  opserr << " IPARAM(7) must be 1,2,3,4,5.\n";
	  break;
	case -11: 
	  opserr << " IPARAM(7) = 1 and BMAT = 'G' are incompatibl\n";
	  break;
	case -12: 
	  opserr << " NEV and WHICH = 'BE' are incompatible.\n";
	  break;
	case -14: 
	  opserr << " DSAUPD did not find any eigenvalues to sufficient accuracy.\n";
	  break;
	case -15: 
	  opserr << " HOWMNY must be one of 'A' or 'S' if RVEC = .true.\n";
	  break;
	case -16: 
	  opserr << " HOWMNY = 'S' not yet implemented\n";
	  break;
	default:
	  ;
	}
	
	
	return info;
	
      }
    }
  }
  
  numMode = numModes;
  
  // clean up the memory
  return 0;
}