| 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> ./test3f [-help] [-n <n>] [all SLEPc options] | ||
| 11 | ! | ||
| 12 | ! Description: square root of the 2-D Laplacian. | ||
| 13 | ! | ||
| 14 | ! The command line options are: | ||
| 15 | ! -n <n>, where <n> = matrix rows and columns | ||
| 16 | ! | ||
| 17 | ! ---------------------------------------------------------------------- | ||
| 18 | ! | ||
| 19 | #include <slepc/finclude/slepcmfn.h> | ||
| 20 | 8 | program test3f | |
| 21 | 6 | use slepcmfn | |
| 22 | implicit none | ||
| 23 | |||
| 24 | ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | ||
| 25 | ! Declarations | ||
| 26 | ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | ||
| 27 | |||
| 28 | Mat :: A, B | ||
| 29 | MFN :: mfn | ||
| 30 | FN :: f | ||
| 31 | MFNConvergedReason :: reason | ||
| 32 | Vec :: v, y | ||
| 33 | PetscInt :: Nt, n, i, j, II | ||
| 34 | PetscInt :: Istart, maxit, ncv | ||
| 35 | PetscInt :: col, its, Iend | ||
| 36 | PetscScalar :: val | ||
| 37 | PetscReal :: tol, norm | ||
| 38 | PetscMPIInt :: rank | ||
| 39 | PetscErrorCode :: ierr | ||
| 40 | PetscBool :: flg | ||
| 41 | |||
| 42 | ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | ||
| 43 | ! Beginning of program | ||
| 44 | ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | ||
| 45 | |||
| 46 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
6 | PetscCallA(SlepcInitialize(PETSC_NULL_CHARACTER, ierr)) |
| 47 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
6 | PetscCallMPIA(MPI_Comm_rank(PETSC_COMM_WORLD, rank, ierr)) |
| 48 | 6 | n = 4 | |
| 49 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
6 | PetscCallA(PetscOptionsGetInt(PETSC_NULL_OPTIONS, PETSC_NULL_CHARACTER, '-n', n, flg, ierr)) |
| 50 | 6 | Nt = n*n | |
| 51 | |||
| 52 |
1/2✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
|
6 | if (rank == 0) then |
| 53 | 6 | write (*, '(/a,i3,a)') 'Square root of Laplacian, n=', n, ' (Fortran)' | |
| 54 | end if | ||
| 55 | |||
| 56 | ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | ||
| 57 | ! Compute the discrete 2-D Laplacian | ||
| 58 | ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | ||
| 59 | |||
| 60 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
6 | PetscCallA(MatCreate(PETSC_COMM_WORLD, A, ierr)) |
| 61 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
6 | PetscCallA(MatSetSizes(A, PETSC_DECIDE, PETSC_DECIDE, Nt, Nt, ierr)) |
| 62 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
6 | PetscCallA(MatSetFromOptions(A, ierr)) |
| 63 | |||
| 64 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
6 | PetscCallA(MatGetOwnershipRange(A, Istart, Iend, ierr)) |
| 65 |
2/2✓ Branch 0 taken 6 times.
✓ Branch 1 taken 6 times.
|
102 | do II = Istart, Iend - 1 |
| 66 | 96 | i = II/n | |
| 67 | 96 | j = II - i*n | |
| 68 | 96 | val = -1.0 | |
| 69 |
2/2✓ Branch 0 taken 6 times.
✓ Branch 1 taken 6 times.
|
96 | if (i > 0) then |
| 70 | 72 | col = II - n | |
| 71 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
72 | PetscCallA(MatSetValue(A, II, col, val, INSERT_VALUES, ierr)) |
| 72 | end if | ||
| 73 |
2/2✓ Branch 0 taken 6 times.
✓ Branch 1 taken 6 times.
|
96 | if (i < n - 1) then |
| 74 | 72 | col = II + n | |
| 75 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
72 | PetscCallA(MatSetValue(A, II, col, val, INSERT_VALUES, ierr)) |
| 76 | end if | ||
| 77 |
2/2✓ Branch 0 taken 6 times.
✓ Branch 1 taken 6 times.
|
96 | if (j > 0) then |
| 78 | 72 | col = II - 1 | |
| 79 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
72 | PetscCallA(MatSetValue(A, II, col, val, INSERT_VALUES, ierr)) |
| 80 | end if | ||
| 81 |
2/2✓ Branch 0 taken 6 times.
✓ Branch 1 taken 6 times.
|
96 | if (j < n - 1) then |
| 82 | 72 | col = II + 1 | |
| 83 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
72 | PetscCallA(MatSetValue(A, II, col, val, INSERT_VALUES, ierr)) |
| 84 | end if | ||
| 85 | 96 | val = 4.0 | |
| 86 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
102 | PetscCallA(MatSetValue(A, II, II, val, INSERT_VALUES, ierr)) |
| 87 | end do | ||
| 88 | |||
| 89 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
6 | PetscCallA(MatAssemblyBegin(A, MAT_FINAL_ASSEMBLY, ierr)) |
| 90 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
6 | PetscCallA(MatAssemblyEnd(A, MAT_FINAL_ASSEMBLY, ierr)) |
| 91 | |||
| 92 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
6 | PetscCallA(MatCreateVecs(A, PETSC_NULL_VEC, v, ierr)) |
| 93 | 6 | i = 0 | |
| 94 | 6 | val = 1.0 | |
| 95 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
6 | PetscCallA(VecSetValue(v, i, val, INSERT_VALUES, ierr)) |
| 96 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
6 | PetscCallA(VecAssemblyBegin(v, ierr)) |
| 97 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
6 | PetscCallA(VecAssemblyEnd(v, ierr)) |
| 98 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
6 | PetscCallA(VecDuplicate(v, y, ierr)) |
| 99 | |||
| 100 | ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | ||
| 101 | ! Compute singular values | ||
| 102 | ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | ||
| 103 | |||
| 104 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
6 | PetscCallA(MFNCreate(PETSC_COMM_WORLD, mfn, ierr)) |
| 105 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
6 | PetscCallA(MFNSetOperator(mfn, A, ierr)) |
| 106 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
6 | PetscCallA(MFNGetFN(mfn, f, ierr)) |
| 107 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
6 | PetscCallA(FNSetType(f, FNSQRT, ierr)) |
| 108 | |||
| 109 | ! ** test some interface functions | ||
| 110 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
6 | PetscCallA(MFNGetOperator(mfn, B, ierr)) |
| 111 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
6 | PetscCallA(MatView(B, PETSC_VIEWER_STDOUT_WORLD, ierr)) |
| 112 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
6 | PetscCallA(MFNSetOptionsPrefix(mfn, 'myprefix_', ierr)) |
| 113 | 6 | tol = 1e-4 | |
| 114 | 6 | maxit = 500 | |
| 115 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
6 | PetscCallA(MFNSetTolerances(mfn, tol, maxit, ierr)) |
| 116 | 6 | ncv = 6 | |
| 117 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
6 | PetscCallA(MFNSetDimensions(mfn, ncv, ierr)) |
| 118 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
6 | PetscCallA(MFNSetErrorIfNotConverged(mfn, PETSC_TRUE, ierr)) |
| 119 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
6 | PetscCallA(MFNSetFromOptions(mfn, ierr)) |
| 120 | |||
| 121 | ! ** query properties and print them | ||
| 122 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
6 | PetscCallA(MFNGetTolerances(mfn, tol, maxit, ierr)) |
| 123 |
1/2✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
|
6 | if (rank == 0) then |
| 124 | 6 | write (*, '(/a,f7.4,a,i4)') ' Tolerance: ', tol, ', maxit: ', maxit | |
| 125 | end if | ||
| 126 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
6 | PetscCallA(MFNGetDimensions(mfn, ncv, ierr)) |
| 127 |
1/2✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
|
6 | if (rank == 0) then |
| 128 | 6 | write (*, '(a,i3)') ' Subspace dimension: ', ncv | |
| 129 | end if | ||
| 130 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
6 | PetscCallA(MFNGetErrorIfNotConverged(mfn, flg, ierr)) |
| 131 |
2/4✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 6 times.
✗ Branch 3 not taken.
|
6 | if (rank == 0 .and. flg) then |
| 132 | 6 | write (*, *) 'Erroring out if convergence fails' | |
| 133 | end if | ||
| 134 | |||
| 135 | ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | ||
| 136 | ! Call the solver | ||
| 137 | ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | ||
| 138 | |||
| 139 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
6 | PetscCallA(MFNSolve(mfn, v, y, ierr)) |
| 140 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
6 | PetscCallA(MFNGetConvergedReason(mfn, reason, ierr)) |
| 141 |
1/2✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
|
6 | if (rank == 0) then |
| 142 | 6 | write (*, '(a,i2)') ' Converged reason:', reason | |
| 143 | end if | ||
| 144 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
6 | PetscCallA(MFNGetIterationNumber(mfn, its, ierr)) |
| 145 | ! if (rank==0) then | ||
| 146 | ! write(*, '(a,i4)') ' Number of iterations of the method:', its | ||
| 147 | ! end if | ||
| 148 | |||
| 149 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
6 | PetscCallA(VecNorm(y, NORM_2, norm, ierr)) |
| 150 |
1/2✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
|
6 | if (rank == 0) then |
| 151 | 6 | write (*, '(a,f7.4)') ' sqrt(A)*v has norm ', norm | |
| 152 | end if | ||
| 153 | |||
| 154 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
6 | PetscCallA(MFNDestroy(mfn, ierr)) |
| 155 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
6 | PetscCallA(MatDestroy(A, ierr)) |
| 156 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
6 | PetscCallA(VecDestroy(v, ierr)) |
| 157 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
6 | PetscCallA(VecDestroy(y, ierr)) |
| 158 | |||
| 159 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
|
6 | PetscCallA(SlepcFinalize(ierr)) |
| 160 | 1 | end program test3f | |
| 161 | |||
| 162 | !/*TEST | ||
| 163 | ! | ||
| 164 | ! test: | ||
| 165 | ! suffix: 1 | ||
| 166 | ! args: -log_exclude mfn | ||
| 167 | ! | ||
| 168 | !TEST*/ | ||
| 169 |