GCC Code Coverage Report

Directory: ./
File: src/nep/tutorials/ex54f.F90
Date: 2026-02-22 03:58:10
Exec Total Coverage
Lines: 62 68 91.2%
Functions: 2 2 100.0%
Branches: 45 98 45.9%
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> ./ex54f [-help] [-n <n>] [all SLEPc options]
11 !
12 ! Description: Illustrates use of shell matrices in callback interface from Fortran.
13 ! Similar to ex21.c. This one solves a simple diagonal linear eigenproblem as a NEP.
14 !
15 ! The command line options are:
16 ! -n <n>, where <n> = matrix dimension
17
18 #include <slepc/finclude/slepcnep.h>
19
20 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
21 ! Modules needed to pass and get the context to/from the Mat
22 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
23
24 module shell_ctx
25 use petscmat
26 implicit none
27 type :: MatCtx
28 PetscScalar :: lambda
29 end type MatCtx
30 ✗ end module shell_ctx
31
32 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
33 ! Module used to implement the shell matrix operations
34 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
35
36 module ex54fmodule
37 use slepcnep
38 implicit none
39
40 contains
41 ! --------------------------------------------------------------
42 ! MyNEPFunction - Computes Function matrix T(lambda)
43 !
44 575 subroutine MyNEPFunction(nep, lambda, T, P, ctx, ierr)
45 use slepcnep
46 use shell_ctx
47 implicit none
48
49 NEP :: nep
50 PetscScalar :: lambda
51 Mat :: T, P
52 PetscInt :: ctx
53 type(MatCtx), pointer :: ctxT
54 PetscErrorCode, intent(out) :: ierr
55
56
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
 575 PetscCall(MatShellGetContext(T, ctxT, ierr))
57 575 ctxT%lambda = lambda
58 end subroutine MyNEPFunction
59
60 ! --------------------------------------------------------------
61 ! MyNEPJacobian - Computes Jacobian matrix T'(lambda)
62 !
63 15 subroutine MyNEPJacobian(nep, lambda, T, ctx, ierr)
64 use slepcnep
65 use shell_ctx
66 implicit none
67
68 NEP :: nep
69 PetscScalar :: lambda
70 Mat :: T
71 PetscInt :: ctx
72 type(MatCtx), pointer :: ctxT
73 PetscErrorCode, intent(out) :: ierr
74
75
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
 15 PetscCall(MatShellGetContext(T, ctxT, ierr))
76 15 ctxT%lambda = lambda
77 end subroutine MyNEPJacobian
78
79 ! --------------------------------------------------------------
80 ! MatMult_A - Shell matrix operation, multiples y=A*x
81 ! Here A=(D-lambda*I) where D is a diagonal matrix
82 !
83 23176 subroutine MatMult_A(A, x, y, ierr)
84 use shell_ctx
85 implicit none
86
87 Mat :: A
88 Vec :: x, y
89 PetscInt :: i, istart, iend
90 PetscScalar :: val
91 type(MatCtx), pointer :: ctxA
92 PetscErrorCode, intent(out) :: ierr
93 !
94
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
 6868 PetscCall(VecGetOwnershipRange(x, istart, iend, ierr))
95
2/2
✓ Branch 0 taken 5 times.
✓ Branch 1 taken 5 times.
 2754068 do i = istart, iend - 1
96 2747200 val = 1.0/real(i + 1, PETSC_REAL_KIND)
97
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
 2754068 PetscCall(VecSetValue(y, i, val, INSERT_VALUES, ierr))
98 end do
99
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
 6868 PetscCall(VecAssemblyBegin(y, ierr))
100
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
 6868 PetscCall(VecAssemblyEnd(y, ierr))
101
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
 6868 PetscCall(VecPointwiseMult(y, y, x, ierr))
102
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
 6868 PetscCall(MatShellGetContext(A, ctxA, ierr))
103
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
 6868 PetscCall(VecAXPY(y, -ctxA%lambda, x, ierr))
