Actual source code: slepcutil.c

  1: /*
  2:    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  3:    SLEPc - Scalable Library for Eigenvalue Problem Computations
  4:    Copyright (c) 2002-, Universitat Politecnica de Valencia, Spain

  6:    This file is part of SLEPc.
  7:    SLEPc is distributed under a 2-clause BSD license (see LICENSE).
  8:    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  9: */

 11: #include <slepc/private/slepcimpl.h>

 13: /*
 14:    Internal functions used to register monitors.
 15:  */
 16: PetscErrorCode SlepcMonitorMakeKey_Internal(const char name[],PetscViewerType vtype,PetscViewerFormat format,char key[])
 17: {
 18:   PetscFunctionBegin;
 19:   PetscCall(PetscStrncpy(key,name,PETSC_MAX_PATH_LEN));
 20:   PetscCall(PetscStrlcat(key,":",PETSC_MAX_PATH_LEN));
 21:   PetscCall(PetscStrlcat(key,vtype,PETSC_MAX_PATH_LEN));
 22:   PetscCall(PetscStrlcat(key,":",PETSC_MAX_PATH_LEN));
 23:   PetscCall(PetscStrlcat(key,PetscViewerFormats[format],PETSC_MAX_PATH_LEN));
 24:   PetscFunctionReturn(PETSC_SUCCESS);
 25: }

 27: PetscErrorCode PetscViewerAndFormatCreate_Internal(PetscViewer viewer,PetscViewerFormat format,void *ctx,PetscViewerAndFormat **vf)
 28: {
 29:   PetscFunctionBegin;
 30:   PetscCall(PetscViewerAndFormatCreate(viewer,format,vf));
 31:   (*vf)->data = ctx;
 32:   PetscFunctionReturn(PETSC_SUCCESS);
 33: }

 35: /*
 36:    Given n vectors in V, this function gets references of them into W.
 37:    If m<0 then some previous non-processed vectors remain in W and must be freed.
 38:  */
 39: PetscErrorCode SlepcBasisReference_Private(PetscInt n,Vec *V,PetscInt *m,Vec **W)
 40: {
 41:   PetscInt       i;

 43:   PetscFunctionBegin;
 44:   for (i=0;i<n;i++) PetscCall(PetscObjectReference((PetscObject)V[i]));
 45:   PetscCall(SlepcBasisDestroy_Private(m,W));
 46:   if (n>0) {
 47:     PetscCall(PetscMalloc1(n,W));
 48:     for (i=0;i<n;i++) (*W)[i] = V[i];
 49:     *m = -n;
 50:   }
 51:   PetscFunctionReturn(PETSC_SUCCESS);
 52: }

 54: /*
 55:    Destroys a set of vectors.
 56:    A negative value of m indicates that W contains vectors to be destroyed.
 57:  */
 58: PetscErrorCode SlepcBasisDestroy_Private(PetscInt *m,Vec **W)
 59: {
 60:   PetscInt       i;

 62:   PetscFunctionBegin;
 63:   if (*m<0) {
 64:     for (i=0;i<-(*m);i++) PetscCall(VecDestroy(&(*W)[i]));
 65:     PetscCall(PetscFree(*W));
 66:   }
 67:   *m = 0;
 68:   PetscFunctionReturn(PETSC_SUCCESS);
 69: }

 71: /*@
 72:    SlepcSNPrintfScalar - Prints a `PetscScalar` variable to a string of
 73:    given length.

 75:    Not Collective

 77:    Input Parameters:
 78: +  str - the string to print to
 79: .  len - the length of str
 80: .  val - scalar value to be printed
 81: -  exp - to be used within an expression, print leading sign and parentheses
 82:          in case of nonzero imaginary part

 84:    Level: developer

 86: .seealso: `PetscSNPrintf()`
 87: @*/
 88: PetscErrorCode SlepcSNPrintfScalar(char str[],size_t len,PetscScalar val,PetscBool exp)
 89: {
 90: #if PetscDefined(USE_COMPLEX)
 91:   PetscReal      re,im;
 92: #endif

 94:   PetscFunctionBegin;
 95: #if !PetscDefined(USE_COMPLEX)
 96:   if (exp) PetscCall(PetscSNPrintf(str,len,"%+g",(double)val));
 97:   else PetscCall(PetscSNPrintf(str,len,"%g",(double)val));
 98: #else
 99:   re = PetscRealPart(val);
100:   im = PetscImaginaryPart(val);
101:   if (im!=0.0) {
102:     if (exp) PetscCall(PetscSNPrintf(str,len,"+(%g%+gi)",(double)re,(double)im));
103:     else PetscCall(PetscSNPrintf(str,len,"%g%+gi",(double)re,(double)im));
104:   } else {
105:     if (exp) PetscCall(PetscSNPrintf(str,len,"%+g",(double)re));
106:     else PetscCall(PetscSNPrintf(str,len,"%g",(double)re));
107:   }
108: #endif
109:   PetscFunctionReturn(PETSC_SUCCESS);
110: }

