| 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> ./test15f [-help] [-n <n>] [all SLEPc options] | ||
| 11 | ! | ||
| 12 | ! Description: Tests custom monitors from Fortran. | ||
| 13 | ! | ||
| 14 | ! The command line options are: | ||
| 15 | ! -n <n>, where <n> = number of grid points = matrix size | ||
| 16 | ! -my_eps_monitor, activates the custom monitor | ||
| 17 | ! | ||
| 18 | ! ---------------------------------------------------------------------- | ||
| 19 | ! | ||
| 20 | 8 | program main | |
| 21 | #include <slepc/finclude/slepceps.h> | ||
| 22 | 6 | use slepceps | |
| 23 | implicit none | ||
| 24 | |||
| 25 | ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | ||
| 26 | ! Declarations | ||
| 27 | ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | ||
| 28 | ! | ||
| 29 | ! Variables: | ||
| 30 | ! A operator matrix | ||
| 31 | ! eps eigenproblem solver context | ||
| 32 | |||
| 33 | Mat A | ||
| 34 | EPS eps | ||
| 35 | EPSType tname | ||
| 36 | PetscInt n, i, Istart, Iend | ||
| 37 | PetscInt nev | ||
| 38 | PetscInt col(3) | ||
| 39 | PetscInt i1,i2,i3 | ||
| 40 | PetscMPIInt rank | ||
| 41 | PetscErrorCode ierr | ||
| 42 | PetscBool flg | ||
| 43 | PetscScalar value(3) | ||
| 44 | |||
| 45 | ! Note: Any user-defined Fortran routines (such as MyEPSMonitor) | ||
| 46 | ! MUST be declared as external. | ||
| 47 | |||
| 48 | external MyEPSMonitor | ||
| 49 | |||
| 50 | ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | ||
| 51 | ! Beginning of program | ||
| 52 | ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | ||
| 53 | |||
| 54 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
6 | PetscCallA(SlepcInitialize(PETSC_NULL_CHARACTER,ierr)) |
| 55 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
6 | PetscCallMPIA(MPI_Comm_rank(PETSC_COMM_WORLD,rank,ierr)) |
| 56 | 6 | n = 30 | |
| 57 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
6 | PetscCallA(PetscOptionsGetInt(PETSC_NULL_OPTIONS,PETSC_NULL_CHARACTER,'-n',n,flg,ierr)) |
| 58 | |||
| 59 |
1/2✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
|
6 | if (rank .eq. 0) then |
| 60 | 6 | write(*,100) n | |
| 61 | endif | ||
| 62 | 100 format (/'1-D Laplacian Eigenproblem, n =',I3,' (Fortran)') | ||
| 63 | |||
| 64 | ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | ||
| 65 | ! Compute the operator matrix that defines the eigensystem, Ax=kx | ||
| 66 | ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | ||
| 67 | |||
| 68 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
6 | PetscCallA(MatCreate(PETSC_COMM_WORLD,A,ierr)) |
| 69 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
6 | PetscCallA(MatSetSizes(A,PETSC_DECIDE,PETSC_DECIDE,n,n,ierr)) |
| 70 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
6 | PetscCallA(MatSetFromOptions(A,ierr)) |
| 71 | |||
| 72 | 6 | i1 = 1 | |
| 73 | 6 | i2 = 2 | |
| 74 | 6 | i3 = 3 | |
| 75 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
6 | PetscCallA(MatGetOwnershipRange(A,Istart,Iend,ierr)) |
| 76 |
1/2✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
|
6 | if (Istart .eq. 0) then |
| 77 | 6 | i = 0 | |
| 78 | 6 | col(1) = 0 | |
| 79 | 6 | col(2) = 1 | |
| 80 | 6 | value(1) = 2.0 | |
| 81 | 6 | value(2) = -1.0 | |
| 82 |
3/4✓ Branch 0 taken 6 times.
✓ Branch 1 taken 6 times.
✗ Branch 2 not taken.
✓ Branch 3 taken 6 times.
|
12 | PetscCallA(MatSetValues(A,i1,[i],i2,col,value,INSERT_VALUES,ierr)) |
| 83 | 6 | Istart = Istart+1 | |
| 84 | endif | ||
| 85 |
1/2✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
|
6 | if (Iend .eq. n) then |
| 86 | 6 | i = n-1 | |
| 87 | 6 | col(1) = n-2 | |
| 88 | 6 | col(2) = n-1 | |
| 89 | 6 | value(1) = -1.0 | |
| 90 | 6 | value(2) = 2.0 | |
| 91 |
3/4✓ Branch 0 taken 6 times.
✓ Branch 1 taken 6 times.
✗ Branch 2 not taken.
✓ Branch 3 taken 6 times.
|
12 | PetscCallA(MatSetValues(A,i1,[i],i2,col,value,INSERT_VALUES,ierr)) |
| 92 | 6 | Iend = Iend-1 | |
| 93 | endif | ||
| 94 | 6 | value(1) = -1.0 | |
| 95 | 6 | value(2) = 2.0 | |
| 96 | 6 | value(3) = -1.0 | |
| 97 |
2/2✓ Branch 0 taken 6 times.
✓ Branch 1 taken 6 times.
|
174 | do i=Istart,Iend-1 |
| 98 | 168 | col(1) = i-1 | |
| 99 | 168 | col(2) = i | |
| 100 | 168 | col(3) = i+1 | |
| 101 |
3/4✓ Branch 0 taken 6 times.
✓ Branch 1 taken 6 times.
✓ Branch 2 taken 6 times.
✗ Branch 3 not taken.
|
342 | PetscCallA(MatSetValues(A,i1,[i],i3,col,value,INSERT_VALUES,ierr)) |
| 102 | enddo | ||
| 103 | |||
| 104 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
6 | PetscCallA(MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY,ierr)) |
| 105 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
6 | PetscCallA(MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY,ierr)) |
| 106 | |||
| 107 | ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | ||
| 108 | ! Create the eigensolver and display info | ||
| 109 | ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | ||
| 110 | |||
| 111 | ! ** Create eigensolver context | ||
| 112 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
6 | PetscCallA(EPSCreate(PETSC_COMM_WORLD,eps,ierr)) |
| 113 | |||
| 114 | ! ** Set operators. In this case, it is a standard eigenvalue problem | ||
| 115 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
6 | PetscCallA(EPSSetOperators(eps,A,PETSC_NULL_MAT,ierr)) |
| 116 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
6 | PetscCallA(EPSSetProblemType(eps,EPS_HEP,ierr)) |
| 117 | |||
| 118 | ! ** Set user-defined monitor | ||
| 119 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
6 | PetscCallA(PetscOptionsHasName(PETSC_NULL_OPTIONS,PETSC_NULL_CHARACTER,'-my_eps_monitor',flg,ierr)) |
| 120 |
1/2✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
|
6 | if (flg) then |
| 121 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
6 | PetscCallA(EPSMonitorSet(eps,MyEPSMonitor,0,PETSC_NULL_FUNCTION,ierr)) |
| 122 | endif | ||
| 123 | |||
| 124 | ! ** Set solver parameters at runtime | ||
| 125 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
6 | PetscCallA(EPSSetFromOptions(eps,ierr)) |
| 126 | |||
| 127 | ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | ||
| 128 | ! Solve the eigensystem | ||
| 129 | ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | ||
| 130 | |||
| 131 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
6 | PetscCallA(EPSSolve(eps,ierr)) |
| 132 | |||
| 133 | ! ** Optional: Get some information from the solver and display it | ||
| 134 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
6 | PetscCallA(EPSGetType(eps,tname,ierr)) |
| 135 |
1/2✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
|
6 | if (rank .eq. 0) then |
| 136 | 6 | write(*,120) tname | |
| 137 | endif | ||
| 138 | 120 format (' Solution method: ',A) | ||
| 139 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
6 | PetscCallA(EPSGetDimensions(eps,nev,PETSC_NULL_INTEGER,PETSC_NULL_INTEGER,ierr)) |
| 140 |
1/2✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
|
6 | if (rank .eq. 0) then |
| 141 | 6 | write(*,130) nev | |
| 142 | endif | ||
| 143 | 130 format (' Number of requested eigenvalues:',I2) | ||
| 144 | |||
| 145 | ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | ||
| 146 | ! Display solution and clean up | ||
| 147 | ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | ||
| 148 | |||
| 149 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
6 | PetscCallA(EPSErrorView(eps,EPS_ERROR_RELATIVE,PETSC_NULL_VIEWER,ierr)) |
| 150 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
6 | PetscCallA(EPSDestroy(eps,ierr)) |
| 151 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
6 | PetscCallA(MatDestroy(A,ierr)) |
| 152 | |||
| 153 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
|
6 | PetscCallA(SlepcFinalize(ierr)) |
| 154 | 1 | end | |
| 155 | |||
| 156 | ! -------------------------------------------------------------- | ||
| 157 | ! | ||
| 158 | ! MyEPSMonitor - This is a user-defined routine for monitoring | ||
| 159 | ! the EPS iterative solvers. | ||
| 160 | ! | ||
| 161 | ! Input Parameters: | ||
| 162 | ! eps - eigensolver context | ||
| 163 | ! its - iteration number | ||
| 164 | ! nconv - number of converged eigenpairs | ||
| 165 | ! eigr - real part of the eigenvalues | ||
| 166 | ! eigi - imaginary part of the eigenvalues | ||
| 167 | ! errest- relative error estimates for each eigenpair | ||
| 168 | ! nest - number of error estimates | ||
| 169 | ! dummy - optional user-defined monitor context (unused here) | ||
| 170 | ! | ||
| 171 | 24 | subroutine MyEPSMonitor(eps,its,nconv,eigr,eigi,errest,nest,dummy,ierr) | |
| 172 | #include <slepc/finclude/slepceps.h> | ||
| 173 | use slepceps | ||
| 174 | implicit none | ||
| 175 | |||
| 176 | EPS eps | ||
| 177 | PetscErrorCode ierr | ||
| 178 | PetscInt its,nconv,nest,dummy | ||
| 179 | PetscScalar eigr(*),eigi(*) | ||
| 180 | PetscReal re,errest(*) | ||
| 181 | PetscMPIInt rank | ||
| 182 | |||
| 183 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
|
24 | PetscCallMPI(MPI_Comm_rank(PETSC_COMM_WORLD,rank,ierr)) |
| 184 |
2/4✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 6 times.
✗ Branch 3 not taken.
|
24 | if (its .gt. 0 .and. rank .eq. 0) then |
| 185 | 24 | re = PetscRealPart(eigr(nconv+1)) | |
| 186 | 24 | write(6,140) its,nconv,re,errest(nconv+1) | |
| 187 | endif | ||
| 188 | |||
| 189 | 140 format(i3,' EPS nconv=',i2,' first unconverged value (error) ',f7.4,' (',g10.3,')') | ||
| 190 | 24 | ierr = 0 | |
| 191 | end | ||
| 192 | |||
| 193 | !/*TEST | ||
| 194 | ! | ||
| 195 | ! test: | ||
| 196 | ! suffix: 1 | ||
| 197 | ! args: -my_eps_monitor | ||
| 198 | ! requires: double | ||
| 199 | ! | ||
| 200 | !TEST*/ | ||
| 201 |