Actual source code: ex6f.F
1: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2: ! SLEPc - Scalable Library for Eigenvalue Problem Computations
3: ! Copyright (c) 2002-2009, Universidad 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: ! Program usage: mpirun -np n ex6f [-help] [-m <m>] [all SLEPc options]
21: !
22: ! Description: This example solves the eigensystem arising in the Ising
23: ! model for ferromagnetic materials. The file mvmisg.f must be linked
24: ! together. Information about the model can be found at the following
25: ! site http://math.nist.gov/MatrixMarket/data/NEP
26: !
27: ! The command line options are:
28: ! -m <m>, where <m> is the number of 2x2 blocks, i.e. matrix size N=2*m
29: !
30: ! ----------------------------------------------------------------------
31: !
32: program main
33: implicit none
35: #include "finclude/petsc.h"
36: #include "finclude/petscvec.h"
37: #include "finclude/petscmat.h"
38: #include finclude/slepc.h
39: #include finclude/slepceps.h
41: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
42: ! Declarations
43: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
44: !
45: ! Variables:
46: ! A operator matrix
47: ! eps eigenproblem solver context
49: Mat A
50: EPS eps
51: EPSType tname
52: PetscReal tol, error
53: PetscScalar kr, ki
54: PetscInt N, m, i
55: PetscInt nev, maxit, its, nconv
56: PetscMPIInt sz, rank
57: PetscErrorCode ierr
58: PetscTruth flg
60: ! This is the routine to use for matrix-free approach
61: !
62: external MatIsing_Mult
64: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
65: ! Beginning of program
66: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
68: call SlepcInitialize(PETSC_NULL_CHARACTER,ierr)
69: #if defined(PETSC_USE_COMPLEX)
70: write(*,*) 'This example requires real numbers.'
71: goto 999
72: #endif
73: call MPI_Comm_size(PETSC_COMM_WORLD,sz,ierr)
74: call MPI_Comm_rank(PETSC_COMM_WORLD,rank,ierr)
75: if (sz .ne. 1) then
76: if (rank .eq. 0) then
77: write(*,*) 'This is a uniprocessor example only!'
78: endif
79: SETERRQ(1,' ',ierr)
80: endif
81: m = 30
82: call PetscOptionsGetInt(PETSC_NULL_CHARACTER,'-m',m,flg,ierr)
83: N = 2*m
85: if (rank .eq. 0) then
86: write(*,*)
87: write(*,'(A,I6,A)') 'Ising Model Eigenproblem, m=',m,', (N=2*m)'
88: write(*,*)
89: endif
91: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
92: ! Register the matrix-vector subroutine for the operator that defines
93: ! the eigensystem, Ax=kx
94: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
96: call MatCreateShell(PETSC_COMM_WORLD,N,N,N,N,PETSC_NULL_OBJECT,A,
97: & ierr)
98: call MatShellSetOperation(A,MATOP_MULT,MatIsing_Mult,ierr)
100: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
101: ! Create the eigensolver and display info
102: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
104: ! ** Create eigensolver context
105: call EPSCreate(PETSC_COMM_WORLD,eps,ierr)
107: ! ** Set operators. In this case, it is a standard eigenvalue problem
108: call EPSSetOperators(eps,A,PETSC_NULL_OBJECT,ierr)
109: call EPSSetProblemType(eps,EPS_NHEP,ierr)
111: ! ** Set solver parameters at runtime
112: call EPSSetFromOptions(eps,ierr)
114: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
115: ! Solve the eigensystem
116: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
118: call EPSSolve(eps,ierr)
119: call EPSGetIterationNumber(eps,its,ierr)
120: if (rank .eq. 0) then
121: write(*,'(A,I4)') ' Number of iterations of the method: ', its
122: endif
124: ! ** Optional: Get some information from the solver and display it
125: call EPSGetType(eps,tname,ierr)
126: if (rank .eq. 0) then
127: write(*,'(A,A)') ' Solution method: ', tname
128: endif
129: call EPSGetDimensions(eps,nev,PETSC_NULL_INTEGER,
130: + PETSC_NULL_INTEGER,ierr)
131: if (rank .eq. 0) then
132: write(*,'(A,I2)') ' Number of requested eigenvalues:', nev
133: endif
134: call EPSGetTolerances(eps,tol,maxit,ierr)
135: if (rank .eq. 0) then
136: write(*,'(A,1PE10.4,A,I6)') ' Stopping condition: tol=', tol,
137: & ', maxit=', maxit
138: endif
140: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
141: ! Display solution and clean up
142: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
144: ! ** Get number of converged eigenpairs
145: call EPSGetConverged(eps,nconv,ierr)
146: if (rank .eq. 0) then
147: write(*,'(A,I2)') ' Number of converged eigenpairs:', nconv
148: endif
150: ! ** Display eigenvalues and relative errors
151: if (nconv.gt.0 .and. rank.eq.0) then
152: write(*,*)
153: write(*,*) ' k ||Ax-kx||/||kx||'
154: write(*,*) ' ----------------- ------------------'
155: do i=0,nconv-1
156: ! ** Get converged eigenpairs: i-th eigenvalue is stored in kr
157: ! ** (real part) and ki (imaginary part)
158: call EPSGetEigenpair(eps,i,kr,ki,PETSC_NULL,PETSC_NULL,ierr)
160: ! ** Compute the relative error associated to each eigenpair
161: call EPSComputeRelativeError(eps,i,error,ierr)
163: if (ki.ne.0.D0) then
164: write(*,'(1P,E11.4,E11.4,A,E12.4)') kr, ki, ' j ', error
165: else
166: write(*,'(1P,A,E12.4,A,E12.4)') ' ', kr, ' ', error
167: endif
168: enddo
169: endif
170: write(*,*)
172: ! ** Free work space
173: call EPSDestroy(eps,ierr)
174: call MatDestroy(A,ierr)
176: #if defined(PETSC_USE_COMPLEX)
177: 999 continue
178: #endif
179: call SlepcFinalize(ierr)
180: end
182: ! -------------------------------------------------------------------
183: !
184: ! MatIsing_Mult - user provided matrix-vector multiply
185: !
186: ! Input Parameters:
187: ! A - matrix
188: ! x - input vector
189: !
190: ! Output Parameter:
191: ! y - output vector
192: !
193: subroutine MatIsing_Mult(A,x,y,ierr)
194: implicit none
196: #include "finclude/petsc.h"
198: Mat A
199: Vec x,y
200: integer trans,one,N
201: PetscScalar x_array(1),y_array(1)
202: PetscOffset i_x,i_y
203: PetscErrorCode ierr
205: ! The actual routine for the matrix-vector product
206: external mvmisg
208: call MatGetSize(A,N,PETSC_NULL_INTEGER,ierr)
209: call VecGetArray(x,x_array,i_x,ierr)
210: call VecGetArray(y,y_array,i_y,ierr)
212: trans = 0
213: one = 1
214: call mvmisg(trans,N,one,x_array(i_x+1),N,y_array(i_y+1),N)
216: call VecRestoreArray(x,x_array,i_x,ierr)
217: call VecRestoreArray(y,y_array,i_y,ierr)
219: return
220: end