112: /*@
113:    SlepcHasExternalPackage - Determine whether SLEPc has been configured with the
114:    given package.

116:    Not Collective

118:    Input Parameter:
119: .  pkg - external package name

121:    Output Parameter:
122: .  has - `PETSC_TRUE` if SLEPc is configured with the given package, else `PETSC_FALSE`

124:    Level: intermediate

126:    Notes:
127:    This is basically an alternative for `SLEPC_HAVE_XXX` whenever a preprocessor macro
128:    is not available/desirable, e.g., in Python.

130:    The external package name pkg is, e.g., `arpack` or `primme`.
131:    It should correspond to the name listed in  `./configure --help`.

133:    The lookup is case insensitive, i.e. looking for `ARPACK` or `arpack` is the same.

135: .seealso: [](sec:writing-prog), `EPSType`, `SVDType`
136: @*/
137: PetscErrorCode SlepcHasExternalPackage(const char pkg[], PetscBool *has)
138: {
139:   char           pkgstr[128],*loc;
140:   size_t         cnt;

142:   PetscFunctionBegin;
143:   PetscCall(PetscSNPrintfCount(pkgstr,sizeof(pkgstr),":%s:",&cnt,pkg));
144:   PetscCheck(cnt<sizeof(pkgstr),PETSC_COMM_SELF,PETSC_ERR_SUP,"Package name is too long: \"%s\"",pkg);
145:   PetscCall(PetscStrtolower(pkgstr));
146: #if defined(SLEPC_HAVE_PACKAGES)
147:   PetscCall(PetscStrstr(SLEPC_HAVE_PACKAGES,pkgstr,&loc));
148: #else
149: #error "SLEPC_HAVE_PACKAGES macro undefined. Please reconfigure"
150: #endif
151:   *has = loc? PETSC_TRUE: PETSC_FALSE;
152:   PetscFunctionReturn(PETSC_SUCCESS);
153: }

155: #if PetscDefined(USE_DEBUG)
156: /*@
157:    SlepcDebugViewMatrix - Print an array as a Matlab matrix, to be used from within a debugger.

159:    Logically Collective

161:    Input Parameters:
162: +  nrows    - number of rows of printed matrix
163: .  ncols    - number of columns of printed matrix
164: .  Xr       - real part of array to be printed
165: .  Xi       - imaginary part of array to be printed (not referenced in complex scalars)
166: .  ldx      - leading dimension
167: .  s        - name of Matlab variable
168: -  filename - optional name of a file to write the output, can be `NULL`

170:    Level: developer

172: .seealso: `SlepcInitialize()`
173: @*/
174: PetscErrorCode SlepcDebugViewMatrix(PetscInt nrows,PetscInt ncols,PetscScalar Xr[],PetscScalar Xi[],PetscInt ldx,const char s[],const char filename[])
175: {
176:   PetscInt       i,j;
177:   PetscViewer    viewer;

179:   PetscFunctionBegin;
180:   if (filename) PetscCall(PetscViewerASCIIOpen(PETSC_COMM_WORLD,filename,&viewer));
181:   else PetscCall(PetscViewerASCIIGetStdout(PETSC_COMM_WORLD,&viewer));
182:   PetscCall(PetscViewerASCIIPrintf(viewer,"%s = [\n",s));
183:   for (i=0;i<nrows;i++) {
184:     for (j=0;j<ncols;j++) {
185: #if PetscDefined(USE_COMPLEX)
186:       PetscCall(PetscViewerASCIIPrintf(viewer,"%.18g+%.18gi ",(double)PetscRealPart(Xr[i+j*ldx]),(double)PetscImaginaryPart(Xr[i+j*ldx])));
187: #else
188:       if (Xi) PetscCall(PetscViewerASCIIPrintf(viewer,"%.18g+%.18gi ",(double)Xr[i+j*ldx],(double)Xi[i+j*ldx]));
189:       else PetscCall(PetscViewerASCIIPrintf(viewer,"%.18g ",(double)Xr[i+j*ldx]));
190: #endif
191:     }
192:     PetscCall(PetscViewerASCIIPrintf(viewer,"\n"));
193:   }
194:   PetscCall(PetscViewerASCIIPrintf(viewer,"];\n"));
195:   if (filename) PetscCall(PetscViewerDestroy(&viewer));
196:   PetscFunctionReturn(PETSC_SUCCESS);
197: }
198: #endif

200: /*
201:    SlepcDebugSetMatlabStdout - sets Matlab format in stdout, to be used from within a debugger.
202:  */
203: #if PetscDefined(USE_DEBUG) && !PetscDefined(CLANG_STATIC_ANALYZER)
204: PETSC_UNUSED PetscErrorCode SlepcDebugSetMatlabStdout(void)
205: {
206:   PetscViewer    viewer;

208:   PetscFunctionBegin;
209:   PetscCall(PetscViewerASCIIGetStdout(PETSC_COMM_WORLD,&viewer));
210:   PetscCall(PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB));
211:   PetscFunctionReturn(PETSC_SUCCESS);
212: }
213: #endif