| void PETSC_STDCALL stgettype_(ST *st,CHAR name PETSC_MIXED_LEN(len),PetscErrorCode *ierr PETSC_END_LEN(len)) |
| { |
| char *tname; |
| const char *tname; |
| *ierr = STGetType(*st,&tname); |
| #if defined(PETSC_USES_CPTOFCD) |
| ierr = STInnerProduct(st,x,x,&p);CHKERRQ(ierr); |
| if (PetscAbsScalar(p)<PETSC_MACHINE_EPSILON) |
| PetscLogInfo((st,"STNorm: Zero norm, either the vector is zero or a semi-inner product is being used\n")); |
| PetscVerboseInfo((st,"STNorm: Zero norm, either the vector is zero or a semi-inner product is being used\n")); |
| #if defined(PETSC_USE_COMPLEX) |
| if (PetscRealPart(p)<0.0 || PetscAbsReal(PetscImaginaryPart(p))>PETSC_MACHINE_EPSILON) |
| ierr = STInnerProductEnd(st,x,x,&p);CHKERRQ(ierr); |
| if (PetscAbsScalar(p)<PETSC_MACHINE_EPSILON) |
| PetscLogInfo((st,"STNorm: Zero norm, either the vector is zero or a semi-inner product is being used\n")); |
| PetscVerboseInfo((st,"STNorm: Zero norm, either the vector is zero or a semi-inner product is being used\n")); |
| #if defined(PETSC_USE_COMPLEX) |
| if (PetscRealPart(p)<0.0 || PetscAbsReal(PetscImaginaryPart(p))>PETSC_MACHINE_EPSILON) |
| PetscFunctionBegin; |
| PetscValidHeaderSpecific(st,ST_COOKIE,1); |
| PetscLogInfo((st,"STSetUp:Setting up new ST\n")); |
| PetscVerboseInfo((st,"STSetUp:Setting up new ST\n")); |
| if (st->setupcalled) PetscFunctionReturn(0); |
| ierr = PetscLogEventBegin(ST_SetUp,st,0,0,0);CHKERRQ(ierr); |
| if (!st->A) {SETERRQ(PETSC_ERR_ARG_WRONGSTATE,"Matrix must be set first");} |
| if (opt) { |
| ierr = PetscStrstr(logList, "st", &className);CHKERRQ(ierr); |
| if (className) { |
| ierr = PetscLogInfoDeactivateClass(ST_COOKIE);CHKERRQ(ierr); |
| ierr = PetscVerboseInfoDeactivateClass(ST_COOKIE);CHKERRQ(ierr); |
| } |
| } |
| /* Process summary exclusions */ |
| { |
| PetscErrorCode ierr; |
| STType cstr; |
| char* str; |
| const char* str; |
| PetscTruth isascii,isstring; |
| PetscViewerFormat format; |
| #undef __FUNCT__ |
| #define __FUNCT__ "STRegister" |
| PetscErrorCode STRegister(char *sname,char *path,char *name,int (*function)(ST)) |
| PetscErrorCode STRegister(const char *sname,const char *path,const char *name,int (*function)(ST)) |
| { |
| PetscErrorCode ierr; |
| char fullname[256]; |
| if (reason<0) { SETERRQ1(0,"Warning: KSP did not converge (%d)",reason); } |
| ierr = KSPGetIterationNumber(st->ksp,&its);CHKERRQ(ierr); |
| st->lineariterations += its; |
| PetscLogInfo((st,"ST: linear solve iterations=%d\n",its)); |
| PetscVerboseInfo((st,"ST: linear solve iterations=%d\n",its)); |
| PetscFunctionReturn(0); |
| } |
| if (reason<0) { SETERRQ1(0,"Warning: KSP did not converge (%d)",reason); } |
| ierr = KSPGetIterationNumber(st->ksp,&its);CHKERRQ(ierr); |
| st->lineariterations += its; |
| PetscLogInfo((st,"ST: linear solve iterations=%d\n",its)); |
| PetscVerboseInfo((st,"ST: linear solve iterations=%d\n",its)); |
| PetscFunctionReturn(0); |
| } |
| ierr = MatMult(A,V[i],w);CHKERRQ(ierr); |
| ierr = VecNorm(w,NORM_2,&norm);CHKERRQ(ierr); |
| if (norm < 1e-8) { |
| PetscLogInfo((st,"STCheckNullSpace: vector %i norm=%g\n",i,norm)); |
| PetscVerboseInfo((st,"STCheckNullSpace: vector %i norm=%g\n",i,norm)); |
| T[c] = V[i]; |
| c++; |
| } |
| }; |
| EXTERN PetscErrorCode STRegisterAll(char*); |
| EXTERN PetscErrorCode STRegister(char*,char*,char*,int(*)(ST)); |
| EXTERN PetscErrorCode STRegister(const char*,const char*,const char*,int(*)(ST)); |
| #if defined(PETSC_USE_DYNAMIC_LIBRARIES) |
| #define STRegisterDynamic(a,b,c,d) STRegister(a,b,c,0) |
| #else |
| } |
| EXTERN PetscErrorCode EPSRegisterAll(char *); |
| EXTERN PetscErrorCode EPSRegister(char*,char*,char*,int(*)(EPS)); |
| EXTERN PetscErrorCode EPSRegister(const char*,const char*,const char*,int(*)(EPS)); |
| #if defined(PETSC_USE_DYNAMIC_LIBRARIES) |
| #define EPSRegisterDynamic(a,b,c,d) EPSRegister(a,b,c,0) |
| #else |
| PetscReal abnrm,*scale,dummy; |
| PetscScalar *work; |
| int ilo,ihi,lwork = 4*n,info; |
| char *jobvr,*jobvl; |
| const char *jobvr,*jobvl; |
| #if defined(PETSC_USE_COMPLEX) |
| PetscReal *rwork; |
| #else |
| PetscReal *rscale,*lscale,abnrm,bbnrm,dummy; |
| PetscScalar *alpha,*beta,*work; |
| int i,ilo,ihi,idummy,info; |
| char *jobvr,*jobvl; |
| const char *jobvr,*jobvl; |
| #if defined(PETSC_USE_COMPLEX) |
| PetscReal *rwork; |
| int lwork = 2*n; |
| PetscReal abstol = 0.0,vl,vu; |
| PetscScalar *work; |
| int il,iu,m,*isuppz,*iwork,liwork = 10*n,info; |
| char *jobz; |
| const char *jobz; |
| #if defined(PETSC_USE_COMPLEX) |
| PetscReal *rwork; |
| int lwork = 18*n,lrwork = 24*n; |
| PetscScalar *work; |
| int itype = 1,*iwork,info, |
| liwork = V ? 5*n+3 : 1; |
| char *jobz; |
| const char *jobz; |
| #if defined(PETSC_USE_COMPLEX) |
| PetscReal *rwork; |
| int lwork = V ? n*n+2*n : n+1, |
| void PETSC_STDCALL epsgettype_(EPS *eps,CHAR name PETSC_MIXED_LEN(len),PetscErrorCode *ierr PETSC_END_LEN(len)) |
| { |
| char *tname; |
| const char *tname; |
| *ierr = EPSGetType(*eps,&tname);if (*ierr) return; |
| #if defined(PETSC_USES_CPTOFCD) |
| if (opt) { |
| ierr = PetscStrstr(logList, "eps", &className);CHKERRQ(ierr); |
| if (className) { |
| ierr = PetscLogInfoDeactivateClass(EPS_COOKIE);CHKERRQ(ierr); |
| ierr = PetscVerboseInfoDeactivateClass(EPS_COOKIE);CHKERRQ(ierr); |
| } |
| } |
| /* Process summary exclusions */ |
| PetscErrorCode EPSView(EPS eps,PetscViewer viewer) |
| { |
| PetscErrorCode ierr; |
| char *type, *which; |
| PetscTruth isascii; |
| const char *type, *which; |
| PetscTruth isascii; |
| PetscFunctionBegin; |
| PetscValidHeaderSpecific(eps,EPS_COOKIE,1); |
| #undef __FUNCT__ |
| #define __FUNCT__ "EPSRegister" |
| PetscErrorCode EPSRegister(char *sname,char *path,char *name,int (*function)(EPS)) |
| PetscErrorCode EPSRegister(const char *sname,const char *path,const char *name,int (*function)(EPS)) |
| { |
| PetscErrorCode ierr; |
| char fullname[256]; |
| /* normalize v_k: r_{k,k} = ||v_k||_2; v_k = v_k/r_{k,k} */ |
| if (norm==0.0 || lindep) { |
| PetscLogInfo((eps,"EPSQRDecomposition: Linearly dependent vector found, generating a new random vector\n")); |
| PetscVerboseInfo((eps,"EPSQRDecomposition: Linearly dependent vector found, generating a new random vector\n")); |
| ierr = SlepcVecSetRandom(V[k]);CHKERRQ(ierr); |
| ierr = STNorm(eps->OP,V[k],&norm);CHKERRQ(ierr); |
| } |
| /* if ||q|| < eta ||h|| */ |
| if ((eps->orthog_ref == EPS_ORTH_REFINE_IFNEEDED && *norm < eps->orthog_eta * *hnorm) || |
| eps->orthog_ref == EPS_ORTH_REFINE_ALWAYS) { |
| PetscLogInfo((eps,"EPSClassicalGramSchmidtOrthogonalization:Performing iterative refinement wnorm %g hnorm %g\n",norm ? *norm : 0,hnorm ? *hnorm : 0)); |
| PetscVerboseInfo((eps,"EPSClassicalGramSchmidtOrthogonalization:Performing iterative refinement wnorm %g hnorm %g\n",norm ? *norm : 0,hnorm ? *hnorm : 0)); |
| /* s = W^* q */ |
| /* q = q - V s ; h = h + s */ |
| /* if ||q|| < eta ||h|| */ |
| if ((eps->orthog_ref == EPS_ORTH_REFINE_IFNEEDED && *norm < eps->orthog_eta * *hnorm) || |
| eps->orthog_ref == EPS_ORTH_REFINE_ALWAYS) { |
| PetscLogInfo((eps,"EPSModifiedGramSchmidtOrthogonalization:Performing iterative refinement wnorm %g hnorm %g\n",norm ? *norm : 0,hnorm ? *hnorm : 0)); |
| PetscVerboseInfo((eps,"EPSModifiedGramSchmidtOrthogonalization:Performing iterative refinement wnorm %g hnorm %g\n",norm ? *norm : 0,hnorm ? *hnorm : 0)); |
| for (j=0; j<n; j++) { |
| /* alpha = ( v, v_j ) */ |
| ierr = STInnerProduct(eps->OP,v,W[j],&alpha);CHKERRQ(ierr); |
| PetscReal *x,*y; |
| int i,n = eps->nev; |
| #if !defined(PETSC_USE_COMPLEX) |
| int pause; |
| int p; |
| PetscDraw draw1; |
| PetscDrawLG lg1; |
| #endif |
| #if !defined(PETSC_USE_COMPLEX) |
| if (eps->ishermitian) { |
| ierr = PetscDrawLGAddPoint(lg1,x,eps->eigr);CHKERRQ(ierr); |
| ierr = PetscDrawGetPause(draw1,&pause);CHKERRQ(ierr); |
| ierr = PetscDrawGetPause(draw1,&p);CHKERRQ(ierr); |
| ierr = PetscDrawSetPause(draw1,0);CHKERRQ(ierr); |
| ierr = PetscDrawLGDraw(lg1);CHKERRQ(ierr); |
| ierr = PetscDrawSetPause(draw1,pause);CHKERRQ(ierr); |
| ierr = PetscDrawSetPause(draw1,p);CHKERRQ(ierr); |
| } |
| #endif |
| ierr = PetscDrawLGDraw(lg);CHKERRQ(ierr); |
| ierr = EPSOrthogonalize(eps,j+1,V,V[j+1],H+m*j,&norm,&breakdown);CHKERRQ(ierr); |
| H[(m+1)*j+1] = norm; |
| if (breakdown) { |
| PetscLogInfo((eps,"Breakdown in Arnoldi method (norm=%g)\n",norm)); |
| PetscVerboseInfo((eps,"Breakdown in Arnoldi method (norm=%g)\n",norm)); |
| ierr = EPSGetStartVector(eps,j,V[j+1]);CHKERRQ(ierr); |
| } else { |
| ierr = VecScale(V[j+1],1/norm);CHKERRQ(ierr); |
| ierr = VecSet(eps->AV[i],0.0);CHKERRQ(ierr); |
| ierr = VecMAXPY(eps->AV[i],ncv,U+ncv*i,eps->V);CHKERRQ(ierr); |
| } |
| if (i<ncv) SETERRQ(1,"KK"); |
| for (i=eps->nconv;(i<=k || orthog) && i<ncv;i++) { |
| ierr = VecCopy(eps->AV[i],eps->V[i]);CHKERRQ(ierr); |
| } |
| if (i<ncv) SETERRQ(1,"KK"); |
| eps->nconv = k; |
| EPSMonitor(eps,eps->its,eps->nconv,eps->eigr,eps->eigi,eps->errest,ncv); |
| Vec *Qr=eps->V, *Ql=eps->W; |
| PetscScalar *Hr=eps->T,*Ur,*work; |
| PetscScalar *Hl=eps->Tl,*Ul; |
| PetscReal beta,gamma; |
| PetscReal beta,g; |
| PetscScalar *eigr,*eigi,*aux; |
| PetscFunctionBegin; |
| /* Compute an ncv-step Arnoldi factorization for both A and A' */ |
| ierr = EPSBasicArnoldi(eps,PETSC_FALSE,Hr,Qr,eps->nconv,ncv,fr,&beta);CHKERRQ(ierr); |
| ierr = EPSBasicArnoldi(eps,PETSC_TRUE,Hl,Ql,eps->nconv,ncv,fl,&gamma);CHKERRQ(ierr); |
| ierr = EPSBasicArnoldi(eps,PETSC_TRUE,Hl,Ql,eps->nconv,ncv,fl,&g);CHKERRQ(ierr); |
| ierr = EPSBiOrthogonalize(eps,ncv,Qr,Ql,fr,aux,PETSC_NULL);CHKERRQ(ierr); |
| for (i=0;i<ncv;i++) { |
| } |
| ierr = EPSBiOrthogonalize(eps,ncv,Ql,Qr,fl,aux,PETSC_NULL);CHKERRQ(ierr); |
| for (i=0;i<ncv;i++) { |
| Hl[ncv*(ncv-1)+i] += gamma * aux[i]; |
| Hl[ncv*(ncv-1)+i] += g * aux[i]; |
| } |
| /* Reduce H to (quasi-)triangular form, H <- U H U' */ |
| /* Compute residual norm estimates */ |
| ierr = ArnoldiResiduals(Hr,Ur,beta,eps->nconv,ncv,eps->eigr,eps->eigi,eps->errest,work);CHKERRQ(ierr); |
| ierr = ArnoldiResiduals(Hl,Ul,gamma,eps->nconv,ncv,eigr,eigi,eps->errest_left,work);CHKERRQ(ierr); |
| ierr = ArnoldiResiduals(Hl,Ul,g,eps->nconv,ncv,eigr,eigi,eps->errest_left,work);CHKERRQ(ierr); |
| /* Lock converged eigenpairs and update the corresponding vectors, |
| including the restart vector: V(:,idx) = V*U(:,idx) */ |
| if (breakdown) { |
| restart = -1; |
| PetscLogInfo((eps,"Breakdown in Lanczos method (norm=%g)\n",beta)); |
| PetscVerboseInfo((eps,"Breakdown in Lanczos method (norm=%g)\n",beta)); |
| } |
| if (k<eps->nev) { |
| } else { |
| /* Use random vector for restarting */ |
| ierr = SlepcVecSetRandom(eps->V[k]);CHKERRQ(ierr); |
| PetscLogInfo((eps,"Using random vector for restart\n")); |
| PetscVerboseInfo((eps,"Using random vector for restart\n")); |
| } |
| } |
| ierr = EPSOrthogonalize(eps,eps->nds+k,eps->DSV,eps->V[k],PETSC_NULL,&norm,&breakdown);CHKERRQ(ierr); |
| if (breakdown) { |
| eps->reason = EPS_DIVERGED_BREAKDOWN; |
| PetscLogInfo((eps,"Unable to generate more start vectors\n")); |
| PetscVerboseInfo((eps,"Unable to generate more start vectors\n")); |
| } else { |
| ierr = VecScale(eps->V[k],1.0/norm);CHKERRQ(ierr); |
| } |
| ierr = MatShift(la->A,shift);CHKERRQ(ierr); |
| } |
| } else { |
| PetscLogInfo((eps,"EPSSetup_LAPACK: Using slow explicit operator\n")); |
| PetscVerboseInfo((eps,"EPSSetup_LAPACK: Using slow explicit operator\n")); |
| la->A = PETSC_NULL; |
| la->B = PETSC_NULL; |
| ierr = STComputeExplicitOperator(eps->OP,&la->OP);CHKERRQ(ierr); |
| #endif |
| SlepcInitializeCalled = PETSC_TRUE; |
| PetscLogInfo((0,"SlepcInitialize: SLEPc successfully started from Fortran\n")); |
| PetscVerboseInfo((0,"SlepcInitialize: SLEPc successfully started from Fortran\n")); |
| } |
| #endif |
| SlepcInitializeCalled = PETSC_TRUE; |
| PetscLogInfo((0,"SlepcInitialize: SLEPc successfully started\n")); |
| PetscVerboseInfo((0,"SlepcInitialize: SLEPc successfully started\n")); |
| PetscFunctionReturn(info); |
| } |
| PetscErrorCode info=0; |
| PetscFunctionBegin; |
| PetscLogInfo((0,"SlepcFinalize: SLEPc successfully ended!\n")); |
| PetscVerboseInfo((0,"SlepcFinalize: SLEPc successfully ended!\n")); |
| if (SlepcBeganPetsc) { |
| info = PetscFinalize();CHKERRQ(info); |