Actual source code: test7f.F
slepc-3.20.2 2024-03-15
1: !
2: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
3: ! SLEPc - Scalable Library for Eigenvalue Problem Computations
4: ! Copyright (c) 2002-, 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> ./test7f [-help] [-n <n>] [all SLEPc options]
11: !
12: ! Description: Simple example that solves an eigensystem with the EPS object.
13: ! Same problem as ex1f but with simplified output.
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: #include <slepc/finclude/slepceps.h>
22: use slepceps
23: implicit none
25: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
26: ! Declarations
27: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
28: !
29: ! Variables:
30: ! A operator matrix
31: ! eps eigenproblem solver context
33: Mat A
34: EPS eps
35: EPSType tname
36: PetscInt n, i, Istart, Iend
37: PetscInt nev, nini
38: PetscInt col(3)
39: PetscInt i1,i2,i3
40: PetscMPIInt rank
41: PetscErrorCode ierr
42: PetscBool flg
43: PetscScalar value(3), one
44: Vec v(1)
46: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
47: ! Beginning of program
48: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
50: call SlepcInitialize(PETSC_NULL_CHARACTER,ierr)
51: call MPI_Comm_rank(PETSC_COMM_WORLD,rank,ierr)
52: n = 30
53: call PetscOptionsGetInt(PETSC_NULL_OPTIONS,PETSC_NULL_CHARACTER, &
54: & '-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)
68: call MatSetUp(A,ierr)
70: i1 = 1
71: i2 = 2
72: i3 = 3
73: call MatGetOwnershipRange(A,Istart,Iend,ierr)
74: if (Istart .eq. 0) then
75: i = 0
76: col(1) = 0
77: col(2) = 1
78: value(1) = 2.0
79: value(2) = -1.0
80: call MatSetValues(A,i1,i,i2,col,value,INSERT_VALUES,ierr)
81: Istart = Istart+1
82: endif
83: if (Iend .eq. n) then
84: i = n-1
85: col(1) = n-2
86: col(2) = n-1
87: value(1) = -1.0
88: value(2) = 2.0
89: call MatSetValues(A,i1,i,i2,col,value,INSERT_VALUES,ierr)
90: Iend = Iend-1
91: endif
92: value(1) = -1.0
93: value(2) = 2.0
94: value(3) = -1.0
95: do i=Istart,Iend-1
96: col(1) = i-1
97: col(2) = i
98: col(3) = i+1
99: call MatSetValues(A,i1,i,i3,col,value,INSERT_VALUES,ierr)
100: enddo
102: call MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY,ierr)
103: call MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY,ierr)
105: call MatCreateVecs(A,v(1),PETSC_NULL_VEC,ierr)
106: one = 1.0
107: if (Istart .eq. 0) then
108: call VecSetValue(v(1),0,one,INSERT_VALUES,ierr)
109: endif
110: call VecAssemblyBegin(v(1),ierr)
111: call VecAssemblyEnd(v(1),ierr)
113: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
114: ! Create the eigensolver and display info
115: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
117: ! ** Create eigensolver context
118: call EPSCreate(PETSC_COMM_WORLD,eps,ierr)
120: ! ** Set operators. In this case, it is a standard eigenvalue problem
121: call EPSSetOperators(eps,A,PETSC_NULL_MAT,ierr)
122: call EPSSetProblemType(eps,EPS_HEP,ierr)
124: ! ** Set solver parameters at runtime
125: call EPSSetFromOptions(eps,ierr)
127: ! ** Set initial vectors
128: nini = 1
129: call EPSSetInitialSpace(eps,nini,v,ierr)
131: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
132: ! Solve the eigensystem
133: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
135: call EPSSolve(eps,ierr)
137: ! ** Optional: Get some information from the solver and display it
138: call EPSGetType(eps,tname,ierr)
139: if (rank .eq. 0) then
140: write(*,120) tname
141: endif
142: 120 format (' Solution method: ',A)
143: call EPSGetDimensions(eps,nev,PETSC_NULL_INTEGER, &
144: & PETSC_NULL_INTEGER,ierr)
145: if (rank .eq. 0) then
146: write(*,130) nev
147: endif
148: 130 format (' Number of requested eigenvalues:',I2)
150: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
151: ! Display solution and clean up
152: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
154: call EPSErrorView(eps,EPS_ERROR_RELATIVE,PETSC_NULL_VIEWER,ierr)
155: call EPSDestroy(eps,ierr)
156: call MatDestroy(A,ierr)
157: call VecDestroy(v(1),ierr)
159: call SlepcFinalize(ierr)
160: end
162: !/*TEST
163: !
164: ! test:
165: ! suffix: 1
166: ! args: -eps_nev 4 -eps_ncv 19
167: ! filter: sed -e "s/83791/83792/"
168: !
169: !TEST*/