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 : #include <slepc/private/slepcimpl.h> /*I "slepcsys.h" I*/
12 :
13 : /*
14 : Internal functions used to register monitors.
15 : */
16 6730 : PetscErrorCode SlepcMonitorMakeKey_Internal(const char name[],PetscViewerType vtype,PetscViewerFormat format,char key[])
17 : {
18 6730 : PetscFunctionBegin;
19 6730 : PetscCall(PetscStrncpy(key,name,PETSC_MAX_PATH_LEN));
20 6730 : PetscCall(PetscStrlcat(key,":",PETSC_MAX_PATH_LEN));
21 6730 : PetscCall(PetscStrlcat(key,vtype,PETSC_MAX_PATH_LEN));
22 6730 : PetscCall(PetscStrlcat(key,":",PETSC_MAX_PATH_LEN));
23 6730 : PetscCall(PetscStrlcat(key,PetscViewerFormats[format],PETSC_MAX_PATH_LEN));
24 6730 : PetscFunctionReturn(PETSC_SUCCESS);
25 : }
26 :
27 14 : PetscErrorCode PetscViewerAndFormatCreate_Internal(PetscViewer viewer,PetscViewerFormat format,void *ctx,PetscViewerAndFormat **vf)
28 : {
29 14 : PetscFunctionBegin;
30 14 : PetscCall(PetscViewerAndFormatCreate(viewer,format,vf));
31 14 : (*vf)->data = ctx;
32 14 : PetscFunctionReturn(PETSC_SUCCESS);
33 : }
34 :
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 318 : PetscErrorCode SlepcBasisReference_Private(PetscInt n,Vec *V,PetscInt *m,Vec **W)
40 : {
41 318 : PetscInt i;
42 :
43 318 : PetscFunctionBegin;
44 660 : for (i=0;i<n;i++) PetscCall(PetscObjectReference((PetscObject)V[i]));
45 318 : PetscCall(SlepcBasisDestroy_Private(m,W));
46 318 : if (n>0) {
47 316 : PetscCall(PetscMalloc1(n,W));
48 658 : for (i=0;i<n;i++) (*W)[i] = V[i];
49 316 : *m = -n;
50 : }
51 318 : PetscFunctionReturn(PETSC_SUCCESS);
52 : }
53 :
54 : /*
55 : Destroys a set of vectors.
56 : A negative value of m indicates that W contains vectors to be destroyed.
57 : */
58 3149 : PetscErrorCode SlepcBasisDestroy_Private(PetscInt *m,Vec **W)
59 : {
60 3149 : PetscInt i;
61 :
62 3149 : PetscFunctionBegin;
63 3149 : if (*m<0) {
64 658 : for (i=0;i<-(*m);i++) PetscCall(VecDestroy(&(*W)[i]));
65 316 : PetscCall(PetscFree(*W));
66 : }
67 3149 : *m = 0;
68 3149 : PetscFunctionReturn(PETSC_SUCCESS);
69 : }
70 :
71 : /*@C
72 : SlepcSNPrintfScalar - Prints a PetscScalar variable to a string of
73 : given length.
74 :
75 : Not Collective
76 :
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
83 :
84 : Level: developer
85 :
86 : .seealso: PetscSNPrintf()
87 : @*/
88 291 : PetscErrorCode SlepcSNPrintfScalar(char *str,size_t len,PetscScalar val,PetscBool exp)
89 : {
90 : #if defined(PETSC_USE_COMPLEX)
91 291 : PetscReal re,im;
92 : #endif
93 :
94 291 : 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 291 : re = PetscRealPart(val);
100 291 : im = PetscImaginaryPart(val);
101 291 : if (im!=0.0) {
102 12 : if (exp) PetscCall(PetscSNPrintf(str,len,"+(%g%+gi)",(double)re,(double)im));
103 12 : else PetscCall(PetscSNPrintf(str,len,"%g%+gi",(double)re,(double)im));
104 : } else {
105 279 : if (exp) PetscCall(PetscSNPrintf(str,len,"%+g",(double)re));
106 150 : else PetscCall(PetscSNPrintf(str,len,"%g",(double)re));
107 : }
108 : #endif
109 291 : PetscFunctionReturn(PETSC_SUCCESS);
110 : }
111 :
112 : /*@
113 : SlepcHasExternalPackage - Determine whether SLEPc has been configured with the
114 : given package.
115 :
116 : Not Collective
117 :
118 : Input Parameter:
119 : . pkg - external package name
120 :
121 : Output Parameter:
122 : . has - PETSC_TRUE if SLEPc is configured with the given package, else PETSC_FALSE
123 :
124 : Level: intermediate
125 :
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.
129 :
130 : The external package name pkg is e.g. "arpack", "primme".
131 : It should correspond to the name listed in ./configure --help
132 :
133 : The lookup is case insensitive, i.e. looking for "ARPACK" or "arpack" is the same.
134 :
135 : .seealso: EPSType, SVDType
136 : @*/
137 2 : PetscErrorCode SlepcHasExternalPackage(const char pkg[], PetscBool *has)
138 : {
139 2 : char pkgstr[128],*loc;
140 2 : size_t cnt;
141 :
142 2 : PetscFunctionBegin;
143 2 : PetscCall(PetscSNPrintfCount(pkgstr,sizeof(pkgstr),":%s:",&cnt,pkg));
144 2 : PetscCheck(cnt<sizeof(pkgstr),PETSC_COMM_SELF,PETSC_ERR_SUP,"Package name is too long: \"%s\"",pkg);
145 2 : PetscCall(PetscStrtolower(pkgstr));
146 : #if defined(SLEPC_HAVE_PACKAGES)
147 2 : PetscCall(PetscStrstr(SLEPC_HAVE_PACKAGES,pkgstr,&loc));
148 : #else
149 : #error "SLEPC_HAVE_PACKAGES macro undefined. Please reconfigure"
150 : #endif
151 2 : *has = loc? PETSC_TRUE: PETSC_FALSE;
152 2 : PetscFunctionReturn(PETSC_SUCCESS);
153 : }
154 :
155 : /*
156 : SlepcDebugViewMatrix - prints an array as a matrix, to be used from within a debugger.
157 : Output can be pasted to Matlab.
158 :
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 1 : PetscErrorCode SlepcDebugViewMatrix(PetscInt nrows,PetscInt ncols,PetscScalar *Xr,PetscScalar *Xi,PetscInt ldx,const char *s,const char *filename)
167 : {
168 1 : PetscInt i,j;
169 1 : PetscViewer viewer;
170 :
171 1 : PetscFunctionBegin;
172 1 : if (filename) PetscCall(PetscViewerASCIIOpen(PETSC_COMM_WORLD,filename,&viewer));
173 1 : else PetscCall(PetscViewerASCIIGetStdout(PETSC_COMM_WORLD,&viewer));
174 1 : PetscCall(PetscViewerASCIIPrintf(viewer,"%s = [\n",s));
175 3 : for (i=0;i<nrows;i++) {
176 8 : for (j=0;j<ncols;j++) {
177 : #if defined(PETSC_USE_COMPLEX)
178 6 : 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 2 : PetscCall(PetscViewerASCIIPrintf(viewer,"\n"));
185 : }
186 1 : PetscCall(PetscViewerASCIIPrintf(viewer,"];\n"));
187 1 : if (filename) PetscCall(PetscViewerDestroy(&viewer));
188 1 : PetscFunctionReturn(PETSC_SUCCESS);
189 : }
190 : #endif
191 :
192 : /*
193 : SlepcDebugSetMatlabStdout - sets Matlab format in stdout, to be used from within a debugger.
194 : */
195 : #if defined(PETSC_USE_DEBUG) && !defined(PETSC_CLANG_STATIC_ANALYZER)
196 0 : PETSC_UNUSED PetscErrorCode SlepcDebugSetMatlabStdout(void)
197 : {
198 0 : PetscViewer viewer;
199 :
200 0 : PetscFunctionBegin;
201 0 : PetscCall(PetscViewerASCIIGetStdout(PETSC_COMM_WORLD,&viewer));
202 0 : PetscCall(PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB));
203 0 : PetscFunctionReturn(PETSC_SUCCESS);
204 : }
205 : #endif
|
