| 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> ./ex15f [-help] [-n <n>] [-mu <mu>] [all SLEPc options] | ||
| 11 | ! | ||
| 12 | ! Description: Singular value decomposition of the Lauchli matrix. | ||
| 13 | ! | ||
| 14 | ! The command line options are: | ||
| 15 | ! -n <n>, where <n> = matrix dimension. | ||
| 16 | ! -mu <mu>, where <mu> = subdiagonal value. | ||
| 17 | ! | ||
| 18 | ! ---------------------------------------------------------------------- | ||
| 19 | ! | ||
| 20 | #include <slepc/finclude/slepcsvd.h> | ||
| 21 | 82 | program ex15f | |
| 22 | 5 | use slepcsvd | |
| 23 | implicit none | ||
| 24 | |||
| 25 | ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | ||
| 26 | ! Declarations | ||
| 27 | ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | ||
| 28 | |||
| 29 | Mat :: A ! operator matrix | ||
| 30 | SVD :: svd ! singular value solver context | ||
| 31 | SVDType :: tname | ||
| 32 | PetscReal :: tol, error, sigma, mu | ||
| 33 | PetscInt :: n, i, j, Istart, Iend | ||
| 34 | PetscInt :: nsv, maxit, its, nconv | ||
| 35 | PetscMPIInt :: rank | ||
| 36 | PetscErrorCode :: ierr | ||
| 37 | PetscBool :: flg | ||
| 38 | PetscScalar :: alpha | ||
| 39 | PetscScalar, parameter :: one = 1.0 | ||
| 40 | |||
| 41 | ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | ||
| 42 | ! Beginning of program | ||
| 43 | ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | ||
| 44 | |||
| 45 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
|
5 | PetscCallA(SlepcInitialize(PETSC_NULL_CHARACTER, ierr)) |
| 46 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
|
5 | PetscCallMPIA(MPI_Comm_rank(PETSC_COMM_WORLD, rank, ierr)) |
| 47 | 5 | n = 100 | |
| 48 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
|
5 | PetscCallA(PetscOptionsGetInt(PETSC_NULL_OPTIONS, PETSC_NULL_CHARACTER, '-n', n, flg, ierr)) |
| 49 | 5 | mu = PETSC_SQRT_MACHINE_EPSILON | |
| 50 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
|
5 | PetscCallA(PetscOptionsGetReal(PETSC_NULL_OPTIONS, PETSC_NULL_CHARACTER, '-mu', mu, flg, ierr)) |
| 51 | |||
| 52 |
1/2✓ Branch 0 taken 5 times.
✗ Branch 1 not taken.
|
5 | if (rank == 0) then |
| 53 | 5 | write (*, '(/a,i3,a,e12.4,a)') 'Lauchli SVD, n =', n, ', mu=', mu, ' (Fortran)' | |
| 54 | end if | ||
| 55 | |||
| 56 | ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | ||
| 57 | ! Build the Lauchli matrix | ||
| 58 | ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | ||
| 59 | |||
| 60 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
|
5 | PetscCallA(MatCreate(PETSC_COMM_WORLD, A, ierr)) |
| 61 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
|
5 | PetscCallA(MatSetSizes(A, PETSC_DECIDE, PETSC_DECIDE, n + 1, n, ierr)) |
| 62 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
|
5 | PetscCallA(MatSetFromOptions(A, ierr)) |
| 63 | |||
| 64 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
|
5 | PetscCallA(MatGetOwnershipRange(A, Istart, Iend, ierr)) |
| 65 |
2/2✓ Branch 0 taken 5 times.
✓ Branch 1 taken 5 times.
|
510 | do i = Istart, Iend - 1 |
| 66 |
2/2✓ Branch 0 taken 5 times.
✓ Branch 1 taken 5 times.
|
510 | if (i == 0) then |
| 67 |
2/2✓ Branch 0 taken 5 times.
✓ Branch 1 taken 5 times.
|
505 | do j = 0, n - 1 |
| 68 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
|
505 | PetscCallA(MatSetValue(A, i, j, one, INSERT_VALUES, ierr)) |
| 69 | end do | ||
| 70 | else | ||
| 71 | 500 | alpha = mu | |
| 72 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
|
500 | PetscCallA(MatSetValue(A, i, i - 1, alpha, INSERT_VALUES, ierr)) |
| 73 | end if | ||
| 74 | end do | ||
| 75 | |||
| 76 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
|
5 | PetscCallA(MatAssemblyBegin(A, MAT_FINAL_ASSEMBLY, ierr)) |
| 77 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
|
5 | PetscCallA(MatAssemblyEnd(A, MAT_FINAL_ASSEMBLY, ierr)) |
| 78 | |||
| 79 | ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | ||
| 80 | ! Create the singular value solver and display info | ||
| 81 | ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | ||
| 82 | |||
| 83 | ! ** Create singular value solver context | ||
| 84 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
|
5 | PetscCallA(SVDCreate(PETSC_COMM_WORLD, svd, ierr)) |
| 85 | |||
| 86 | ! ** Set operators and problem type | ||
| 87 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
|
5 | PetscCallA(SVDSetOperators(svd, A, PETSC_NULL_MAT, ierr)) |
| 88 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
|
5 | PetscCallA(SVDSetProblemType(svd, SVD_STANDARD, ierr)) |
| 89 | |||
| 90 | ! ** Use thick-restart Lanczos as default solver | ||
| 91 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
|
5 | PetscCallA(SVDSetType(svd, SVDTRLANCZOS, ierr)) |
| 92 | |||
| 93 | ! ** Set solver parameters at runtime | ||
| 94 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
|
5 | PetscCallA(SVDSetFromOptions(svd, ierr)) |
| 95 | |||
| 96 | ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | ||
| 97 | ! Solve the singular value system | ||
| 98 | ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | ||
| 99 | |||
| 100 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
|
5 | PetscCallA(SVDSolve(svd, ierr)) |
| 101 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
|
5 | PetscCallA(SVDGetIterationNumber(svd, its, ierr)) |
| 102 |
1/2✓ Branch 0 taken 5 times.
✗ Branch 1 not taken.
|
5 | if (rank == 0) then |
| 103 | 5 | write (*, '(/a,i4)') ' Number of iterations of the method:', its | |
| 104 | end if | ||
| 105 | |||
| 106 | ! ** Optional: Get some information from the solver and display it | ||
| 107 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
|
5 | PetscCallA(SVDGetType(svd, tname, ierr)) |
| 108 |
1/2✓ Branch 0 taken 5 times.
✗ Branch 1 not taken.
|
5 | if (rank == 0) then |
| 109 | 5 | write (*, '(a,a)') ' Solution method: ', tname | |
| 110 | end if | ||
| 111 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
|
5 | PetscCallA(SVDGetDimensions(svd, nsv, PETSC_NULL_INTEGER, PETSC_NULL_INTEGER, ierr)) |
| 112 |
1/2✓ Branch 0 taken 5 times.
✗ Branch 1 not taken.
|
5 | if (rank == 0) then |
| 113 | 5 | write (*, '(a,i2)') ' Number of requested singular values:', nsv | |
| 114 | end if | ||
| 115 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
|
5 | PetscCallA(SVDGetTolerances(svd, tol, maxit, ierr)) |
| 116 |
1/2✓ Branch 0 taken 5 times.
✗ Branch 1 not taken.
|
5 | if (rank == 0) then |
| 117 | 5 | write (*, '(a,1pe11.4,a,i4)') ' Stopping condition: tol=', tol, ', maxit=', maxit | |
| 118 | end if | ||
| 119 | |||
| 120 | ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | ||
| 121 | ! Display solution and clean up | ||
| 122 | ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | ||
| 123 | |||
| 124 | ! ** Get number of converged singular triplets | ||
| 125 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
|
5 | PetscCallA(SVDGetConverged(svd, nconv, ierr)) |
| 126 |
1/2✓ Branch 0 taken 5 times.
✗ Branch 1 not taken.
|
5 | if (rank == 0) then |
| 127 | 5 | write (*, '(a,i2/)') ' Number of converged approximate singular triplets:', nconv | |
| 128 | end if | ||
| 129 | |||
| 130 | ! ** Display singular values and relative errors | ||
| 131 |
1/2✓ Branch 0 taken 5 times.
✗ Branch 1 not taken.
|
5 | if (nconv > 0) then |
| 132 |
1/2✓ Branch 0 taken 5 times.
✗ Branch 1 not taken.
|
5 | if (rank == 0) then |
| 133 | 5 | write (*, *) ' sigma relative error' | |
| 134 | 5 | write (*, *) ' ----------------- ------------------' | |
| 135 | end if | ||
| 136 |
2/2✓ Branch 0 taken 5 times.
✓ Branch 1 taken 5 times.
|
55 | do i = 0, nconv - 1 |
| 137 | ! ** Get i-th singular value | ||
| 138 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
|
50 | PetscCallA(SVDGetSingularTriplet(svd, i, sigma, PETSC_NULL_VEC, PETSC_NULL_VEC, ierr)) |
| 139 | |||
| 140 | ! ** Compute the relative error for each singular triplet | ||
| 141 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
|
50 | PetscCallA(SVDComputeError(svd, i, SVD_ERROR_RELATIVE, error, ierr)) |
| 142 |
1/2✓ Branch 0 taken 5 times.
✗ Branch 1 not taken.
|
55 | if (rank == 0) then |
| 143 | 50 | write (*, '(1p,a,e12.4,a,e12.4)') ' ', sigma, ' ', error | |
| 144 | end if | ||
| 145 | |||
| 146 | end do | ||
| 147 |
1/2✓ Branch 0 taken 5 times.
✗ Branch 1 not taken.
|
5 | if (rank == 0) then |
| 148 | 5 | write (*, *) | |
| 149 | end if | ||
| 150 | end if | ||
| 151 | |||
| 152 | ! ** Free work space | ||
| 153 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
|
5 | PetscCallA(SVDDestroy(svd, ierr)) |
| 154 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
|
5 | PetscCallA(MatDestroy(A, ierr)) |
| 155 | |||
| 156 |
0/2✗ Branch 0 not taken.
✗ Branch 1 not taken.
|
5 | PetscCallA(SlepcFinalize(ierr)) |
| 157 | ✗ | end program ex15f | |
| 158 | |||
| 159 | !/*TEST | ||
| 160 | ! | ||
| 161 | ! test: | ||
| 162 | ! suffix: 1 | ||
| 163 | ! filter: sed -e "s/[0-9]\.[0-9]*E[+-]\([0-9]*\)/removed/g" | ||
| 164 | ! | ||
| 165 | !TEST*/ | ||
| 166 |