Line | Branch | Exec | Source |
---|---|---|---|
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 | ! Program usage: mpiexec -n <np> ./ex27f [-help] [-n <n>] [all SLEPc options] | ||
11 | ! | ||
12 | ! Description: Simple NLEIGS example. Fortran90 equivalent of ex27.c | ||
13 | ! | ||
14 | ! The command line options are: | ||
15 | ! -n <n>, where <n> = matrix dimension | ||
16 | ! | ||
17 | ! ---------------------------------------------------------------------- | ||
18 | ! Solve T(lambda)x=0 using NLEIGS solver | ||
19 | ! with T(lambda) = -D+sqrt(lambda)*I | ||
20 | ! where D is the Laplacian operator in 1 dimension | ||
21 | ! and with the interpolation interval [.01,16] | ||
22 | ! ---------------------------------------------------------------------- | ||
23 | ! | ||
24 | 12 | PROGRAM main | |
25 | #include <slepc/finclude/slepcnep.h> | ||
26 | 12 | USE slepcnep | |
27 | implicit none | ||
28 | |||
29 | ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | ||
30 | ! Declarations | ||
31 | ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | ||
32 | |||
33 | NEP :: nep | ||
34 |
2/2✓ Branch 0 taken 6 times.
✓ Branch 1 taken 6 times.
|
36 | Mat :: A(2),F,J |
35 | NEPType :: ntype | ||
36 | PetscInt :: n=100,nev,Istart,Iend,i,col,one,two,three | ||
37 | PetscErrorCode :: ierr | ||
38 | PetscBool :: terse,flg,split=PETSC_TRUE | ||
39 | PetscReal :: ia,ib,ic,id | ||
40 | RG :: rg | ||
41 |
2/2✓ Branch 0 taken 6 times.
✓ Branch 1 taken 6 times.
|
36 | FN :: fn(2) |
42 | PetscScalar :: coeffs,sigma,done | ||
43 | CHARACTER(LEN=128) :: string | ||
44 | |||
45 | ! NOTE: Any user-defined Fortran routines (such as ComputeSingularities) | ||
46 | ! MUST be declared as external. | ||
47 | external ComputeSingularities, FormFunction, FormJacobian | ||
48 | |||
49 | ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | ||
50 | ! Beginning of program | ||
51 | ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | ||
52 | |||
53 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
12 | PetscCallA(SlepcInitialize(PETSC_NULL_CHARACTER,ierr)) |
54 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
12 | PetscCallA(PetscOptionsGetInt(PETSC_NULL_OPTIONS,PETSC_NULL_CHARACTER,"-n",n,flg,ierr)) |
55 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
12 | PetscCallA(PetscOptionsGetBool(PETSC_NULL_OPTIONS,PETSC_NULL_CHARACTER,"-split",split,flg,ierr)) |
56 |
2/2✓ Branch 0 taken 6 times.
✓ Branch 1 taken 6 times.
|
12 | if (split) then |
57 | 6 | write(string,*) 'Square root eigenproblem, n=',n,' (split-form)\n' | |
58 | else | ||
59 | 6 | write(string,*) 'Square root eigenproblem, n=',n,'\n' | |
60 | end if | ||
61 |
2/4✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 6 times.
|
12 | PetscCallA(PetscPrintf(PETSC_COMM_WORLD,trim(string),ierr)) |
62 | 12 | done = 1.0 | |
63 | 12 | one = 1 | |
64 | 12 | two = 2 | |
65 | 12 | three = 3 | |
66 | |||
67 | ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | ||
68 | ! Create nonlinear eigensolver context and set options | ||
69 | ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | ||
70 | |||
71 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
12 | PetscCallA(NEPCreate(PETSC_COMM_WORLD,nep,ierr)) |
72 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
12 | PetscCallA(NEPSetType(nep,NEPNLEIGS,ierr)) |
73 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
12 | PetscCallA(NEPNLEIGSSetSingularitiesFunction(nep,ComputeSingularities,0,ierr)) |
74 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
12 | PetscCallA(NEPGetRG(nep,rg,ierr)) |
75 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
12 | PetscCallA(RGSetType(rg,RGINTERVAL,ierr)) |
76 | 12 | ia = 0.01 | |
77 | 12 | ib = 16.0 | |
78 | #if defined(PETSC_USE_COMPLEX) | ||
79 | 8 | ic = -0.001 | |
80 | 8 | id = 0.001 | |
81 | #else | ||
82 | 4 | ic = 0.0 | |
83 | 4 | id = 0.0 | |
84 | #endif | ||
85 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
12 | PetscCallA(RGIntervalSetEndpoints(rg,ia,ib,ic,id,ierr)) |
86 | 12 | sigma = 1.1 | |
87 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
12 | PetscCallA(NEPSetTarget(nep,sigma,ierr)) |
88 | |||
89 | ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | ||
90 | ! Define the nonlinear problem | ||
91 | ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | ||
92 | |||
93 |
2/2✓ Branch 0 taken 6 times.
✓ Branch 1 taken 6 times.
|
12 | if (split) then |
94 | ! ** Create matrices for the split form | ||
95 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
6 | PetscCallA(MatCreate(PETSC_COMM_WORLD,A(1),ierr)) |
96 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
6 | PetscCallA(MatSetSizes(A(1),PETSC_DECIDE,PETSC_DECIDE,n,n,ierr)) |
97 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
6 | PetscCallA(MatSetFromOptions(A(1),ierr)) |
98 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
6 | PetscCallA(MatGetOwnershipRange(A(1),Istart,Iend,ierr)) |
99 | 6 | coeffs = -2.0 | |
100 |
2/2✓ Branch 0 taken 6 times.
✓ Branch 1 taken 6 times.
|
606 | do i=Istart,Iend-1 |
101 |
2/2✓ Branch 0 taken 6 times.
✓ Branch 1 taken 6 times.
|
600 | if (i.gt.0) then |
102 | 594 | col = i-1 | |
103 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
594 | PetscCallA(MatSetValue(A(1),i,col,done,INSERT_VALUES,ierr)) |
104 | end if | ||
105 |
2/2✓ Branch 0 taken 6 times.
✓ Branch 1 taken 6 times.
|
600 | if (i.lt.n-1) then |
106 | 594 | col = i+1 | |
107 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
594 | PetscCallA(MatSetValue(A(1),i,col,done,INSERT_VALUES,ierr)) |
108 | end if | ||
109 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
606 | PetscCallA(MatSetValue(A(1),i,i,coeffs,INSERT_VALUES,ierr)) |
110 | end do | ||
111 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
6 | PetscCallA(MatAssemblyBegin(A(1),MAT_FINAL_ASSEMBLY,ierr)) |
112 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
6 | PetscCallA(MatAssemblyEnd(A(1),MAT_FINAL_ASSEMBLY,ierr)) |
113 | |||
114 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
6 | PetscCallA(MatCreateConstantDiagonal(PETSC_COMM_WORLD,PETSC_DECIDE,PETSC_DECIDE,n,n,done,A(2),ierr)) |
115 | |||
116 | ! ** Define functions for the split form | ||
117 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
6 | PetscCallA(FNCreate(PETSC_COMM_WORLD,fn(1),ierr)) |
118 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
6 | PetscCallA(FNSetType(fn(1),FNRATIONAL,ierr)) |
119 |
3/4✓ Branch 0 taken 6 times.
✓ Branch 1 taken 6 times.
✗ Branch 2 not taken.
✓ Branch 3 taken 6 times.
|
12 | PetscCallA(FNRationalSetNumerator(fn(1),one,[done],ierr)) |
120 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
6 | PetscCallA(FNCreate(PETSC_COMM_WORLD,fn(2),ierr)) |
121 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
6 | PetscCallA(FNSetType(fn(2),FNSQRT,ierr)) |
122 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
6 | PetscCallA(NEPSetSplitOperator(nep,two,A,fn,SUBSET_NONZERO_PATTERN,ierr)) |
123 | else | ||
124 | ! ** Callback form: create matrix and set Function evaluation routine | ||
125 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
6 | PetscCallA(MatCreate(PETSC_COMM_WORLD,F,ierr)) |
126 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
6 | PetscCallA(MatSetSizes(F,PETSC_DECIDE,PETSC_DECIDE,n,n,ierr)) |
127 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
6 | PetscCallA(MatSetFromOptions(F,ierr)) |
128 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
6 | PetscCallA(MatSeqAIJSetPreallocation(F,three,PETSC_NULL_INTEGER_ARRAY,ierr)) |
129 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
6 | PetscCallA(MatMPIAIJSetPreallocation(F,three,PETSC_NULL_INTEGER_ARRAY,one,PETSC_NULL_INTEGER_ARRAY,ierr)) |
130 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
6 | PetscCallA(NEPSetFunction(nep,F,F,FormFunction,PETSC_NULL_INTEGER,ierr)) |
131 | |||
132 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
6 | PetscCallA(MatCreate(PETSC_COMM_WORLD,J,ierr)) |
133 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
6 | PetscCallA(MatSetSizes(J,PETSC_DECIDE,PETSC_DECIDE,n,n,ierr)) |
134 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
6 | PetscCallA(MatSetFromOptions(J,ierr)) |
135 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
6 | PetscCallA(MatSeqAIJSetPreallocation(J,one,PETSC_NULL_INTEGER_ARRAY,ierr)) |
136 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
6 | PetscCallA(MatMPIAIJSetPreallocation(J,one,PETSC_NULL_INTEGER_ARRAY,one,PETSC_NULL_INTEGER_ARRAY,ierr)) |
137 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
6 | PetscCallA(NEPSetJacobian(nep,J,FormJacobian,PETSC_NULL_INTEGER,ierr)) |
138 | end if | ||
139 | |||
140 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
12 | PetscCallA(NEPSetFromOptions(nep,ierr)) |
141 | |||
142 | ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | ||
143 | ! Solve the eigensystem | ||
144 | ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | ||
145 | |||
146 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
12 | PetscCallA(NEPSolve(nep,ierr)) |
147 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
12 | PetscCallA(NEPGetType(nep,ntype,ierr)) |
148 | 12 | write(string,*) 'Solution method: ',ntype,'\n' | |
149 |
2/4✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 6 times.
|
12 | PetscCallA(PetscPrintf(PETSC_COMM_WORLD,trim(string),ierr)) |
150 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
12 | PetscCallA(NEPGetDimensions(nep,nev,PETSC_NULL_INTEGER,PETSC_NULL_INTEGER,ierr)) |
151 | 12 | write(string,*) 'Number of requested eigenvalues:',nev,'\n' | |
152 |
2/4✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 6 times.
|
12 | PetscCallA(PetscPrintf(PETSC_COMM_WORLD,trim(string),ierr)) |
153 | |||
154 | ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | ||
155 | ! Display solution and clean up | ||
156 | ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | ||
157 | |||
158 | ! ** show detailed info unless -terse option is given by user | ||
159 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
12 | PetscCallA(PetscOptionsHasName(PETSC_NULL_OPTIONS,PETSC_NULL_CHARACTER,'-terse',terse,ierr)) |
160 |
1/2✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
|
12 | if (terse) then |
161 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
12 | PetscCallA(NEPErrorView(nep,NEP_ERROR_BACKWARD,PETSC_NULL_VIEWER,ierr)) |
162 | else | ||
163 | ✗ | PetscCallA(PetscViewerPushFormat(PETSC_VIEWER_STDOUT_WORLD,PETSC_VIEWER_ASCII_INFO_DETAIL,ierr)) | |
164 | ✗ | PetscCallA(NEPConvergedReasonView(nep,PETSC_VIEWER_STDOUT_WORLD,ierr)) | |
165 | ✗ | PetscCallA(NEPErrorView(nep,NEP_ERROR_BACKWARD,PETSC_VIEWER_STDOUT_WORLD,ierr)) | |
166 | ✗ | PetscCallA(PetscViewerPopFormat(PETSC_VIEWER_STDOUT_WORLD,ierr)) | |
167 | end if | ||
168 | |||
169 |
2/2✓ Branch 0 taken 6 times.
✓ Branch 1 taken 6 times.
|
12 | if (split) then |
170 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
6 | PetscCallA(MatDestroy(A(1),ierr)) |
171 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
6 | PetscCallA(MatDestroy(A(2),ierr)) |
172 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
6 | PetscCallA(FNDestroy(fn(1),ierr)) |
173 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
6 | PetscCallA(FNDestroy(fn(2),ierr)) |
174 | else | ||
175 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
6 | PetscCallA(MatDestroy(F,ierr)) |
176 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
6 | PetscCallA(MatDestroy(J,ierr)) |
177 | end if | ||
178 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
12 | PetscCallA(NEPDestroy(nep,ierr)) |
179 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
|
12 | PetscCallA(SlepcFinalize(ierr)) |
180 | |||
181 | 2 | END PROGRAM main | |
182 | |||
183 | ! -------------------------------------------------------------- | ||
184 | ! | ||
185 | ! FormFunction - Computes Function matrix T(lambda) | ||
186 | ! | ||
187 | 170 | SUBROUTINE FormFunction(nep,lambda,fun,B,ctx,ierr) | |
188 | #include <slepc/finclude/slepcnep.h> | ||
189 | use slepcnep | ||
190 | implicit none | ||
191 | |||
192 | NEP :: nep | ||
193 | PetscScalar :: lambda,val(0:2),t | ||
194 | Mat :: fun,B | ||
195 | PetscInt :: ctx,i,n,col(0:2),Istart,Iend,Istart0,Iend0,one,two,three | ||
196 | PetscErrorCode :: ierr | ||
197 | PetscBool :: FirstBlock=PETSC_FALSE, LastBlock=PETSC_FALSE | ||
198 | |||
199 | 170 | one = 1 | |
200 | 170 | two = 2 | |
201 | 170 | three = 3 | |
202 | |||
203 | ! ** Compute Function entries and insert into matrix | ||
204 | 170 | t = sqrt(lambda) | |
205 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
170 | PetscCall(MatGetSize(fun,n,PETSC_NULL_INTEGER,ierr)) |
206 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
170 | PetscCall(MatGetOwnershipRange(fun,Istart,Iend,ierr)) |
207 |
1/2✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
|
170 | if (Istart.eq.0) FirstBlock=PETSC_TRUE |
208 |
1/2✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
|
170 | if (Iend.eq.n) LastBlock=PETSC_TRUE |
209 | 170 | val(0)=1.0 | |
210 | 170 | val(1)=t-2.0 | |
211 | 170 | val(2)=1.0 | |
212 | |||
213 | 170 | Istart0 = Istart | |
214 |
1/2✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
|
170 | if (FirstBlock) Istart0 = Istart+1 |
215 | 170 | Iend0 = Iend | |
216 |
1/2✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
|
170 | if (LastBlock) Iend0 = Iend-1 |
217 | |||
218 |
2/2✓ Branch 0 taken 6 times.
✓ Branch 1 taken 6 times.
|
16830 | do i=Istart0,Iend0-1 |
219 | 16660 | col(0) = i-1 | |
220 | 16660 | col(1) = i | |
221 | 16660 | col(2) = i+1 | |
222 |
3/4✓ Branch 0 taken 6 times.
✓ Branch 1 taken 6 times.
✓ Branch 2 taken 6 times.
✗ Branch 3 not taken.
|
33490 | PetscCall(MatSetValues(fun,one,[i],three,col,val,INSERT_VALUES,ierr)) |
223 | end do | ||
224 | |||
225 |
1/2✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
|
170 | if (LastBlock) then |
226 | 170 | i = n-1 | |
227 | 170 | col(0) = n-2 | |
228 | 170 | col(1) = n-1 | |
229 | 170 | val(0) = 1.0 | |
230 | 170 | val(1) = t-2.0 | |
231 |
3/4✓ Branch 0 taken 6 times.
✓ Branch 1 taken 6 times.
✗ Branch 2 not taken.
✓ Branch 3 taken 6 times.
|
340 | PetscCall(MatSetValues(fun,one,[i],two,col,val,INSERT_VALUES,ierr)) |
232 | end if | ||
233 | |||
234 |
1/2✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
|
170 | if (FirstBlock) then |
235 | 170 | i = 0 | |
236 | 170 | col(0) = 0 | |
237 | 170 | col(1) = 1 | |
238 | 170 | val(0) = t-2.0 | |
239 | 170 | val(1) = 1.0 | |
240 |
3/4✓ Branch 0 taken 6 times.
✓ Branch 1 taken 6 times.
✗ Branch 2 not taken.
✓ Branch 3 taken 6 times.
|
340 | PetscCall(MatSetValues(fun,one,[i],two,col,val,INSERT_VALUES,ierr)) |
241 | end if | ||
242 | |||
243 | ! ** Assemble matrix | ||
244 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
170 | PetscCall(MatAssemblyBegin(B,MAT_FINAL_ASSEMBLY,ierr)) |
245 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
170 | PetscCall(MatAssemblyEnd(B,MAT_FINAL_ASSEMBLY,ierr)) |
246 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
170 | PetscCall(MatAssemblyBegin(fun,MAT_FINAL_ASSEMBLY,ierr)) |
247 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
170 | PetscCall(MatAssemblyEnd(fun,MAT_FINAL_ASSEMBLY,ierr)) |
248 | |||
249 | END SUBROUTINE FormFunction | ||
250 | |||
251 | ! -------------------------------------------------------------- | ||
252 | ! | ||
253 | ! FormJacobian - Computes Jacobian matrix T'(lambda) | ||
254 | ! | ||
255 | ✗ | SUBROUTINE FormJacobian(nep,lambda,jac,ctx,ierr) | |
256 | #include <slepc/finclude/slepcnep.h> | ||
257 | USE slepcnep | ||
258 | implicit none | ||
259 | |||
260 | NEP :: nep | ||
261 | PetscScalar :: lambda,t | ||
262 | Mat :: jac | ||
263 | PetscInt :: ctx | ||
264 | PetscErrorCode :: ierr | ||
265 | Vec :: d | ||
266 | |||
267 | ✗ | PetscCall(MatCreateVecs(jac,d,PETSC_NULL_VEC,ierr)) | |
268 | ✗ | t = 0.5/sqrt(lambda) | |
269 | ✗ | PetscCall(VecSet(d,t,ierr)) | |
270 | ✗ | PetscCall(MatDiagonalSet(jac,d,INSERT_VALUES,ierr)) | |
271 | ✗ | PetscCall(VecDestroy(d,ierr)) | |
272 | |||
273 | ✗ | END SUBROUTINE FormJacobian | |
274 | |||
275 | ! -------------------------------------------------------------- | ||
276 | ! | ||
277 | ! ComputeSingularities - This is a user-defined routine to compute maxnp | ||
278 | ! points (at most) in the complex plane where the function T(.) is not analytic. | ||
279 | ! | ||
280 | ! In this case, we discretize the singularity region (-inf,0)~(-1e+6,-1e-5) | ||
281 | ! | ||
282 | ! Input Parameters: | ||
283 | ! nep - nonlinear eigensolver context | ||
284 | ! maxnp - on input number of requested points in the discretization (can be set) | ||
285 | ! xi - computed values of the discretization | ||
286 | ! dummy - optional user-defined monitor context (unused here) | ||
287 | ! | ||
288 | 12 | SUBROUTINE ComputeSingularities(nep,maxnp,xi,dummy,ierr) | |
289 | #include <slepc/finclude/slepcnep.h> | ||
290 | use slepcnep | ||
291 | implicit none | ||
292 | |||
293 | NEP :: nep | ||
294 | PetscInt :: maxnp, dummy | ||
295 | PetscScalar :: xi(0:maxnp-1) | ||
296 | PetscErrorCode :: ierr | ||
297 | PetscReal :: h | ||
298 | PetscInt :: i | ||
299 | |||
300 | 12 | h = 11.0/real(maxnp-1) | |
301 | 12 | xi(0) = -1e-5 | |
302 | 12 | xi(maxnp-1) = -1e+6 | |
303 |
2/2✓ Branch 0 taken 6 times.
✓ Branch 1 taken 6 times.
|
119988 | do i=1,maxnp-2 |
304 | 119988 | xi(i) = -10**(-5+h*i) | |
305 | end do | ||
306 | 12 | ierr = 0 | |
307 | |||
308 | 12 | END SUBROUTINE ComputeSingularities | |
309 | |||
310 | !/*TEST | ||
311 | ! | ||
312 | ! test: | ||
313 | ! suffix: 1 | ||
314 | ! args: -nep_nev 3 -nep_nleigs_interpolation_degree 90 -terse | ||
315 | ! requires: !single | ||
316 | ! filter: sed -e "s/[+-]0\.0*i//g" | ||
317 | ! | ||
318 | ! test: | ||
319 | ! suffix: 2 | ||
320 | ! args: -split 0 -nep_nev 3 -nep_nleigs_interpolation_degree 90 -terse | ||
321 | ! requires: !single | ||
322 | ! filter: sed -e "s/[+-]0\.0*i//g" | ||
323 | ! | ||
324 | !TEST*/ | ||
325 |