Esempio n. 1
0
static double dist_dot(double *x, int incx,
   double *y, int incy, primme_params *primme) {
                                                                                
   double temp, product;
   int count;
                                                                                
   temp = Num_dot_dprimme(primme->nLocal, x, incx, y, incy);
   count = 1;
   (*primme->globalSumDouble)(&temp, &product, &count, primme);
   return product;
                                                                                
}
Esempio n. 2
0
static void compute_resnorms(double *V, double *W, double *hVecs, 
   double *hVals, int basisSize, double *blockNorms, int *iev, int left, 
   int right, void *rwork, primme_params *primme) {

   int i;            /* Loop variable                             */
   int numResiduals; /* Number of residual vectors to be computed */
   double *dwork = (double *) rwork;  /* pointer casting rwork to double */
   double ztmp;     /* temp var holding shift                    */
   double tpone = +1.0e+00, tzero = +0.0e+00;       /* constants */

   numResiduals = right - left + 1;

   /* We want to compute residuals r = Ax-hVal*x for the Ritz vectors x */
   /* Eqivalently, r = A*V*hVec - hval*V*hVec = W*hVec - hVal*V*hVec.   */

   /* Compute the Ritz vectors */

   Num_gemm_dprimme("N", "N", primme->nLocal, numResiduals, basisSize, 
      tpone, V, primme->nLocal, hVecs, basisSize, tzero,
      &V[primme->nLocal*(basisSize+left)], primme->nLocal);

   /* Compute W*hVecs */

   Num_gemm_dprimme("N", "N", primme->nLocal, numResiduals, basisSize, 
      tpone, W, primme->nLocal, hVecs, basisSize, tzero,
      &W[primme->nLocal*(basisSize+left)], primme->nLocal);

   /* Compute the residuals */

   for (i=left; i <= right; i++) {
      ztmp = -hVals[iev[i]];
      Num_axpy_dprimme(primme->nLocal, ztmp, &V[primme->nLocal*(basisSize+i)],
       1, &W[primme->nLocal*(basisSize+i)], 1);
   }

   /* Compute the residual norms */

   for (i=left; i <= right; i++) {
      dwork[i] = Num_dot_dprimme(primme->nLocal, 
      &W[primme->nLocal*(basisSize+i)], 1, &W[primme->nLocal*(basisSize+i)], 1);
   }
   
   (*primme->globalSumDouble)(&dwork[left], &blockNorms[left], &numResiduals,
                              primme);

   for (i=left; i <= right; i++) {
      blockNorms[i] = sqrt(blockNorms[i]);
   }

}
Esempio n. 3
0
int lock_vectors_dprimme(double tol, double *aNormEstimate, double *maxConvTol, 
   int *basisSize, int *numLocked, int *numGuesses, int *nextGuess,
   double *V, double *W, double *H, double *evecsHat, double *M, 
   double *UDU, int *ipivot, double *hVals, double *hVecs, 
   double *evecs, double *evals, int *perm, double machEps, 
   double *resNorms, int *numPrevRitzVals, double *prevRitzVals, 
   int *flag, double *rwork, int rworkSize, int *iwork, 
   int *LockingProblem, primme_params *primme) {

   int i;             /* Loop counter                                       */
   int numCandidates; /* Number of targeted Ritz vectors converged before   */
                      /* restart.                                           */
   int newStart;      /* Index in evecs where the locked vectors were added */
   int numNewVectors; /* Number of vectors added to the basis to replace    */
                      /* locked vectors.                                    */
   int candidate;     /* Index of Ritz vector to be checked for convergence */
   int numDeflated;   /* The number of vectors actually locked              */
   int numReplaced;   /* The number of locked vectors that were replaced by */
                      /* initial guesses.                                   */
   int numRecentlyLocked; /* Number of vectors locked.                      */
   int evecsSize;     /* The number of orthogonalization constraints plus   */
                      /* the number of locked vectors.                      */
   int ret;           /* Used to store return values.                       */
   int workinW;       /* Flag whether an active W vector is used as tempwork*/
   int entireSpace = (*basisSize+*numLocked >= primme->n); /* bool if entire*/
                      /* space is built, so current ritzvecs are accurate.  */

   double *norms, *tnorms; /* Array of residual norms, and temp array       */
   double attainableTol;   /* Used to verify a practical convergence problem*/
   double *residual;  /* Stores residual vector                             */
   double ztmp;       /* temp variable */

   /* ----------------------------------------*/
   /* Assign temporary work space for residual*/
   /* ----------------------------------------*/

   if (*basisSize < primme->maxBasisSize) {
      /* compute residuals in the next open slot of W */
      residual = &W[*basisSize*primme->nLocal];
      workinW = 0;
   }
   else {
      /* This basiSize==maxBasisSize, immediately after restart, can only occur
       * if the basisSize + numLocked = n (at which case we lock everything)
       * OR if (numConverged + restartSize + numPrevRetain > basisSize), ie.
       * too many converged. Since we do not know which evec will be locked
       * we use the W[LAST] as temporary space, but only after W[LAST] has 
       * been used to compute residual(LAST) -the while loop starts from LAST.
       * After all lockings, if the LAST evec was not locked, we must  
       * recompute W[LAST]=Av. This matvec event is extremely infrequent */
      residual = &W[(*basisSize-1)*primme->nLocal];
      workinW = 1;
   }

   /* -------------------------------------*/
   /* Set the tolerance, and attainableTol */
   /* -------------------------------------*/
   
   if (primme->aNorm <= 0.0L) {
      tol = tol * (*aNormEstimate);
   }
   attainableTol=max(tol,sqrt(primme->numOrthoConst+*numLocked)*(*maxConvTol));

   /* -------------------------------------------------------- */
   /* Determine how many Ritz vectors converged before restart */
   /* -------------------------------------------------------- */

   i = *basisSize - 1;
   while ((flag[i] == LOCK_IT ||flag[i] == UNCONDITIONAL_LOCK_IT) && i >= 0) {
      i--;
   }
      
   numCandidates = *basisSize - i - 1;

   if (numCandidates == 0) {
      return 0;
   }

   /* --------------------------------- */
   /* Compute residuals and their norms */
   /* --------------------------------- */

   tnorms = (double *) rwork;
   norms  = tnorms + numCandidates;

   for (i = *basisSize-1, candidate = numCandidates-1;  
      i >= *basisSize-numCandidates; i--, candidate--) {
      Num_dcopy_dprimme(primme->nLocal, &W[primme->nLocal*i], 1, residual, 1);
      ztmp = -hVals[i];
      Num_axpy_dprimme(primme->nLocal, ztmp, &V[primme->nLocal*i],1,residual,1);
      tnorms[candidate] = Num_dot_dprimme(primme->nLocal,residual,1,residual,1);
   }

   /* Global sum the dot products */
   (*primme->globalSumDouble)(tnorms, norms, &numCandidates, primme); 

   numRecentlyLocked = 0;

   /* ------------------------------------------------------------------- */
   /* Check the convergence of each residual norm.  If the Ritz vector is */
   /* converged, then lock it.                                            */
   /* ------------------------------------------------------------------- */

   for (i = *basisSize - numCandidates, candidate = 0; i < *basisSize; i++, 
      candidate++) {

      norms[candidate] = sqrt(norms[candidate]);

      /* If the vector has become (regularly or practically) unconverged, */
      /* then flag it, else lock it and replace it with an initial guess, */
      /* if one is available. Exception: If the entire space is spanned,  */
      /* we can't do better, so lock it.                                  */


      if ((flag[i]!=UNCONDITIONAL_LOCK_IT && norms[candidate] >= tol 
                                   && !entireSpace ) ||
          (flag[i]==UNCONDITIONAL_LOCK_IT && norms[candidate] >= attainableTol
                                   && !entireSpace )) {
         flag[i] = UNCONVERGED;
      }
      else {
        /* If an unconditional lock has become converged, show it and */
        /* record the max converged tolerance accordingly             */
        if (norms[candidate]<tol) {
           flag[i]=LOCK_IT;
           *maxConvTol = max(*maxConvTol, tol);
        }
        else {
           *maxConvTol = max(*maxConvTol, norms[candidate]);
           *LockingProblem = 1;
        }

         if (primme->printLevel >= 2 && primme->procID == 0) { 
            fprintf(primme->outputFile, 
            "Lock epair[ %d ]= %e norm %.4e Mvecs %d Time %.4e Flag %d\n",
                  *numLocked+1, hVals[i], norms[candidate], 
                   primme->stats.numMatvecs,primme_wTimer(0),flag[i]);
            fflush(primme->outputFile);
         }

         /* Copy the converged Ritz vector to the evecs array and  */
         /* insert the converged Ritz value in sorted order within */
         /* the evals array.                                       */

         Num_dcopy_dprimme(primme->nLocal, &V[primme->nLocal*i], 1, 
            &evecs[primme->nLocal*(primme->numOrthoConst + *numLocked)], 1);
         insertionSort(hVals[i], evals, norms[candidate], resNorms, perm, 
            *numLocked, primme);

         /* If there are any initial guesses remaining, then copy it */
         /* into the basis, else flag the vector as locked so it may */
         /* be discarded later.                                      */

         if (*numGuesses > 0) {
            Num_dcopy_dprimme(primme->nLocal, 
               &evecs[primme->nLocal*(*nextGuess)], 1, &V[primme->nLocal*i], 1);
            flag[i] = INITIAL_GUESS;
            *numGuesses = *numGuesses - 1;
            *nextGuess = *nextGuess + 1;
         }
         else {
            flag[i] = LOCKED;
         }

         *numLocked = *numLocked + 1;
         numRecentlyLocked++;
            
      }
   }
      
   evecsSize = primme->numOrthoConst + *numLocked;

   /* -------------------------------------------------------------------- */
   /* If a W vector was used as workspace for residual AND its evec has    */
   /* not been locked out,  recompute it, W = A*v. This is rare.           */
   /* -------------------------------------------------------------------- */
      if (workinW && flag[*basisSize-1] != LOCKED) {
         update_W_dprimme(V, W, *basisSize-1, 1, primme);
      }
   
   /* -------------------------------------------------------------------- */
   /* Return IF all target Ritz vectors have been locked, ELSE update the  */
   /* evecsHat array by applying the preconditioner (if preconditioning is */
   /* needed, and JDQMR with right, skew Q projector is applied            */
   /* -------------------------------------------------------------------- */

   if (*numLocked >= primme->numEvals) {
      return 0;
   }
   else if (UDU != NULL) {

      /* Compute K^{-1}x for all newly locked eigenvectors */

      newStart = primme->nLocal*(evecsSize - numRecentlyLocked);
      (*primme->applyPreconditioner)( &evecs[newStart], &evecsHat[newStart], 
                                    &numRecentlyLocked, primme);
      primme->stats.numPreconds += numRecentlyLocked;

      /* Update the projection evecs'*evecsHat now that evecs and evecsHat   */
      /* have been expanded by numRecentlyLocked columns.  Required          */
      /* workspace is numLocked*numEvals.  The most ever needed would be     */
      /* maxBasisSize*numEvals.                                              */

      update_projection_dprimme(evecs, evecsHat, M, 
         evecsSize-numRecentlyLocked, primme->numOrthoConst+primme->numEvals, 
         numRecentlyLocked, rwork, primme);

      ret = UDUDecompose_dprimme(M, UDU, ipivot, evecsSize, rwork, 
         rworkSize, primme);

      if (ret != 0) {
         primme_PushErrorMessage(Primme_lock_vectors, Primme_ududecompose, ret,
            __FILE__, __LINE__, primme);
         return UDUDECOMPOSE_FAILURE;
      }

   }


   /* --------------------------------------------------------------------- */
   /* Swap, towards the end of the basis, vectors that were locked but not  */
   /* replaced by new initial guesses.                                      */
   /* --------------------------------------------------------------------- */

   numDeflated = swap_flagVecs_toEnd(*basisSize, LOCKED, V, W, H, hVals, flag, 
      primme);

   /* --------------------------------------------------------------------- */
   /* Reduce the basis size by numDeflated and swap the new initial guesses */
   /* towards the end of the basis.                                         */
   /* --------------------------------------------------------------------- */
  
   numReplaced = swap_flagVecs_toEnd(*basisSize-numDeflated, INITIAL_GUESS, 
      V, W, H, hVals, flag, primme);

   *basisSize = *basisSize - (numDeflated + numReplaced);

   if (primme->printLevel >= 5 && primme->procID == 0) {
      fprintf(primme->outputFile, "numDeflated: %d numReplaced: %d \
              basisSize: %d\n", numDeflated, numReplaced, *basisSize);
   }
Esempio n. 4
0
/*******************************************************************************
 * Subroutine check_practical_convergence()
 *
 *       This function is called after swaping has pushed converged (C)
 *       and to be projected (P) evecs at the end of blockSize.
 *       Makes C, P contiguous, projects P, checks and finds practically 
 *       converged evecs (p), and makes p contiguous to C, updating
 *       flags[], blockNorms[], and numVacancies. Eg:
 *
 *          blockSize 
 *       |------CPCCPPCP|  -> |------PPPPCCCC|  ->  |------PpPpCCCC| ->
 *       |------PPppCCCC|, numVacancies = 6
 *
 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 *                    
 * INPUT ARRAYS AND PARAMETERS
 * ---------------------------
 * evecs           The locked eigenvectors
 * numLocked       The number of locked eigenvectors
 * basisSize       Number of vectors in the basis
 * blockSize       The number of block vectors
 * start           Starting index in V,W of vectors converged or to be projected
 * numToProject    The number of vectors to project. 
 * tol             The required convergence tolerance
 * rwork           real work array of size: 2*maxEvecsSize*primme->maxBlockSize
 * primme          Structure containing various solver parameters
 *
 *
 * OUTPUT ARRAYS AND PARAMETERS
 * ----------------------------
 * V               The basis vectors
 * W               A*V
 * iev             Indicates which Ritz value each block vector corresponds to
 * flags           Indicates which Ritz pairs have converged
 * blockNorms      The norms of the block vectors to be targeted
 * recentlyConverged Number of converged vectors in the whole basis V
 *                   = converged+practicallyConverged 
 * numVacancies    Number of Ritz values between left and right that were
 *                 declared converged or practicallyConverged. [left, right]
 *                 can be smaller than the whole V. See while-loop in 
 *                 check_convergence.
 * left, right     Indices indicating which vectors are to be replaced
 * ievMax          Index of the next Ritz value to be targeted by the block
 ******************************************************************************/
static void check_practical_convergence(double *V, double *W, 
   double *evecs, int numLocked, int basisSize, int blockSize, int start, 
   int numToProject, int *iev, int *flags, double *blockNorms, double tol, 
   int *recentlyConverged, int *numVacancies, double *rwork, 
   primme_params *primme) {

   int i, n, dimEvecs;
   int count; 
   double normPr; 
   double normDiff;
   double *overlaps;  /* Pointer in rwork to keep Q'*r */
   double tpone = +1.0e+00, tzero = +0.0e+00, tmone = -1.0e+00; /* constants */

   /* convenience variables */
   n        = primme->nLocal;
   dimEvecs = primme->numOrthoConst + numLocked;

   /* Subdivide rwork */
   overlaps = rwork + dimEvecs*primme->maxBlockSize;

   /* --------------------------------------------------------------- */
   /* Reset any TO_BE_PROJECTED flags back to UNCONVERGED, and  swap  */
   /* again CONVERGED flags toward the end of the block. Now swapping */
   /* occurs in the block basisSize+[start:blockSize]:                */
   /*        [ . . . . . . . P P P P C C C C ]     blockSize          */
   /*                   start^       ^start+numToProject              */
   /* --------------------------------------------------------------- */

   for (i=start; i < blockSize; i++)
      if (flags[iev[i]] == TO_BE_PROJECTED)
         flags[iev[i]] = UNCONVERGED;

   if (*numVacancies > 0)
      swap_UnconvVecs(V, W, primme->nLocal, basisSize, iev, flags, 
                   blockNorms, dimEvecs, blockSize, start);

   /* ------------------------------------------------------------------ */
   /* Project the numToProject residuals agaist (I-evecs*evecs')         */
   /* ------------------------------------------------------------------ */

   /* overlaps = evecs'*residuals */

   Num_gemm_dprimme("C", "N", dimEvecs, numToProject, n, tpone, evecs, n, 
                  &W[(basisSize+start)*n], n, tzero, rwork, dimEvecs);

   count = dimEvecs*numToProject;
   (*primme->globalSumDouble)(rwork, overlaps, &count, primme);

   /* residuals = residuals - evecs*overlaps */

   Num_gemm_dprimme("N", "N", n, numToProject, dimEvecs, tmone, evecs, n, 
                  overlaps, dimEvecs, tpone, &W[(basisSize+start)*n], n);

   /* ------------------------------------------------------------------ */
   /* Compute norms^2 of the projected res and the differences from res  */ 
   /* note: ||residual - (I-QQ')residual||=||Q'*r||=||overlaps||         */
   /* ------------------------------------------------------------------ */

   for (i=0; i < numToProject; i++) {
      /* || res - (I-QQ')res || */
      rwork[i] = Num_dot_dprimme(dimEvecs, &overlaps[dimEvecs*i], 1, 
                                &overlaps[dimEvecs*i], 1);
      /* || (I-QQ')res || */
      rwork[i+numToProject] = Num_dot_dprimme(n, &W[(basisSize+start+i)*n], 1,
                                &W[(basisSize+start+i)*n], 1);
   }
   /* global sum ||overlaps|| and ||(I-QQ')r|| */
   count = 2*numToProject;
   (*primme->globalSumDouble)(rwork, &rwork[count], &count, primme);

   /* ------------------------------------------------------------------ */
   /* For each projected residual check whether there is an accuracy     */
   /* problem and, if so, declare it PRACTICALLY_CONVERGED to lock later.*/
   /* normDiff is a lower bound to the attainable accuracy for this pair */
   /* so problems exist only if normDiff > tol. Then, we stop if Tol is  */
   /* the geometric mean of normPr and r.                                */
   /* ------------------------------------------------------------------ */

   for (i=start; i < start+numToProject; i++) {

      normDiff = sqrt(rwork[i-start]);
      normPr   = sqrt(rwork[i-start+numToProject]);

      /* printf(" R Pr |R-Pr| %e %e %e \n", blockNorms[i],normPr,normDiff); */

      if (normDiff >= tol && normPr < tol*tol/blockNorms[i]/2) {
         if (primme->printLevel >= 5 && primme->procID == 0) {
            fprintf(primme->outputFile, 
               " PRACTICALLY_CONVERGED %d norm(I-QQt)r %e bound %e\n",
                iev[i],normPr,tol*tol/normDiff);
                  fflush(primme->outputFile);
         }
         flags[iev[i]] = PRACTICALLY_CONVERGED;
         (*numVacancies)++;
         if (numLocked + iev[i] < primme->numEvals){
            recentlyConverged++;
         }
      } /* if practically converged */

   } /* for each projected residual */

   /* ------------------------------------------------------------------ */
   /* Finally swap all practically converged toward the end of the block */
   /* to be contiguous with the converged ones. Swap all relevant arrays */
   /* ------------------------------------------------------------------ */

   start = blockSize - *numVacancies;

   swap_UnconvVecs(V, W, primme->nLocal, basisSize, iev, flags, blockNorms, 
                         dimEvecs, blockSize, start);

}