Actual source code: test14f.F
1: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2: ! SLEPc - Scalable Library for Eigenvalue Problem Computations
3: ! Copyright (c) 2002-2013, Universitat Politecnica de Valencia, Spain
4: !
5: ! This file is part of SLEPc.
6: !
7: ! SLEPc is free software: you can redistribute it and/or modify it under the
8: ! terms of version 3 of the GNU Lesser General Public License as published by
9: ! the Free Software Foundation.
10: !
11: ! SLEPc is distributed in the hope that it will be useful, but WITHOUT ANY
12: ! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
13: ! FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for
14: ! more details.
15: !
16: ! You should have received a copy of the GNU Lesser General Public License
17: ! along with SLEPc. If not, see <http://www.gnu.org/licenses/>.
18: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
19: !
20: ! Description: Simple example to test the EPS Fortran interface.
21: !
22: ! ----------------------------------------------------------------------
23: !
24: program main
25: implicit none
27: #include <finclude/petscsys.h>
28: #include <finclude/petscvec.h>
29: #include <finclude/petscmat.h>
30: #include <finclude/slepcsys.h>
31: #include <finclude/slepceps.h>
33: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
34: ! Declarations
35: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
36: Mat A,B
37: EPS eps
38: ST st
39: IP ip
40: DS ds
41: PetscReal cut,tol
42: PetscScalar tget,value
43: PetscInt n,i,its,Istart,Iend
44: PetscInt nev,ncv,mpd
45: PetscBool flg
46: EPSConvergedReason reason
47: EPSType tname
48: EPSExtraction extr
49: EPSBalance bal
50: EPSWhich which
51: EPSConv conv
52: EPSProblemType ptype
53: PetscMPIInt rank
54: PetscErrorCode ierr
56: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
57: ! Beginning of program
58: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
60: call SlepcInitialize(PETSC_NULL_CHARACTER,ierr)
61: call MPI_Comm_rank(PETSC_COMM_WORLD,rank,ierr)
62: n = 20
63: if (rank .eq. 0) then
64: write(*,100) n
65: endif
66: 100 format (/'Diagonal Eigenproblem, n =',I3,' (Fortran)')
68: call MatCreate(PETSC_COMM_WORLD,A,ierr)
69: call MatSetSizes(A,PETSC_DECIDE,PETSC_DECIDE,n,n,ierr)
70: call MatSetFromOptions(A,ierr)
71: call MatSetUp(A,ierr)
72: call MatGetOwnershipRange(A,Istart,Iend,ierr)
73: do i=Istart,Iend-1
74: value = i+1
75: call MatSetValue(A,i,i,value,INSERT_VALUES,ierr)
76: enddo
77: call MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY,ierr)
78: call MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY,ierr)
80: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
81: ! Create eigensolver and test interface functions
82: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
84: call EPSCreate(PETSC_COMM_WORLD,eps,ierr)
85: call EPSSetOperators(eps,A,PETSC_NULL_OBJECT,ierr)
86: call EPSGetOperators(eps,B,PETSC_NULL_OBJECT,ierr)
87: call MatView(B,PETSC_NULL_OBJECT,ierr)
89: call EPSSetType(eps,EPSKRYLOVSCHUR,ierr)
90: call EPSGetType(eps,tname,ierr)
91: if (rank .eq. 0) then
92: write(*,110) tname
93: endif
94: 110 format (' Type set to ',A)
96: call EPSGetProblemType(eps,ptype,ierr)
97: if (rank .eq. 0) then
98: write(*,120) ptype
99: endif
100: 120 format (' Problem type before changing = ',I2)
101: call EPSSetProblemType(eps,EPS_HEP,ierr)
102: call EPSGetProblemType(eps,ptype,ierr)
103: if (rank .eq. 0) then
104: write(*,130) ptype
105: endif
106: 130 format (' ... changed to ',I2)
107: call EPSIsGeneralized(eps,flg,ierr)
108: if (flg .and. rank .eq. 0) then
109: write(*,*) 'generalized'
110: endif
111: call EPSIsHermitian(eps,flg,ierr)
112: if (flg .and. rank .eq. 0) then
113: write(*,*) 'hermitian'
114: endif
115: call EPSIsPositive(eps,flg,ierr)
116: if (flg .and. rank .eq. 0) then
117: write(*,*) 'positive'
118: endif
120: call EPSGetExtraction(eps,extr,ierr)
121: if (rank .eq. 0) then
122: write(*,140) extr
123: endif
124: 140 format (' Extraction before changing = ',I2)
125: call EPSSetExtraction(eps,EPS_HARMONIC,ierr)
126: call EPSGetExtraction(eps,extr,ierr)
127: if (rank .eq. 0) then
128: write(*,150) extr
129: endif
130: 150 format (' ... changed to ',I2)
132: its = 8
133: cut = 1.0d-6
134: bal = EPS_BALANCE_ONESIDE
135: call EPSSetBalance(eps,bal,its,cut,ierr)
136: ! call EPSGetBalance(eps,bal,its,cut,ierr)
137: if (rank .eq. 0) then
138: write(*,160) bal,its,cut
139: endif
140: 160 format (' Balance: ',I2,', its=',I2,', cutoff=',F8.6)
142: tget = 4.8
143: call EPSSetTarget(eps,tget,ierr)
144: call EPSGetTarget(eps,tget,ierr)
145: call EPSSetWhichEigenpairs(eps,EPS_TARGET_MAGNITUDE,ierr)
146: call EPSGetWhichEigenpairs(eps,which,ierr)
147: if (rank .eq. 0) then
148: write(*,170) which,PetscRealPart(tget)
149: endif
150: 170 format (' Which = ',I2,', target = ',F3.1)
152: nev = 4
153: call EPSSetDimensions(eps,nev,PETSC_NULL_INTEGER, &
154: & PETSC_NULL_INTEGER,ierr)
155: call EPSGetDimensions(eps,nev,ncv,mpd,ierr)
156: if (rank .eq. 0) then
157: write(*,180) nev,ncv,mpd
158: endif
159: 180 format (' Dimensions: nev=',I2,', ncv=',I2,', mpd=',I2)
161: tol = 2.2d-4
162: its = 200
163: call EPSSetTolerances(eps,tol,its,ierr)
164: call EPSGetTolerances(eps,tol,its,ierr)
165: if (rank .eq. 0) then
166: write(*,190) tol,its
167: endif
168: 190 format (' Tolerance =',F7.5,', max_its =',I4)
170: call EPSSetConvergenceTest(eps,EPS_CONV_ABS,ierr)
171: ! call EPSGetConvergenceTest(eps,conv,ierr)
172: conv = 0
173: if (rank .eq. 0) then
174: write(*,200) conv
175: endif
176: 200 format (' Convergence test =',I2)
178: call EPSMonitorSet(eps,EPSMONITORFIRST,PETSC_NULL_OBJECT, &
179: & PETSC_NULL_FUNCTION,ierr)
180: call EPSMonitorCancel(eps,ierr)
182: call EPSGetST(eps,st,ierr)
183: call STView(st,PETSC_NULL_OBJECT,ierr)
184: call EPSGetIP(eps,ip,ierr)
185: call IPView(ip,PETSC_NULL_OBJECT,ierr)
186: call EPSGetDS(eps,ds,ierr)
187: call DSView(ds,PETSC_NULL_OBJECT,ierr)
189: call EPSSetFromOptions(eps,ierr)
190: call EPSSolve(eps,ierr)
191: call EPSGetConvergedReason(eps,reason,ierr)
192: call EPSGetIterationNumber(eps,its,ierr)
193: if (rank .eq. 0) then
194: write(*,210) reason,its
195: endif
196: 210 format (' Finished - converged reason =',I2,', its=',I4)
198: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
199: ! Display solution and clean up
200: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
201: call EPSPrintSolution(eps,PETSC_NULL_OBJECT,ierr)
202: call EPSDestroy(eps,ierr)
203: call MatDestroy(A,ierr)
205: call SlepcFinalize(ierr)
206: end