104 end subroutine MatMult_A
105
106 ! --------------------------------------------------------------
107 ! MatDuplicate_A - Shell matrix operation, duplicates A
108 !
109 24 subroutine MatDuplicate_A(A, opt, M, ierr)
110 use shell_ctx
111 implicit none
112
113 Mat :: A, M
114 MatDuplicateOption :: opt
115 PetscInt :: ml, nl
116 type(MatCtx), pointer :: ctxM, ctxA
117 PetscErrorCode, intent(out) :: ierr
118
119
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
 15 PetscCall(MatGetLocalSize(A, ml, nl, ierr))
120
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
 15 PetscCall(MatShellGetContext(A, ctxA, ierr))
121
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
 15 allocate (ctxM)
122 15 ctxM%lambda = ctxA%lambda
123
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
 15 PetscCall(MatCreateShell(PETSC_COMM_WORLD, ml, nl, PETSC_DETERMINE, PETSC_DETERMINE, ctxM, M, ierr))
124
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
 15 PetscCall(MatShellSetOperation(M, MATOP_MULT, MatMult_A, ierr))
125
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
 15 PetscCall(MatShellSetOperation(M, MATOP_DESTROY, MatDestroy_A, ierr))
126 end subroutine MatDuplicate_A
127
128 ! --------------------------------------------------------------
129 ! MatDestroy_A - Shell matrix operation, destroys A
130 !
131 15 subroutine MatDestroy_A(A, ierr)
132 use shell_ctx
133 implicit none
134
135 Mat :: A
136 type(MatCtx), pointer :: ctxA
137 PetscErrorCode, intent(out) :: ierr
138
139
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
 15 PetscCall(MatShellGetContext(A, ctxA, ierr))
140
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
 15 deallocate (ctxA)
141 end subroutine MatDestroy_A
142
143 ! --------------------------------------------------------------
144 ! MatMult_B - Shell matrix operation, multiples y=B*x
145 ! Here B=-I
146 !
147 255 subroutine MatMult_B(B, x, y, ierr)
148 use petscmat
149 implicit none
150
151 Mat :: B
152 Vec :: x
153 Vec :: y
154 PetscErrorCode, intent(out) :: ierr
155 PetscScalar, parameter :: mone = -1.0
156
157
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
 255 PetscCall(VecCopy(x, y, ierr))
158
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
 255 PetscCall(VecScale(y, mone, ierr))
159 end subroutine MatMult_B
160
161 end module ex54fmodule
162
163 !=================================================================================================
164
165 124 program ex54f
166 10 use slepcnep
167 use shell_ctx
168 use ex54fmodule
169 implicit none
170
171 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
172 ! Declarations
173 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
174
175 NEP :: nep
176 Mat :: A, B
177 PetscInt :: n = 400, nev = 3, nconv
178 PetscErrorCode :: ierr
179 PetscScalar :: sigma
180 PetscBool :: flg, terse
181 PetscMPIInt :: rank
182 type(MatCtx) :: ctxA, ctxB
183
184 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
185 ! Beginning of program
186 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
187
188
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
 10 PetscCallA(SlepcInitialize(PETSC_NULL_CHARACTER, ierr))
189
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
 10 PetscCallA(PetscOptionsGetInt(PETSC_NULL_OPTIONS, PETSC_NULL_CHARACTER, '-n', n, flg, ierr))
190
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
 10 PetscCallMPIA(MPI_Comm_rank(PETSC_COMM_WORLD, rank, ierr))
191
1/2
✓ Branch 0 taken 5 times.
✗ Branch 1 not taken.
 10 if (rank == 0) then
192 10 write (*, '(/a,i4)') 'Nonlinear eigenproblem with shell matrices, n =', n
193 end if
194
195 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
196 ! Create matrix-free operators for A and B corresponding to T and T'
197 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
198
199 10 ctxA%lambda = 0.0
200
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
 10 PetscCallA(MatCreateShell(PETSC_COMM_WORLD, PETSC_DECIDE, PETSC_DECIDE, n, n, ctxA, A, ierr))
201
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
 10 PetscCallA(MatShellSetOperation(A, MATOP_MULT, MatMult_A, ierr))
202
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
 10 PetscCallA(MatShellSetOperation(A, MATOP_DUPLICATE, MatDuplicate_A, ierr))
