Actual source code: ex1f90.F90
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> ./ex1f90 [-help] [-n <n>] [all SLEPc options]
11: !
12: ! Description: Simple example that solves an eigensystem with the EPS object.
13: ! The standard symmetric eigenvalue problem to be solved corresponds to the
14: ! Laplacian operator in 1 dimension.
15: !
16: ! The command line options are:
17: ! -n <n>, where <n> = number of grid points = matrix size
18: !
19: ! ----------------------------------------------------------------------
20: !
21: program main
22: #include <slepc/finclude/slepceps.h>
23: use slepceps
24: implicit none
26: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
27: ! Declarations
28: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
29: !
30: ! Variables:
31: ! A operator matrix
32: ! eps eigenproblem solver context
34: Mat A
35: EPS eps
36: EPSType tname
37: PetscInt n, i, Istart, Iend, one, two, three
38: PetscInt nev
39: PetscInt row(1), col(3)
40: PetscMPIInt rank
41: PetscErrorCode ierr
42: PetscBool flg, terse
43: PetscScalar value(3)
45: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
46: ! Beginning of program
47: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
49: one = 1
50: two = 2
51: three = 3
52: call SlepcInitialize(PETSC_NULL_CHARACTER,ierr)
53: if (ierr .ne. 0) then
54: print*,'SlepcInitialize failed'
55: stop
56: endif
57: call MPI_Comm_rank(PETSC_COMM_WORLD,rank,ierr);CHKERRA(ierr)
58: n = 30
59: call PetscOptionsGetInt(PETSC_NULL_OPTIONS,PETSC_NULL_CHARACTER,'-n',n,flg,ierr);CHKERRA(ierr)
61: if (rank .eq. 0) then
62: write(*,100) n
63: endif
64: 100 format (/'1-D Laplacian Eigenproblem, n =',I4,' (Fortran)')
66: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
67: ! Compute the operator matrix that defines the eigensystem, Ax=kx
68: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
70: call MatCreate(PETSC_COMM_WORLD,A,ierr);CHKERRA(ierr)
71: call MatSetSizes(A,PETSC_DECIDE,PETSC_DECIDE,n,n,ierr);CHKERRA(ierr)
72: call MatSetFromOptions(A,ierr);CHKERRA(ierr)
73: call MatSetUp(A,ierr);CHKERRA(ierr)
75: call MatGetOwnershipRange(A,Istart,Iend,ierr);CHKERRA(ierr)
76: if (Istart .eq. 0) then
77: row(1) = 0
78: col(1) = 0
79: col(2) = 1
80: value(1) = 2.0
81: value(2) = -1.0
82: call MatSetValues(A,one,row,two,col,value,INSERT_VALUES,ierr);CHKERRA(ierr)
83: Istart = Istart+1
84: endif
85: if (Iend .eq. n) then
86: row(1) = n-1
87: col(1) = n-2
88: col(2) = n-1
89: value(1) = -1.0
90: value(2) = 2.0
91: call MatSetValues(A,one,row,two,col,value,INSERT_VALUES,ierr);CHKERRA(ierr)
92: Iend = Iend-1
93: endif
94: value(1) = -1.0
95: value(2) = 2.0
96: value(3) = -1.0
97: do i=Istart,Iend-1
98: row(1) = i
99: col(1) = i-1
100: col(2) = i
101: col(3) = i+1
102: call MatSetValues(A,one,row,three,col,value,INSERT_VALUES,ierr);CHKERRA(ierr)
103: enddo
105: call MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRA(ierr)
106: call MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRA(ierr)
108: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
109: ! Create the eigensolver and display info
110: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
112: ! ** Create eigensolver context
113: call EPSCreate(PETSC_COMM_WORLD,eps,ierr);CHKERRA(ierr)
115: ! ** Set operators. In this case, it is a standard eigenvalue problem
116: call EPSSetOperators(eps,A,PETSC_NULL_MAT,ierr);CHKERRA(ierr)
117: call EPSSetProblemType(eps,EPS_HEP,ierr);CHKERRA(ierr)
119: ! ** Set solver parameters at runtime
120: call EPSSetFromOptions(eps,ierr);CHKERRA(ierr)
122: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
123: ! Solve the eigensystem
124: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
126: call EPSSolve(eps,ierr);CHKERRA(ierr)
128: ! ** Optional: Get some information from the solver and display it
129: call EPSGetType(eps,tname,ierr);CHKERRA(ierr)
130: if (rank .eq. 0) then
131: write(*,120) tname
132: endif
133: 120 format (' Solution method: ',A)
134: call EPSGetDimensions(eps,nev,PETSC_NULL_INTEGER,PETSC_NULL_INTEGER,ierr);CHKERRA(ierr)
135: if (rank .eq. 0) then
136: write(*,130) nev
137: endif
138: 130 format (' Number of requested eigenvalues:',I4)
140: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
141: ! Display solution and clean up
142: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
144: ! ** show detailed info unless -terse option is given by user
145: call PetscOptionsHasName(PETSC_NULL_OPTIONS,PETSC_NULL_CHARACTER,'-terse',terse,ierr);CHKERRA(ierr)
146: if (terse) then
147: call EPSErrorView(eps,EPS_ERROR_RELATIVE,PETSC_NULL_VIEWER,ierr);CHKERRA(ierr)
148: else
149: call PetscViewerPushFormat(PETSC_VIEWER_STDOUT_WORLD,PETSC_VIEWER_ASCII_INFO_DETAIL,ierr);CHKERRA(ierr)
150: call EPSReasonView(eps,PETSC_VIEWER_STDOUT_WORLD,ierr);CHKERRA(ierr)
151: call EPSErrorView(eps,EPS_ERROR_RELATIVE,PETSC_VIEWER_STDOUT_WORLD,ierr);CHKERRA(ierr)
152: call PetscViewerPopFormat(PETSC_VIEWER_STDOUT_WORLD,ierr);CHKERRA(ierr)
153: endif
154: call EPSDestroy(eps,ierr);CHKERRA(ierr)
155: call MatDestroy(A,ierr);CHKERRA(ierr)
157: call SlepcFinalize(ierr)
158: end
160: !/*TEST
161: !
162: ! test:
163: ! suffix: 1
164: ! args: -eps_nev 4 -terse
165: !
166: !TEST*/