Actual source code: test15f.F
slepc-3.11.2 2019-07-30
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*/