203
204 10 ctxB%lambda = 0.0 ! unused
205
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
 10 PetscCallA(MatCreateShell(PETSC_COMM_WORLD, PETSC_DECIDE, PETSC_DECIDE, n, n, ctxB, B, ierr))
206
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
 10 PetscCallA(MatShellSetOperation(B, MATOP_MULT, MatMult_B, ierr))
207
208 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
209 ! Create the eigensolver and set various options
210 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
211
212
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
 10 PetscCallA(NEPCreate(PETSC_COMM_WORLD, nep, ierr))
213
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
 10 PetscCallA(NEPSetFunction(nep, A, A, MyNEPFunction, PETSC_NULL_INTEGER, ierr))
214
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
 10 PetscCallA(NEPSetJacobian(nep, B, MyNEPJacobian, PETSC_NULL_INTEGER, ierr))
215
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
 10 PetscCallA(NEPSetDimensions(nep, nev, PETSC_DETERMINE_INTEGER, PETSC_DETERMINE_INTEGER, ierr))
216 10 sigma = 1.05
217
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
 10 PetscCallA(NEPSetTarget(nep, sigma, ierr))
218
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
 10 PetscCallA(NEPSetFromOptions(nep, ierr))
219
220 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
221 ! Solve the eigensystem, display solution and clean up
222 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
223
224
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
 10 PetscCallA(NEPSolve(nep, ierr))
225
226
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
 10 PetscCallA(NEPGetConverged(nep, nconv, ierr))
227
1/2
✓ Branch 0 taken 5 times.
✗ Branch 1 not taken.
 10 if (rank == 0) then
228 10 write (*, '(a,i2/)') ' Number of converged approximate eigenpairs:', nconv
229 end if
230 !
231 ! ** show detailed info unless -terse option is given by user
232
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
 10 PetscCallA(PetscOptionsHasName(PETSC_NULL_OPTIONS, PETSC_NULL_CHARACTER, '-terse', terse, ierr))
233
1/2
✓ Branch 0 taken 5 times.
✗ Branch 1 not taken.
 10 if (terse) then
234
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
 10 PetscCallA(NEPErrorView(nep, NEP_ERROR_RELATIVE, PETSC_NULL_VIEWER, ierr))
235 else
236 ✗ PetscCallA(PetscViewerPushFormat(PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_ASCII_INFO_DETAIL, ierr))
237 ✗ PetscCallA(NEPConvergedReasonView(nep, PETSC_VIEWER_STDOUT_WORLD, ierr))
238 ✗ PetscCallA(NEPErrorView(nep, NEP_ERROR_RELATIVE, PETSC_VIEWER_STDOUT_WORLD, ierr))
239 ✗ PetscCallA(PetscViewerPopFormat(PETSC_VIEWER_STDOUT_WORLD, ierr))
240 end if
241
242
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
 10 PetscCallA(NEPDestroy(nep, ierr))
243
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
 10 PetscCallA(MatDestroy(A, ierr))
244
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
 10 PetscCallA(MatDestroy(B, ierr))
245
0/2
✗ Branch 0 not taken.
✗ Branch 1 not taken.
 10 PetscCallA(SlepcFinalize(ierr))
246
247 ✗ end program ex54f
248
249 !/*TEST
250 !
251 ! testset:
252 ! args: -terse
253 ! output_file: output/ex54f_1.out
254 ! filter: grep -v approximate | sed -e "s/[+-]0\.0*i//g"
255 ! test:
256 ! suffix: 1_slp
257 ! args: -nep_type slp -nep_slp_ksp_type gmres -nep_slp_pc_type none
258 ! requires: double
259 ! test:
260 ! suffix: 1_nleigs
261 ! args: -nep_type nleigs -rg_interval_endpoints 0.2,1.1 -nep_nleigs_ksp_type gmres -nep_nleigs_pc_type none
262 ! requires: !complex
263 ! test:
264 ! suffix: 1_nleigs_complex
265 ! args: -nep_type nleigs -rg_interval_endpoints 0.2,1.1,-.1,.1 -nep_nleigs_ksp_type gmres -nep_nleigs_pc_type none
266 ! requires: complex
267 !
268 !TEST*/
269