Actual source code: ex1f.F

  1: !  - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  2: !     SLEPc - Scalable Library for Eigenvalue Problem Computations
  3: !     Copyright (c) 2002-2007, Universidad Politecnica de Valencia, Spain
  4: !
  5: !     This file is part of SLEPc. See the README file for conditions of use
  6: !     and additional information.
  7: !  - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  8: !
  9: !  Program usage: mpirun -np n ex1f [-help] [-n <n>] [all SLEPc options]
 10: !
 11: !  Description: Simple example that solves an eigensystem with the EPS object.
 12: !  The standard symmetric eigenvalue problem to be solved corresponds to the
 13: !  Laplacian operator in 1 dimension.
 14: !
 15: !  The command line options are:
 16: !    -n <n>, where <n> = number of grid points = matrix size
 17: !
 18: ! ----------------------------------------------------------------------
 19: !
 20:       program main
 21:       implicit none

 23: #include "finclude/petsc.h"
 24: #include "finclude/petscvec.h"
 25: #include "finclude/petscmat.h"
 26:  #include finclude/slepc.h
 27:  #include finclude/slepceps.h

 29: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 30: !     Declarations
 31: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 32: !
 33: !  Variables:
 34: !     A     operator matrix
 35: !     eps   eigenproblem solver context

 37:       Mat          A
 38:       EPS          eps
 39:       EPSType      type
 40:       PetscReal    tol, error
 41:       PetscScalar  kr, ki
 42:       integer      rank, n, nev, ierr, maxit, i, its, nconv
 43:       integer      col(3), Istart, Iend
 44:       PetscTruth   flg
 45:       PetscScalar  value(3)

 47: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 48: !     Beginning of program
 49: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

 51:       call SlepcInitialize(PETSC_NULL_CHARACTER,ierr)
 52:       call MPI_Comm_rank(PETSC_COMM_WORLD,rank,ierr)
 53:       n = 30
 54:       call PetscOptionsGetInt(PETSC_NULL_CHARACTER,'-n',n,flg,ierr)

 56:       if (rank .eq. 0) then
 57:         write(*,100) n
 58:       endif
 59:  100  format (/'1-D Laplacian Eigenproblem, n =',I3,' (Fortran)')

 61: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 62: !     Compute the operator matrix that defines the eigensystem, Ax=kx
 63: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

 65:       call MatCreate(PETSC_COMM_WORLD,A,ierr)
 66:       call MatSetSizes(A,PETSC_DECIDE,PETSC_DECIDE,n,n,ierr)
 67:       call MatSetFromOptions(A,ierr)

 69:       call MatGetOwnershipRange(A,Istart,Iend,ierr)
 70:       if (Istart .eq. 0) then
 71:         i = 0
 72:         col(1) = 0
 73:         col(2) = 1
 74:         value(1) =  2.0
 75:         value(2) = -1.0
 76:         call MatSetValues(A,1,i,2,col,value,INSERT_VALUES,ierr)
 77:         Istart = Istart+1
 78:       endif
 79:       if (Iend .eq. n) then
 80:         i = n-1
 81:         col(1) = n-2
 82:         col(2) = n-1
 83:         value(1) = -1.0
 84:         value(2) =  2.0
 85:         call MatSetValues(A,1,i,2,col,value,INSERT_VALUES,ierr)
 86:         Iend = Iend-1
 87:       endif
 88:       value(1) = -1.0
 89:       value(2) =  2.0
 90:       value(3) = -1.0
 91:       do i=Istart,Iend-1
 92:         col(1) = i-1
 93:         col(2) = i
 94:         col(3) = i+1
 95:         call MatSetValues(A,1,i,3,col,value,INSERT_VALUES,ierr)
 96:       enddo

 98:       call MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY,ierr)
 99:       call MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY,ierr)

101: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
102: !     Create the eigensolver and display info
103: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

105: !     ** Create eigensolver context
106:       call EPSCreate(PETSC_COMM_WORLD,eps,ierr)

108: !     ** Set operators. In this case, it is a standard eigenvalue problem
109:       call EPSSetOperators(eps,A,PETSC_NULL_OBJECT,ierr)
110:       call EPSSetProblemType(eps,EPS_HEP,ierr)

112: !     ** Set solver parameters at runtime
113:       call EPSSetFromOptions(eps,ierr)

115: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
116: !     Solve the eigensystem
117: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

119:       call EPSSolve(eps,ierr)
120:       call EPSGetIterationNumber(eps,its,ierr)
121:       if (rank .eq. 0) then
122:         write(*,110) its
123:       endif
124:  110  format (/' Number of iterations of the method:',I4)
125: 
126: !     ** Optional: Get some information from the solver and display it
127:       call EPSGetType(eps,type,ierr)
128:       if (rank .eq. 0) then
129:         write(*,120) type
130:       endif
131:  120  format (' Solution method: ',A)
132:       call EPSGetDimensions(eps,nev,PETSC_NULL_INTEGER,ierr)
133:       if (rank .eq. 0) then
134:         write(*,130) nev
135:       endif
136:  130  format (' Number of requested eigenvalues:',I2)
137:       call EPSGetTolerances(eps,tol,maxit,ierr)
138:       if (rank .eq. 0) then
139:         write(*,140) tol, maxit
140:       endif
141:  140  format (' Stopping condition: tol=',1P,E10.4,', maxit=',I4)

143: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
144: !     Display solution and clean up
145: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

147: !     ** Get number of converged eigenpairs
148:       call EPSGetConverged(eps,nconv,ierr)
149:       if (rank .eq. 0) then
150:         write(*,150) nconv
151:       endif
152:  150  format (' Number of converged eigenpairs:',I2/)

154: !     ** Display eigenvalues and relative errors
155:       if (nconv.gt.0) then
156:         if (rank .eq. 0) then
157:           write(*,*) '         k          ||Ax-kx||/||kx||'
158:           write(*,*) ' ----------------- ------------------'
159:         endif
160:         do i=0,nconv-1
161: !         ** Get converged eigenpairs: i-th eigenvalue is stored in kr
162: !         ** (real part) and ki (imaginary part)
163:           call EPSGetEigenpair(eps,i,kr,ki,PETSC_NULL,PETSC_NULL,ierr)

165: !         ** Compute the relative error associated to each eigenpair
166:           call EPSComputeRelativeError(eps,i,error,ierr)
167:           if (rank .eq. 0) then
168:             write(*,160) PetscRealPart(kr), error
169:           endif
170:  160      format (1P,'   ',E12.4,'       ',E12.4)

172:         enddo
173:         if (rank .eq. 0) then
174:           write(*,*)
175:         endif
176:       endif

178: !     ** Free work space
179:       call EPSDestroy(eps,ierr)
180:       call MatDestroy(A,ierr)

182:       call SlepcFinalize(ierr)
183:       end