Actual source code: ex6f.F
1: !
2: ! Program usage: mpirun -np n ex6f [-help] [-m <m>] [all SLEPc options]
3: !
4: ! Description: This example solves the eigensystem arising in the Ising
5: ! model for ferromagnetic materials. The file mvmisg.f must be linked
6: ! together. Information about the model can be found at the following
7: ! site http://math.nist.gov/MatrixMarket/data/NEP
8: !
9: ! The command line options are:
10: ! -m <m>, where <m> is the number of 2x2 blocks, i.e. matrix size N=2*m
11: !
12: !/*T
13: ! Concepts: SLEPc - Basic functionality
14: ! Routines: SlepcInitialize(); SlepcFinalize();
15: ! Routines: EPSCreate(); EPSSetFromOptions();
16: ! Routines: EPSSolve(); EPSDestroy();
17: !T*/
18: !
19: ! ----------------------------------------------------------------------
20: !
21: program main
22: implicit none
24: #include "finclude/petsc.h"
25: #include "finclude/petscvec.h"
26: #include "finclude/petscmat.h"
27: #include finclude/slepc.h
28: #include finclude/slepceps.h
30: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
31: ! Declarations
32: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
33: !
34: ! Variables:
35: ! A operator matrix
36: ! eps eigenproblem solver context
38: Mat A
39: EPS eps
40: EPSType type
41: PetscReal tol, error
42: PetscScalar kr, ki
43: integer size, rank, N, m, nev, ierr, maxit, i, its, nconv
44: PetscTruth flg
46: ! This is the routine to use for matrix-free approach
47: !
48: external MatIsing_Mult
50: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
51: ! Beginning of program
52: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
54: call SlepcInitialize(PETSC_NULL_CHARACTER,ierr)
55: #if defined(PETSC_USE_COMPLEX)
56: write(*,*) 'This example requires real numbers.'
57: goto 999
58: #endif
59: call MPI_Comm_size(PETSC_COMM_WORLD,size,ierr)
60: call MPI_Comm_rank(PETSC_COMM_WORLD,rank,ierr)
61: if (size .ne. 1) then
62: if (rank .eq. 0) then
63: write(*,*) 'This is a uniprocessor example only!'
64: endif
65: SETERRQ(1,' ',ierr)
66: endif
67: m = 30
68: call PetscOptionsGetInt(PETSC_NULL_CHARACTER,'-m',m,flg,ierr)
69: N = 2*m
71: if (rank .eq. 0) then
72: write(*,*)
73: write(*,'(A,I6,A)') 'Ising Model Eigenproblem, m=',m,', (N=2*m)'
74: write(*,*)
75: endif
77: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
78: ! Register the matrix-vector subroutine for the operator that defines
79: ! the eigensystem, Ax=kx
80: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
82: call MatCreateShell(PETSC_COMM_WORLD,N,N,N,N,PETSC_NULL_OBJECT,A,
83: & ierr)
84: call MatShellSetOperation(A,MATOP_MULT,MatIsing_Mult,ierr)
86: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
87: ! Create the eigensolver and display info
88: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
90: ! ** Create eigensolver context
91: call EPSCreate(PETSC_COMM_WORLD,eps,ierr)
93: ! ** Set operators. In this case, it is a standard eigenvalue problem
94: call EPSSetOperators(eps,A,PETSC_NULL_OBJECT,ierr)
96: ! ** Set solver parameters at runtime
97: call EPSSetFromOptions(eps,ierr)
99: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
100: ! Solve the eigensystem
101: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
103: call EPSSolve(eps,ierr)
104: call EPSGetIterationNumber(eps,its,ierr)
105: if (rank .eq. 0) then
106: write(*,'(A,I4)') ' Number of iterations of the method: ', its
107: endif
109: ! ** Optional: Get some information from the solver and display it
110: call EPSGetType(eps,type,ierr)
111: if (rank .eq. 0) then
112: write(*,'(A,A)') ' Solution method: ', type
113: endif
114: call EPSGetDimensions(eps,nev,PETSC_NULL_INTEGER,ierr)
115: if (rank .eq. 0) then
116: write(*,'(A,I2)') ' Number of requested eigenvalues:', nev
117: endif
118: call EPSGetTolerances(eps,tol,maxit,ierr)
119: if (rank .eq. 0) then
120: write(*,'(A,1PE10.4,A,I6)') ' Stopping condition: tol=', tol,
121: & ', maxit=', maxit
122: endif
124: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
125: ! Display solution and clean up
126: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
128: ! ** Get number of converged eigenpairs
129: call EPSGetConverged(eps,nconv,ierr)
130: if (rank .eq. 0) then
131: write(*,'(A,I2)') ' Number of converged eigenpairs:', nconv
132: endif
134: ! ** Display eigenvalues and relative errors
135: if (nconv.gt.0 .and. rank.eq.0) then
136: write(*,*)
137: write(*,*) ' k ||Ax-kx||/||kx||'
138: write(*,*) ' ----------------- ------------------'
139: do i=0,nconv-1
140: ! ** Get converged eigenpairs: i-th eigenvalue is stored in kr
141: ! ** (real part) and ki (imaginary part)
142: call EPSGetEigenpair(eps,i,kr,ki,PETSC_NULL,PETSC_NULL,ierr)
144: ! ** Compute the relative error associated to each eigenpair
145: call EPSComputeRelativeError(eps,i,error,ierr)
147: if (ki.ne.0.D0) then
148: write(*,'(1P,E11.4,E11.4,A,E12.4)') kr, ki, ' j ', error
149: else
150: write(*,'(1P,A,E12.4,A,E12.4)') ' ', kr, ' ', error
151: endif
152: enddo
153: write(*,*)
154: endif
156: ! ** Free work space
157: call EPSDestroy(eps,ierr)
158: call MatDestroy(A,ierr)
160: 999 continue
161: call SlepcFinalize(ierr)
162: end
164: ! -------------------------------------------------------------------
165: !
166: ! MatIsing_Mult - user provided matrix-vector multiply
167: !
168: ! Input Parameters:
169: ! A - matrix
170: ! x - input vector
171: !
172: ! Output Parameter:
173: ! y - output vector
174: !
175: subroutine MatIsing_Mult(A,x,y,ierr)
176: implicit none
178: #include "finclude/petsc.h"
180: Mat A
181: Vec x,y
182: integer trans,one,ierr,i,N
183: PetscScalar x_array(1),y_array(1)
184: PetscOffset i_x,i_y
186: ! The actual routine for the matrix-vector product
187: external mvmisg
189: call MatGetSize(A,N,PETSC_NULL_INTEGER,ierr)
190: call VecGetArray(x,x_array,i_x,ierr)
191: call VecGetArray(y,y_array,i_y,ierr)
193: trans = 0
194: one = 1
195: call mvmisg(trans,N,one,x_array(i_x+1),N,y_array(i_y+1),N)
197: call VecRestoreArray(x,x_array,i_x,ierr)
198: call VecRestoreArray(y,y_array,i_y,ierr)
200: return
201: end