GCC Code Coverage Report

Directory: ./
File: src/sys/classes/ds/tests/test14f.F90
Date: 2025-12-10 04:20:18
Exec Total Coverage
Lines: 40 41 97.6%
Functions: 3 3 100.0%
Branches: 28 50 56.0%
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> ./test14f [-help] [-n <n>] [all SLEPc options]
11 !
12 ! Description: Simple example that tests solving a DSNHEP problem.
13 !
14 ! The command line options are:
15 ! -n <n>, where <n> = matrix size
16 !
17 ! ----------------------------------------------------------------------
18 !
19 #include <slepc/finclude/slepcds.h>
20 3 program test14f
21 2 use slepcds
22 implicit none
23
24 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
25 ! Declarations
26 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
27
28 Mat :: A ! problem matrix
29 DS :: ds ! dense solver context
30 PetscInt :: n, i, ld, zero
31 PetscMPIInt :: rank
32 PetscErrorCode :: ierr
33 PetscBool :: flg
34 PetscScalar :: wr(100), wi(100)
35 PetscReal :: re, im
36 2 PetscScalar, pointer :: aa(:, :)
37
38 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
39 ! Beginning of program
40 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
41
42 2 zero = 0
43
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 2 times.
 2 PetscCallA(SlepcInitialize(PETSC_NULL_CHARACTER, ierr))
44
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 2 times.
 2 PetscCallMPIA(MPI_Comm_rank(PETSC_COMM_WORLD, rank, ierr))
45 2 n = 10
46
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 2 times.
 2 PetscCallA(PetscOptionsGetInt(PETSC_NULL_OPTIONS, PETSC_NULL_CHARACTER, '-n', n, flg, ierr))
47
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 2 times.
 2 PetscCheckA(n <= 100, PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, 'Program currently limited to n=100')
48
49
1/2
✓ Branch 0 taken 2 times.
✗ Branch 1 not taken.
 2 if (rank == 0) then
50 2 write (*, '(/a,i3,a)') 'Solve a Dense System of type NHEP, n =', n, ' (Fortran)'
51 end if
52
53 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
54 ! Create DS object
55 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
56
57
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 2 times.
 2 PetscCallA(DSCreate(PETSC_COMM_WORLD, ds, ierr))
58
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 2 times.
 2 PetscCallA(DSSetType(ds, DSNHEP, ierr))
59
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 2 times.
 2 PetscCallA(DSSetFromOptions(ds, ierr))
60 2 ld = n
61
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 2 times.
 2 PetscCallA(DSAllocate(ds, ld, ierr))
62
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 2 times.
 2 PetscCallA(DSSetDimensions(ds, n, zero, zero, ierr))
63
64 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
65 ! Fill with Grcar matrix
66 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
67
68
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 2 times.
 2 PetscCallA(DSGetMat(ds, DS_MAT_A, A, ierr))
69
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 2 times.
 2 PetscCallA(MatDenseGetArray(A, aa, ierr))
70
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 2 times.
 2 call FillUpMatrix(n, aa)
71
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 2 times.
 2 PetscCallA(MatDenseRestoreArray(A, aa, ierr))
72
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 2 times.
 2 PetscCallA(DSRestoreMat(ds, DS_MAT_A, A, ierr))
73
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 2 times.
 2 PetscCallA(DSSetState(ds, DS_STATE_INTERMEDIATE, ierr))
74
75 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
76 ! Solve the problem and show eigenvalues
77 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
78
79
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 2 times.
 2 PetscCallA(DSSolve(ds, wr, wi, ierr))
80 ! PetscCallA(DSSort(ds,wr,wi,PETSC_NULL_SCALAR,PETSC_NULL_SCALAR,PETSC_NULL_INTEGER,ierr))
81
82
1/2
✓ Branch 0 taken 2 times.
✗ Branch 1 not taken.
 2 if (rank == 0) then
83 2 write (*, *) 'Computed eigenvalues ='
84
2/2
✓ Branch 0 taken 2 times.
✓ Branch 1 taken 2 times.
 22 do i = 1, n
85 #if defined(PETSC_USE_COMPLEX)
86 re = PetscRealPart(wr(i))
87 im = PetscImaginaryPart(wr(i))
88 #else
89 20 re = wr(i)
90 20 im = wi(i)
91 #endif
92
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 2 times.
 22 if (abs(im) < 1.d-10) then
93 ✗ write (*, '(a,f8.5)') ' ', re
94 else
95 20 write (*, '(a,f8.5,sp,f8.5,a)') ' ', re, im, 'i'
96 end if
97 end do
98 end if
99
100 ! *** Clean up
101
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 2 times.
 2 PetscCallA(DSDestroy(ds, ierr))
102
0/2
✗ Branch 0 not taken.
✗ Branch 1 not taken.
 4 PetscCallA(SlepcFinalize(ierr))
103
104 contains
105
106 2 subroutine FillUpMatrix(n, X)
107 PetscInt :: n, i, j
108 PetscScalar :: X(n, n)
109
110
2/2
✓ Branch 0 taken 2 times.
✓ Branch 1 taken 2 times.
 20 do i = 2, n
111 20 X(i, i - 1) = -1.d0
112 end do
113
2/2
✓ Branch 0 taken 2 times.
✓ Branch 1 taken 2 times.
 10 do j = 0, 3
114
2/2
✓ Branch 0 taken 2 times.
✓ Branch 1 taken 2 times.
 78 do i = 1, n - j
115 76 X(i, i + j) = 1.d0
116 end do
117 end do
118
119 2 end
120
121 end program test14f
122
123 !/*TEST
124 !
125 ! test:
126 ! suffix: 1
127 ! requires: !complex
128 !
129 !TEST*/
130