Date: 2023-09-05T10:18:46+00:00

Actual source code: slepcutil.c
slepc-3.19.2 2023-09-05
Report Typos and Errors

      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: /*@C
     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 defined(PETSC_USE_COMPLEX)
     91:   PetscReal      re,im;
     92: #endif

     94:   PetscFunctionBegin;
     95: #if !defined(PETSC_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: /*@C
    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", "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: 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: /*
    156:    SlepcDebugViewMatrix - prints an array as a matrix, to be used from within a debugger.
    157:    Output can be pasted to Matlab.

    159:      nrows, ncols: size of printed matrix
    160:      Xr, Xi: array to be printed (Xi not referenced in complex scalars)
    161:      ldx: leading dimension
    162:      s: name of Matlab variable
    163:      filename: optionally write output to a file
    164:  */
    165: #if defined(PETSC_USE_DEBUG)
    166: PetscErrorCode SlepcDebugViewMatrix(PetscInt nrows,PetscInt ncols,PetscScalar *Xr,PetscScalar *Xi,PetscInt ldx,const char *s,const char *filename)
    167: {
    168:   PetscInt       i,j;
    169:   PetscViewer    viewer;

    171:   PetscFunctionBegin;
    172:   if (filename) PetscCall(PetscViewerASCIIOpen(PETSC_COMM_WORLD,filename,&viewer));
    173:   else PetscCall(PetscViewerASCIIGetStdout(PETSC_COMM_WORLD,&viewer));
    174:   PetscCall(PetscViewerASCIIPrintf(viewer,"%s = [\n",s));
    175:   for (i=0;i<nrows;i++) {
    176:     for (j=0;j<ncols;j++) {
    177: #if defined(PETSC_USE_COMPLEX)
    178:       PetscCall(PetscViewerASCIIPrintf(viewer,"%.18g+%.18gi ",(double)PetscRealPart(Xr[i+j*ldx]),(double)PetscImaginaryPart(Xr[i+j*ldx])));
    179: #else
    180:       if (Xi) PetscCall(PetscViewerASCIIPrintf(viewer,"%.18g+%.18gi ",(double)Xr[i+j*ldx],(double)Xi[i+j*ldx]));
    181:       else PetscCall(PetscViewerASCIIPrintf(viewer,"%.18g ",(double)Xr[i+j*ldx]));
    182: #endif
    183:     }
    184:     PetscCall(PetscViewerASCIIPrintf(viewer,"\n"));
    185:   }
    186:   PetscCall(PetscViewerASCIIPrintf(viewer,"];\n"));
    187:   if (filename) PetscCall(PetscViewerDestroy(&viewer));
    188:   PetscFunctionReturn(PETSC_SUCCESS);
    189: }
    190: #endif

    192: /*
    193:    SlepcDebugSetMatlabStdout - sets Matlab format in stdout, to be used from within a debugger.
    194:  */
    195: #if defined(PETSC_USE_DEBUG)
    196: PETSC_UNUSED PetscErrorCode SlepcDebugSetMatlabStdout(void)
    197: {
    198:   PetscViewer    viewer;

    200:   PetscFunctionBegin;
    201:   PetscCall(PetscViewerASCIIGetStdout(PETSC_COMM_WORLD,&viewer));
    202:   PetscCall(PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB));
    203:   PetscFunctionReturn(PETSC_SUCCESS);
    204: }
    205: #endif