PETSC_EXTERN void PETSC_STDCALL pcapplytransposeexists_(PC pc,PetscBool *flg, int *__ierr ){ *__ierr = PCApplyTransposeExists( (PC)PetscToPointer((pc) ),flg); }
PetscErrorCode KSPSolve_CGNE(KSP ksp) { PetscErrorCode ierr; PetscInt i,stored_max_it,eigs; PetscScalar dpi,a = 1.0,beta,betaold = 1.0,b = 0,*e = 0,*d = 0; PetscReal dp = 0.0; Vec X,B,Z,R,P,T; KSP_CG *cg; Mat Amat,Pmat; PetscBool diagonalscale,transpose_pc; PetscFunctionBegin; ierr = PCGetDiagonalScale(ksp->pc,&diagonalscale);CHKERRQ(ierr); if (diagonalscale) SETERRQ1(PetscObjectComm((PetscObject)ksp),PETSC_ERR_SUP,"Krylov method %s does not support diagonal scaling",((PetscObject)ksp)->type_name); ierr = PCApplyTransposeExists(ksp->pc,&transpose_pc);CHKERRQ(ierr); cg = (KSP_CG*)ksp->data; eigs = ksp->calc_sings; stored_max_it = ksp->max_it; X = ksp->vec_sol; B = ksp->vec_rhs; R = ksp->work[0]; Z = ksp->work[1]; P = ksp->work[2]; T = ksp->work[3]; #define VecXDot(x,y,a) (((cg->type) == (KSP_CG_HERMITIAN)) ? VecDot(x,y,a) : VecTDot(x,y,a)) if (eigs) {e = cg->e; d = cg->d; e[0] = 0.0; } ierr = PCGetOperators(ksp->pc,&Amat,&Pmat);CHKERRQ(ierr); ksp->its = 0; ierr = MatMultTranspose(Amat,B,T);CHKERRQ(ierr); if (!ksp->guess_zero) { ierr = KSP_MatMult(ksp,Amat,X,P);CHKERRQ(ierr); ierr = KSP_MatMultTranspose(ksp,Amat,P,R);CHKERRQ(ierr); ierr = VecAYPX(R,-1.0,T);CHKERRQ(ierr); } else { ierr = VecCopy(T,R);CHKERRQ(ierr); /* r <- b (x is 0) */ } ierr = KSP_PCApply(ksp,R,T);CHKERRQ(ierr); if (transpose_pc) { ierr = KSP_PCApplyTranspose(ksp,T,Z);CHKERRQ(ierr); } else { ierr = KSP_PCApply(ksp,T,Z);CHKERRQ(ierr); } if (ksp->normtype == KSP_NORM_PRECONDITIONED) { ierr = VecNorm(Z,NORM_2,&dp);CHKERRQ(ierr); /* dp <- z'*z */ } else if (ksp->normtype == KSP_NORM_UNPRECONDITIONED) { ierr = VecNorm(R,NORM_2,&dp);CHKERRQ(ierr); /* dp <- r'*r */ } else if (ksp->normtype == KSP_NORM_NATURAL) { ierr = VecXDot(Z,R,&beta);CHKERRQ(ierr); dp = PetscSqrtReal(PetscAbsScalar(beta)); } else dp = 0.0; ierr = KSPLogResidualHistory(ksp,dp);CHKERRQ(ierr); ierr = KSPMonitor(ksp,0,dp);CHKERRQ(ierr); ksp->rnorm = dp; ierr = (*ksp->converged)(ksp,0,dp,&ksp->reason,ksp->cnvP);CHKERRQ(ierr); /* test for convergence */ if (ksp->reason) PetscFunctionReturn(0); i = 0; do { ksp->its = i+1; ierr = VecXDot(Z,R,&beta);CHKERRQ(ierr); /* beta <- r'z */ if (beta == 0.0) { ksp->reason = KSP_CONVERGED_ATOL; ierr = PetscInfo(ksp,"converged due to beta = 0\n");CHKERRQ(ierr); break; #if !defined(PETSC_USE_COMPLEX) } else if (beta < 0.0) { ksp->reason = KSP_DIVERGED_INDEFINITE_PC; ierr = PetscInfo(ksp,"diverging due to indefinite preconditioner\n");CHKERRQ(ierr); break; #endif } if (!i) { ierr = VecCopy(Z,P);CHKERRQ(ierr); /* p <- z */ b = 0.0; } else { b = beta/betaold; if (eigs) { if (ksp->max_it != stored_max_it) SETERRQ(PetscObjectComm((PetscObject)ksp),PETSC_ERR_SUP,"Can not change maxit AND calculate eigenvalues"); e[i] = PetscSqrtReal(PetscAbsScalar(b))/a; } ierr = VecAYPX(P,b,Z);CHKERRQ(ierr); /* p <- z + b* p */ } betaold = beta; ierr = MatMult(Amat,P,T);CHKERRQ(ierr); ierr = MatMultTranspose(Amat,T,Z);CHKERRQ(ierr); ierr = VecXDot(P,Z,&dpi);CHKERRQ(ierr); /* dpi <- z'p */ a = beta/dpi; /* a = beta/p'z */ if (eigs) d[i] = PetscSqrtReal(PetscAbsScalar(b))*e[i] + 1.0/a; ierr = VecAXPY(X,a,P);CHKERRQ(ierr); /* x <- x + ap */ ierr = VecAXPY(R,-a,Z);CHKERRQ(ierr); /* r <- r - az */ if (ksp->normtype == KSP_NORM_PRECONDITIONED) { ierr = KSP_PCApply(ksp,R,T);CHKERRQ(ierr); if (transpose_pc) { ierr = KSP_PCApplyTranspose(ksp,T,Z);CHKERRQ(ierr); } else { ierr = KSP_PCApply(ksp,T,Z);CHKERRQ(ierr); } ierr = VecNorm(Z,NORM_2,&dp);CHKERRQ(ierr); /* dp <- z'*z */ } else if (ksp->normtype == KSP_NORM_UNPRECONDITIONED) { ierr = VecNorm(R,NORM_2,&dp);CHKERRQ(ierr); } else if (ksp->normtype == KSP_NORM_NATURAL) { dp = PetscSqrtReal(PetscAbsScalar(beta)); } else { dp = 0.0; } ksp->rnorm = dp; ierr = KSPLogResidualHistory(ksp,dp);CHKERRQ(ierr); ierr = KSPMonitor(ksp,i+1,dp);CHKERRQ(ierr); ierr = (*ksp->converged)(ksp,i+1,dp,&ksp->reason,ksp->cnvP);CHKERRQ(ierr); if (ksp->reason) break; if (ksp->normtype != KSP_NORM_PRECONDITIONED) { if (transpose_pc) { ierr = KSP_PCApplyTranspose(ksp,T,Z);CHKERRQ(ierr); } else { ierr = KSP_PCApply(ksp,T,Z);CHKERRQ(ierr); } } i++; } while (i<ksp->max_it); if (i >= ksp->max_it) ksp->reason = KSP_DIVERGED_ITS; PetscFunctionReturn(0); }