Actual source code: test15f.F

slepc-3.11.2 2019-07-30
Report Typos and Errors
  1: !
  2: !  - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  3: !  SLEPc - Scalable Library for Eigenvalue Problem Computations
  4: !  Copyright (c) 2002-2019, 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:       program main
 21: #include <slepc/finclude/slepceps.h>
 22:       use slepceps
 23:       implicit none

 25: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 26: !     Declarations
 27: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 28: !
 29: !  Variables:
 30: !     A     operator matrix
 31: !     eps   eigenproblem solver context

 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)

 45: !  Note: Any user-defined Fortran routines (such as MyEPSMonitor)
 46: !  MUST be declared as external.

 48:       external MyEPSMonitor

 50: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 51: !     Beginning of program
 52: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

 54:       call SlepcInitialize(PETSC_NULL_CHARACTER,ierr)
 55:       call MPI_Comm_rank(PETSC_COMM_WORLD,rank,ierr)
 56:       n = 30
 57:       call PetscOptionsGetInt(PETSC_NULL_OPTIONS,PETSC_NULL_CHARACTER,  &
 58:      &                        '-n',n,flg,ierr)

 60:       if (rank .eq. 0) then
 61:         write(*,100) n
 62:       endif
 63:  100  format (/'1-D Laplacian Eigenproblem, n =',I3,' (Fortran)')

 65: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 66: !     Compute the operator matrix that defines the eigensystem, Ax=kx
 67: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

 69:       call MatCreate(PETSC_COMM_WORLD,A,ierr)
 70:       call MatSetSizes(A,PETSC_DECIDE,PETSC_DECIDE,n,n,ierr)
 71:       call MatSetFromOptions(A,ierr)
 72:       call MatSetUp(A,ierr)

 74:       i1 = 1
 75:       i2 = 2
 76:       i3 = 3
 77:       call MatGetOwnershipRange(A,Istart,Iend,ierr)
 78:       if (Istart .eq. 0) then
 79:         i = 0
 80:         col(1) = 0
 81:         col(2) = 1
 82:         value(1) =  2.0
 83:         value(2) = -1.0
 84:         call MatSetValues(A,i1,i,i2,col,value,INSERT_VALUES,ierr)
 85:         Istart = Istart+1
 86:       endif
 87:       if (Iend .eq. n) then
 88:         i = n-1
 89:         col(1) = n-2
 90:         col(2) = n-1
 91:         value(1) = -1.0
 92:         value(2) =  2.0
 93:         call MatSetValues(A,i1,i,i2,col,value,INSERT_VALUES,ierr)
 94:         Iend = Iend-1
 95:       endif
 96:       value(1) = -1.0
 97:       value(2) =  2.0
 98:       value(3) = -1.0
 99:       do i=Istart,Iend-1
100:         col(1) = i-1
101:         col(2) = i
102:         col(3) = i+1
103:         call MatSetValues(A,i1,i,i3,col,value,INSERT_VALUES,ierr)
104:       enddo

106:       call MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY,ierr)
107:       call MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY,ierr)

109: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
110: !     Create the eigensolver and display info
111: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

113: !     ** Create eigensolver context
114:       call EPSCreate(PETSC_COMM_WORLD,eps,ierr)

116: !     ** Set operators. In this case, it is a standard eigenvalue problem
117:       call EPSSetOperators(eps,A,PETSC_NULL_MAT,ierr)
118:       call EPSSetProblemType(eps,EPS_HEP,ierr)

120: !     ** Set user-defined monitor
121:       call PetscOptionsHasName(PETSC_NULL_OPTIONS,PETSC_NULL_CHARACTER, &
122:      &                        '-my_eps_monitor',flg,ierr)
123:       if (flg) then
124:         call EPSMonitorSet(eps,MyEPSMonitor,0,PETSC_NULL_FUNCTION,ierr)
125:       endif

127: !     ** Set solver parameters at runtime
128:       call EPSSetFromOptions(eps,ierr)

130: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
131: !     Solve the eigensystem
132: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

134:       call EPSSolve(eps,ierr)

136: !     ** Optional: Get some information from the solver and display it
137:       call EPSGetType(eps,tname,ierr)
138:       if (rank .eq. 0) then
139:         write(*,120) tname
140:       endif
141:  120  format (' Solution method: ',A)
142:       call EPSGetDimensions(eps,nev,PETSC_NULL_INTEGER,                 &
143:      &                      PETSC_NULL_INTEGER,ierr)
144:       if (rank .eq. 0) then
145:         write(*,130) nev
146:       endif
147:  130  format (' Number of requested eigenvalues:',I2)

149: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
150: !     Display solution and clean up
151: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

153:       call EPSErrorView(eps,EPS_ERROR_RELATIVE,PETSC_NULL_VIEWER,ierr)
154:       call EPSDestroy(eps,ierr)
155:       call MatDestroy(A,ierr)

157:       call SlepcFinalize(ierr)
158:       end

160: ! --------------------------------------------------------------
161: !
162: !  MyEPSMonitor - This is a user-defined routine for monitoring
163: !  the EPS iterative solvers.
164: !
165: !  Input Parameters:
166: !    eps   - eigensolver context
167: !    its   - iteration number
168: !    nconv - number of converged eigenpairs
169: !    eigr  - real part of the eigenvalues
170: !    eigi  - imaginary part of the eigenvalues
171: !    errest- relative error estimates for each eigenpair
172: !    nest  - number of error estimates
173: !    dummy - optional user-defined monitor context (unused here)
174: !
175:       subroutine MyEPSMonitor(eps,its,nconv,eigr,eigi,errest,nest,dummy,&
176:      &                        ierr)
177: #include <slepc/finclude/slepceps.h>
178:       use slepceps
179:       implicit none

181:       EPS            eps
182:       PetscErrorCode ierr
183:       PetscInt       its,nconv,nest,dummy
184:       PetscScalar    eigr(*),eigi(*)
185:       PetscReal      re,errest(*)
186:       PetscMPIInt    rank

188:       call MPI_Comm_rank(PETSC_COMM_WORLD,rank,ierr)
189:       if (its .gt. 0 .and. rank .eq. 0) then
190:         re = PetscRealPart(eigr(nconv+1))
191:         write(6,140) its,nconv,re,errest(nconv+1)
192:       endif

194:  140  format(i3,' EPS nconv=',i2,' first unconverged value (error) ',   &
195:      &       f7.4,' (',g10.3,')')
196:       0
197:       end

199: !/*TEST
200: !
201: !   test:
202: !      suffix: 1
203: !      args: -my_eps_monitor
204: !      requires: double
205: !
206: !TEST*/