LCOV - code coverage report
Current view: top level - lme/interface - lmesolve.c (source / functions) Hit Total Coverage
Test: SLEPc Lines: 137 139 98.6 %
Date: 2024-11-21 00:34:55 Functions: 6 6 100.0 %
Legend: Lines: hit not hit

          Line data    Source code
       1             : /*
       2             :    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
       3             :    SLEPc - Scalable Library for Eigenvalue Problem Computations
       4             :    Copyright (c) 2002-, Universitat Politecnica de Valencia, Spain
       5             : 
       6             :    This file is part of SLEPc.
       7             :    SLEPc is distributed under a 2-clause BSD license (see LICENSE).
       8             :    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
       9             : */
      10             : /*
      11             :    LME routines related to the solution process
      12             : */
      13             : 
      14             : #include <slepc/private/lmeimpl.h>   /*I "slepclme.h" I*/
      15             : #include <slepcblaslapack.h>
      16             : 
      17             : /*@
      18             :    LMESolve - Solves the linear matrix equation.
      19             : 
      20             :    Collective
      21             : 
      22             :    Input Parameter:
      23             : .  lme - linear matrix equation solver context obtained from LMECreate()
      24             : 
      25             :    Options Database Keys:
      26             : +  -lme_view - print information about the solver used
      27             : .  -lme_view_mat binary - save the matrix to the default binary viewer
      28             : .  -lme_view_rhs binary - save right hand side to the default binary viewer
      29             : .  -lme_view_solution binary - save computed solution to the default binary viewer
      30             : -  -lme_converged_reason - print reason for convergence, and number of iterations
      31             : 
      32             :    Notes:
      33             :    The matrix coefficients are specified with LMESetCoefficients().
      34             :    The right-hand side is specified with LMESetRHS().
      35             :    The placeholder for the solution is specified with LMESetSolution().
      36             : 
      37             :    Level: beginner
      38             : 
      39             : .seealso: LMECreate(), LMESetUp(), LMEDestroy(), LMESetTolerances(), LMESetCoefficients(), LMESetRHS(), LMESetSolution()
      40             : @*/
      41          30 : PetscErrorCode LMESolve(LME lme)
      42             : {
      43          30 :   PetscFunctionBegin;
      44          30 :   PetscValidHeaderSpecific(lme,LME_CLASSID,1);
      45             : 
      46             :   /* call setup */
      47          30 :   PetscCall(LMESetUp(lme));
      48          30 :   lme->its    = 0;
      49          30 :   lme->errest = 0.0;
      50             : 
      51          30 :   PetscCall(LMEViewFromOptions(lme,NULL,"-lme_view_pre"));
      52             : 
      53             :   /* call solver */
      54          30 :   PetscCheck(lme->ops->solve[lme->problem_type],PetscObjectComm((PetscObject)lme),PETSC_ERR_SUP,"The specified solver does not support equation type %s",LMEProblemTypes[lme->problem_type]);
      55          30 :   PetscCall(PetscLogEventBegin(LME_Solve,lme,0,0,0));
      56          30 :   PetscUseTypeMethod(lme,solve[lme->problem_type]);
      57          30 :   PetscCall(PetscLogEventEnd(LME_Solve,lme,0,0,0));
      58             : 
      59          30 :   PetscCheck(lme->reason,PetscObjectComm((PetscObject)lme),PETSC_ERR_PLIB,"Internal error, solver returned without setting converged reason");
      60             : 
      61          30 :   PetscCheck(!lme->errorifnotconverged || lme->reason>=0,PetscObjectComm((PetscObject)lme),PETSC_ERR_NOT_CONVERGED,"LMESolve has not converged");
      62             : 
      63             :   /* various viewers */
      64          30 :   PetscCall(LMEViewFromOptions(lme,NULL,"-lme_view"));
      65          30 :   PetscCall(LMEConvergedReasonViewFromOptions(lme));
      66          30 :   PetscCall(MatViewFromOptions(lme->A,(PetscObject)lme,"-lme_view_mat"));
      67          30 :   PetscCall(MatViewFromOptions(lme->C,(PetscObject)lme,"-lme_view_rhs"));
      68          30 :   PetscCall(MatViewFromOptions(lme->X,(PetscObject)lme,"-lme_view_solution"));
      69          30 :   PetscFunctionReturn(PETSC_SUCCESS);
      70             : }
      71             : 
      72             : /*@
      73             :    LMEGetIterationNumber - Gets the current iteration number. If the
      74             :    call to LMESolve() is complete, then it returns the number of iterations
      75             :    carried out by the solution method.
      76             : 
      77             :    Not Collective
      78             : 
      79             :    Input Parameter:
      80             : .  lme - the linear matrix equation solver context
      81             : 
      82             :    Output Parameter:
      83             : .  its - number of iterations
      84             : 
      85             :    Note:
      86             :    During the i-th iteration this call returns i-1. If LMESolve() is
      87             :    complete, then parameter "its" contains either the iteration number at
      88             :    which convergence was successfully reached, or failure was detected.
      89             :    Call LMEGetConvergedReason() to determine if the solver converged or
      90             :    failed and why.
      91             : 
      92             :    Level: intermediate
      93             : 
      94             : .seealso: LMEGetConvergedReason(), LMESetTolerances()
      95             : @*/
      96           2 : PetscErrorCode LMEGetIterationNumber(LME lme,PetscInt *its)
      97             : {
      98           2 :   PetscFunctionBegin;
      99           2 :   PetscValidHeaderSpecific(lme,LME_CLASSID,1);
     100           2 :   PetscAssertPointer(its,2);
     101           2 :   *its = lme->its;
     102           2 :   PetscFunctionReturn(PETSC_SUCCESS);
     103             : }
     104             : 
     105             : /*@
     106             :    LMEGetConvergedReason - Gets the reason why the LMESolve() iteration was
     107             :    stopped.
     108             : 
     109             :    Not Collective
     110             : 
     111             :    Input Parameter:
     112             : .  lme - the linear matrix equation solver context
     113             : 
     114             :    Output Parameter:
     115             : .  reason - negative value indicates diverged, positive value converged
     116             : 
     117             :    Notes:
     118             : 
     119             :    Possible values for reason are
     120             : +  LME_CONVERGED_TOL - converged up to tolerance
     121             : .  LME_DIVERGED_ITS - required more than max_it iterations to reach convergence
     122             : -  LME_DIVERGED_BREAKDOWN - generic breakdown in method
     123             : 
     124             :    Can only be called after the call to LMESolve() is complete.
     125             : 
     126             :    Level: intermediate
     127             : 
     128             : .seealso: LMESetTolerances(), LMESolve(), LMEConvergedReason, LMESetErrorIfNotConverged()
     129             : @*/
     130           2 : PetscErrorCode LMEGetConvergedReason(LME lme,LMEConvergedReason *reason)
     131             : {
     132           2 :   PetscFunctionBegin;
     133           2 :   PetscValidHeaderSpecific(lme,LME_CLASSID,1);
     134           2 :   PetscAssertPointer(reason,2);
     135           2 :   *reason = lme->reason;
     136           2 :   PetscFunctionReturn(PETSC_SUCCESS);
     137             : }
     138             : 
     139             : /*@
     140             :    LMEGetErrorEstimate - Returns the error estimate obtained during solve.
     141             : 
     142             :    Not Collective
     143             : 
     144             :    Input Parameter:
     145             : .  lme - linear matrix equation solver context
     146             : 
     147             :    Output Parameter:
     148             : .  errest - the error estimate
     149             : 
     150             :    Notes:
     151             :    This is the error estimated internally by the solver. The actual
     152             :    error bound can be computed with LMEComputeError(). Note that some
     153             :    solvers may not be able to provide an error estimate.
     154             : 
     155             :    Level: advanced
     156             : 
     157             : .seealso: LMEComputeError()
     158             : @*/
     159           4 : PetscErrorCode LMEGetErrorEstimate(LME lme,PetscReal *errest)
     160             : {
     161           4 :   PetscFunctionBegin;
     162           4 :   PetscValidHeaderSpecific(lme,LME_CLASSID,1);
     163           4 :   PetscAssertPointer(errest,2);
     164           4 :   *errest = lme->errest;
     165           4 :   PetscFunctionReturn(PETSC_SUCCESS);
     166             : }
     167             : 
     168             : /*
     169             :    LMEComputeResidualNorm_Lyapunov - Computes the Frobenius norm of the residual matrix
     170             :    associated with the Lyapunov equation.
     171             : */
     172           4 : static PetscErrorCode LMEComputeResidualNorm_Lyapunov(LME lme,PetscReal *norm)
     173             : {
     174           4 :   PetscInt          j,n,N,k,l,lda,ldb;
     175           4 :   PetscBLASInt      n_,N_,k_,l_,lda_,ldb_;
     176           4 :   PetscScalar       *Rarray,alpha=1.0,beta=0.0;
     177           4 :   const PetscScalar *A,*B;
     178           4 :   BV                W,AX,X1,C1;
     179           4 :   Mat               R,X1m,C1m;
     180           4 :   Vec               v,w;
     181           4 :   VecScatter        vscat;
     182             : 
     183           4 :   PetscFunctionBegin;
     184           4 :   PetscCall(MatLRCGetMats(lme->C,NULL,&C1m,NULL,NULL));
     185           4 :   PetscCall(MatLRCGetMats(lme->X,NULL,&X1m,NULL,NULL));
     186           4 :   PetscCall(BVCreateFromMat(C1m,&C1));
     187           4 :   PetscCall(BVSetFromOptions(C1));
     188           4 :   PetscCall(BVCreateFromMat(X1m,&X1));
     189           4 :   PetscCall(BVSetFromOptions(X1));
     190           4 :   PetscCall(BVGetSizes(X1,&n,&N,&k));
     191           4 :   PetscCall(BVGetSizes(C1,NULL,NULL,&l));
     192           4 :   PetscCall(PetscBLASIntCast(n,&n_));
     193           4 :   PetscCall(PetscBLASIntCast(N,&N_));
     194           4 :   PetscCall(PetscBLASIntCast(k,&k_));
     195           4 :   PetscCall(PetscBLASIntCast(l,&l_));
     196             : 
     197             :   /* create W to store a redundant copy of a BV in each process */
     198           4 :   PetscCall(BVCreate(PETSC_COMM_SELF,&W));
     199           4 :   PetscCall(BVSetSizes(W,N,N,k));
     200           4 :   PetscCall(BVSetFromOptions(W));
     201           4 :   PetscCall(BVGetColumn(X1,0,&v));
     202           4 :   PetscCall(VecScatterCreateToAll(v,&vscat,NULL));
     203           4 :   PetscCall(BVRestoreColumn(X1,0,&v));
     204             : 
     205             :   /* create AX to hold the product A*X1 */
     206           4 :   PetscCall(BVDuplicate(X1,&AX));
     207           4 :   PetscCall(BVMatMult(X1,lme->A,AX));
     208             : 
     209             :   /* create dense matrix to hold the residual R=C1*C1'+AX*X1'+X1*AX' */
     210           4 :   PetscCall(MatCreateDense(PetscObjectComm((PetscObject)lme),n,n,N,N,NULL,&R));
     211             : 
     212             :   /* R=C1*C1' */
     213           4 :   PetscCall(MatDenseGetArrayWrite(R,&Rarray));
     214          12 :   for (j=0;j<l;j++) {
     215           8 :     PetscCall(BVGetColumn(C1,j,&v));
     216           8 :     PetscCall(BVGetColumn(W,j,&w));
     217           8 :     PetscCall(VecScatterBegin(vscat,v,w,INSERT_VALUES,SCATTER_FORWARD));
     218           8 :     PetscCall(VecScatterEnd(vscat,v,w,INSERT_VALUES,SCATTER_FORWARD));
     219           8 :     PetscCall(BVRestoreColumn(C1,j,&v));
     220           8 :     PetscCall(BVRestoreColumn(W,j,&w));
     221             :   }
     222           4 :   if (n) {
     223           4 :     PetscCall(BVGetArrayRead(C1,&A));
     224           4 :     PetscCall(BVGetLeadingDimension(C1,&lda));
     225           4 :     PetscCall(PetscBLASIntCast(lda,&lda_));
     226           4 :     PetscCall(BVGetArrayRead(W,&B));
     227           4 :     PetscCall(BVGetLeadingDimension(W,&ldb));
     228           4 :     PetscCall(PetscBLASIntCast(ldb,&ldb_));
     229           4 :     PetscCallBLAS("BLASgemm",BLASgemm_("N","C",&n_,&N_,&l_,&alpha,(PetscScalar*)A,&lda_,(PetscScalar*)B,&ldb_,&beta,Rarray,&n_));
     230           4 :     PetscCall(BVRestoreArrayRead(C1,&A));
     231           4 :     PetscCall(BVRestoreArrayRead(W,&B));
     232             :   }
     233           4 :   beta = 1.0;
     234             : 
     235             :   /* R+=AX*X1' */
     236         272 :   for (j=0;j<k;j++) {
     237         268 :     PetscCall(BVGetColumn(X1,j,&v));
     238         268 :     PetscCall(BVGetColumn(W,j,&w));
     239         268 :     PetscCall(VecScatterBegin(vscat,v,w,INSERT_VALUES,SCATTER_FORWARD));
     240         268 :     PetscCall(VecScatterEnd(vscat,v,w,INSERT_VALUES,SCATTER_FORWARD));
     241         268 :     PetscCall(BVRestoreColumn(X1,j,&v));
     242         268 :     PetscCall(BVRestoreColumn(W,j,&w));
     243             :   }
     244           4 :   if (n) {
     245           4 :     PetscCall(BVGetArrayRead(AX,&A));
     246           4 :     PetscCall(BVGetLeadingDimension(AX,&lda));
     247           4 :     PetscCall(PetscBLASIntCast(lda,&lda_));
     248           4 :     PetscCall(BVGetArrayRead(W,&B));
     249           4 :     PetscCallBLAS("BLASgemm",BLASgemm_("N","C",&n_,&N_,&k_,&alpha,(PetscScalar*)A,&lda_,(PetscScalar*)B,&ldb_,&beta,Rarray,&n_));
     250           4 :     PetscCall(BVRestoreArrayRead(AX,&A));
     251           4 :     PetscCall(BVRestoreArrayRead(W,&B));
     252             :   }
     253             : 
     254             :   /* R+=X1*AX' */
     255         272 :   for (j=0;j<k;j++) {
     256         268 :     PetscCall(BVGetColumn(AX,j,&v));
     257         268 :     PetscCall(BVGetColumn(W,j,&w));
     258         268 :     PetscCall(VecScatterBegin(vscat,v,w,INSERT_VALUES,SCATTER_FORWARD));
     259         268 :     PetscCall(VecScatterEnd(vscat,v,w,INSERT_VALUES,SCATTER_FORWARD));
     260         268 :     PetscCall(BVRestoreColumn(AX,j,&v));
     261         268 :     PetscCall(BVRestoreColumn(W,j,&w));
     262             :   }
     263           4 :   if (n) {
     264           4 :     PetscCall(BVGetArrayRead(X1,&A));
     265           4 :     PetscCall(BVGetLeadingDimension(AX,&lda));
     266           4 :     PetscCall(PetscBLASIntCast(lda,&lda_));
     267           4 :     PetscCall(BVGetArrayRead(W,&B));
     268           4 :     PetscCallBLAS("BLASgemm",BLASgemm_("N","C",&n_,&N_,&k_,&alpha,(PetscScalar*)A,&lda_,(PetscScalar*)B,&ldb_,&beta,Rarray,&n_));
     269           4 :     PetscCall(BVRestoreArrayRead(X1,&A));
     270           4 :     PetscCall(BVRestoreArrayRead(W,&B));
     271             :   }
     272           4 :   PetscCall(MatDenseRestoreArrayWrite(R,&Rarray));
     273             : 
     274             :   /* compute ||R||_F */
     275           4 :   PetscCall(MatNorm(R,NORM_FROBENIUS,norm));
     276             : 
     277           4 :   PetscCall(BVDestroy(&W));
     278           4 :   PetscCall(VecScatterDestroy(&vscat));
     279           4 :   PetscCall(BVDestroy(&AX));
     280           4 :   PetscCall(MatDestroy(&R));
     281           4 :   PetscCall(BVDestroy(&C1));
     282           4 :   PetscCall(BVDestroy(&X1));
     283           4 :   PetscFunctionReturn(PETSC_SUCCESS);
     284             : }
     285             : 
     286             : /*@
     287             :    LMEComputeError - Computes the error (based on the residual norm) associated
     288             :    with the last equation solved.
     289             : 
     290             :    Collective
     291             : 
     292             :    Input Parameter:
     293             : .  lme  - the linear matrix equation solver context
     294             : 
     295             :    Output Parameter:
     296             : .  error - the error
     297             : 
     298             :    Notes:
     299             :    This function is not scalable (in terms of memory or parallel communication),
     300             :    so it should not be called except in the case of small problem size. For
     301             :    large equations, use LMEGetErrorEstimate().
     302             : 
     303             :    Level: advanced
     304             : 
     305             : .seealso: LMESolve(), LMEGetErrorEstimate()
     306             : @*/
     307           4 : PetscErrorCode LMEComputeError(LME lme,PetscReal *error)
     308             : {
     309           4 :   PetscFunctionBegin;
     310           4 :   PetscValidHeaderSpecific(lme,LME_CLASSID,1);
     311           4 :   PetscAssertPointer(error,2);
     312             : 
     313           4 :   PetscCall(PetscLogEventBegin(LME_ComputeError,lme,0,0,0));
     314             :   /* compute residual norm */
     315           4 :   switch (lme->problem_type) {
     316           4 :     case LME_LYAPUNOV:
     317           4 :       PetscCall(LMEComputeResidualNorm_Lyapunov(lme,error));
     318           4 :       break;
     319           0 :     default:
     320           0 :       SETERRQ(PetscObjectComm((PetscObject)lme),PETSC_ERR_SUP,"Not implemented for equation type %s",LMEProblemTypes[lme->problem_type]);
     321             :   }
     322             : 
     323             :   /* compute error */
     324             :   /* currently we only support absolute error, so just return the norm */
     325           4 :   PetscCall(PetscLogEventEnd(LME_ComputeError,lme,0,0,0));
     326           4 :   PetscFunctionReturn(PETSC_SUCCESS);
     327             : }

Generated by: LCOV version 1.14