| 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> ./test4f [-help] [-n <n>] [-m <m>] [all SLEPc options] | ||
| 11 | ! | ||
| 12 | ! Description: Singular value decomposition of a bidiagonal matrix. | ||
| 13 | ! | ||
| 14 | ! | 1 2 | | ||
| 15 | ! | 1 2 | | ||
| 16 | ! | 1 2 | | ||
| 17 | ! A = | . . | | ||
| 18 | ! | . . | | ||
| 19 | ! | 1 2 | | ||
| 20 | ! | 1 2 | | ||
| 21 | ! | ||
| 22 | ! The command line options are: | ||
| 23 | ! -m <m>, where <m> = matrix rows. | ||
| 24 | ! -n <n>, where <n> = matrix columns (defaults to m+2). | ||
| 25 | ! | ||
| 26 | ! ---------------------------------------------------------------------- | ||
| 27 | ! | ||
| 28 | #include <slepc/finclude/slepcsvd.h> | ||
| 29 | 535 | program test4f | |
| 30 | 25 | use slepcsvd | |
| 31 | implicit none | ||
| 32 | |||
| 33 | ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | ||
| 34 | ! Declarations | ||
| 35 | ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | ||
| 36 | ! | ||
| 37 | Mat :: A, B | ||
| 38 | SVD :: svd | ||
| 39 | SVDConv :: conv | ||
| 40 | SVDStop :: stp | ||
| 41 | SVDWhich :: which | ||
| 42 | SVDConvergedReason :: reason | ||
| 43 | PetscInt :: m, n, i, Istart | ||
| 44 | PetscInt :: col(2), its, Iend | ||
| 45 | PetscScalar :: val(2) | ||
| 46 | SVDProblemType :: ptype | ||
| 47 | PetscMPIInt :: rank | ||
| 48 | PetscErrorCode :: ierr | ||
| 49 | PetscBool :: flg, tmode | ||
| 50 | PetscViewerAndFormat :: vf | ||
| 51 | |||
| 52 | ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | ||
| 53 | ! Beginning of program | ||
| 54 | ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | ||
| 55 | |||
| 56 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
|
25 | PetscCallA(SlepcInitialize(PETSC_NULL_CHARACTER, ierr)) |
| 57 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
|
25 | PetscCallMPIA(MPI_Comm_rank(PETSC_COMM_WORLD, rank, ierr)) |
| 58 | 25 | m = 20 | |
| 59 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
|
25 | PetscCallA(PetscOptionsGetInt(PETSC_NULL_OPTIONS, PETSC_NULL_CHARACTER, '-m', m, flg, ierr)) |
| 60 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
|
25 | PetscCallA(PetscOptionsGetInt(PETSC_NULL_OPTIONS, PETSC_NULL_CHARACTER, '-n', n, flg, ierr)) |
| 61 |
1/2✓ Branch 0 taken 5 times.
✗ Branch 1 not taken.
|
25 | if (.not. flg) n = m + 2 |
| 62 | |||
| 63 |
1/2✓ Branch 0 taken 5 times.
✗ Branch 1 not taken.
|
25 | if (rank == 0) then |
| 64 | 25 | write (*, '(/a,i3,a,i3,a)') 'Bidiagonal matrix, m =', m, ', n=', n, ' (Fortran)' | |
| 65 | end if | ||
| 66 | |||
| 67 | ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | ||
| 68 | ! Build the Lauchli matrix | ||
| 69 | ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | ||
| 70 | |||
| 71 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
|
25 | PetscCallA(MatCreate(PETSC_COMM_WORLD, A, ierr)) |
| 72 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
|
25 | PetscCallA(MatSetSizes(A, PETSC_DECIDE, PETSC_DECIDE, m, n, ierr)) |
| 73 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
|
25 | PetscCallA(MatSetFromOptions(A, ierr)) |
| 74 | |||
| 75 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
|
25 | PetscCallA(MatGetOwnershipRange(A, Istart, Iend, ierr)) |
| 76 | 25 | val(1) = 1.0 | |
| 77 | 25 | val(2) = 2.0 | |
| 78 |
2/2✓ Branch 0 taken 5 times.
✓ Branch 1 taken 5 times.
|
525 | do i = Istart, Iend - 1 |
| 79 | 500 | col(1) = i | |
| 80 | 500 | col(2) = i + 1 | |
| 81 |
1/2✓ Branch 0 taken 5 times.
✗ Branch 1 not taken.
|
500 | if (i < n) then |
| 82 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
|
500 | PetscCallA(MatSetValue(A, i, col(1), val(1), INSERT_VALUES, ierr)) |
| 83 | end if | ||
| 84 |
1/2✓ Branch 0 taken 5 times.
✗ Branch 1 not taken.
|
525 | if (i < n - 1) then |
| 85 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
|
500 | PetscCallA(MatSetValue(A, i, col(2), val(2), INSERT_VALUES, ierr)) |
| 86 | end if | ||
| 87 | end do | ||
| 88 | |||
| 89 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
|
25 | PetscCallA(MatAssemblyBegin(A, MAT_FINAL_ASSEMBLY, ierr)) |
| 90 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
|
25 | PetscCallA(MatAssemblyEnd(A, MAT_FINAL_ASSEMBLY, ierr)) |
| 91 | |||
| 92 | ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | ||
| 93 | ! Compute singular values | ||
| 94 | ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | ||
| 95 | |||
| 96 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
|
25 | PetscCallA(SVDCreate(PETSC_COMM_WORLD, svd, ierr)) |
| 97 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
|
25 | PetscCallA(SVDSetOperators(svd, A, PETSC_NULL_MAT, ierr)) |
| 98 | |||
| 99 | ! ** test some interface functions | ||
| 100 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
|
25 | PetscCallA(SVDGetOperators(svd, B, PETSC_NULL_MAT, ierr)) |
| 101 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
|
25 | PetscCallA(MatView(B, PETSC_VIEWER_STDOUT_WORLD, ierr)) |
| 102 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
|
25 | PetscCallA(SVDSetConvergenceTest(svd, SVD_CONV_ABS, ierr)) |
| 103 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
|
25 | PetscCallA(SVDSetStoppingTest(svd, SVD_STOP_BASIC, ierr)) |
| 104 | |||
| 105 | ! ** query properties and print them | ||
| 106 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
|
25 | PetscCallA(SVDGetProblemType(svd, ptype, ierr)) |
| 107 |
1/2✓ Branch 0 taken 5 times.
✗ Branch 1 not taken.
|
25 | if (rank == 0) then |
| 108 | 25 | write (*, '(/a,i2)') ' Problem type = ', ptype | |
| 109 | end if | ||
| 110 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
|
25 | PetscCallA(SVDIsGeneralized(svd, flg, ierr)) |
| 111 |
1/4✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
✗ Branch 2 not taken.
✗ Branch 3 not taken.
|
25 | if (flg .and. rank == 0) then |
| 112 | ✗ | write (*, *) 'generalized' | |
| 113 | end if | ||
| 114 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
|
25 | PetscCallA(SVDGetImplicitTranspose(svd, tmode, ierr)) |
| 115 |
1/2✓ Branch 0 taken 5 times.
✗ Branch 1 not taken.
|
25 | if (rank == 0) then |
| 116 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
|
25 | if (tmode) then |
| 117 | ✗ | write (*, *) ' Transpose mode is implicit' | |
| 118 | else | ||
| 119 | 25 | write (*, *) ' Transpose mode is explicit' | |
| 120 | end if | ||
| 121 | end if | ||
| 122 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
|
25 | PetscCallA(SVDGetConvergenceTest(svd, conv, ierr)) |
| 123 |
1/2✓ Branch 0 taken 5 times.
✗ Branch 1 not taken.
|
25 | if (rank == 0) then |
| 124 | 25 | write (*, '(a,i2)') ' Convergence test is', conv | |
| 125 | end if | ||
| 126 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
|
25 | PetscCallA(SVDGetStoppingTest(svd, stp, ierr)) |
| 127 |
1/2✓ Branch 0 taken 5 times.
✗ Branch 1 not taken.
|
25 | if (rank == 0) then |
| 128 | 25 | write (*, '(a,i2)') ' Stopping test is', stp | |
| 129 | end if | ||
| 130 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
|
25 | PetscCallA(SVDGetWhichSingularTriplets(svd, which, ierr)) |
| 131 |
1/2✓ Branch 0 taken 5 times.
✗ Branch 1 not taken.
|
25 | if (rank == 0) then |
| 132 |
1/2✓ Branch 0 taken 5 times.
✗ Branch 1 not taken.
|
25 | if (which == SVD_LARGEST) then |
| 133 | 25 | write (*, *) ' Which = largest' | |
| 134 | else | ||
| 135 | ✗ | write (*, *) ' Which = smallest' | |
| 136 | end if | ||
| 137 | end if | ||
| 138 | |||
| 139 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
|
25 | PetscCallA(PetscViewerAndFormatCreate(PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_DEFAULT, vf, ierr)) |
| 140 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
|
25 | PetscCallA(SVDMonitorSet(svd, SVDMONITORFIRST, vf, PetscViewerAndFormatDestroy, ierr)) |
| 141 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
|
25 | PetscCallA(SVDMonitorConvergedCreate(PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_DEFAULT, PETSC_NULL, vf, ierr)) |
| 142 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
|
25 | PetscCallA(SVDMonitorSet(svd, SVDMONITORCONVERGED, vf, PetscViewerAndFormatDestroy, ierr)) |
| 143 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
|
25 | PetscCallA(SVDMonitorCancel(svd, ierr)) |
| 144 | |||
| 145 | ! ** call the solver | ||
| 146 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
|
25 | PetscCallA(SVDSetFromOptions(svd, ierr)) |
| 147 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
|
25 | PetscCallA(SVDSolve(svd, ierr)) |
| 148 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
|
25 | PetscCallA(SVDGetConvergedReason(svd, reason, ierr)) |
| 149 |
1/2✓ Branch 0 taken 5 times.
✗ Branch 1 not taken.
|
25 | if (rank == 0) then |
| 150 | 25 | write (*, '(a,i2)') ' Converged reason:', reason | |
| 151 | end if | ||
| 152 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
|
25 | PetscCallA(SVDGetIterationNumber(svd, its, ierr)) |
| 153 | ! if (rank==0) then | ||
| 154 | ! write(*,'(a,i4)') ' Number of iterations of the method:', its | ||
| 155 | ! end if | ||
| 156 | |||
| 157 | ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | ||
| 158 | ! Display solution and clean up | ||
| 159 | ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | ||
| 160 | |||
| 161 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
|
25 | PetscCallA(SVDErrorView(svd, SVD_ERROR_RELATIVE, PETSC_NULL_VIEWER, ierr)) |
| 162 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
|
25 | PetscCallA(SVDDestroy(svd, ierr)) |
| 163 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
|
25 | PetscCallA(MatDestroy(A, ierr)) |
| 164 | |||
| 165 |
0/2✗ Branch 0 not taken.
✗ Branch 1 not taken.
|
25 | PetscCallA(SlepcFinalize(ierr)) |
| 166 | ✗ | end program test4f | |
| 167 | |||
| 168 | !/*TEST | ||
| 169 | ! | ||
| 170 | ! test: | ||
| 171 | ! suffix: 1 | ||
| 172 | ! args: -svd_type {{lanczos trlanczos cross cyclic randomized}} | ||
| 173 | ! filter: sed -e 's/2.99255/2.99254/' | ||
| 174 | ! | ||
| 175 | !TEST*/ | ||
| 176 |