Actual source code: test7f.F90
slepc-3.22.1 2024-10-28
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: PetscCallA(SlepcInitialize(PETSC_NULL_CHARACTER,ierr))
51: PetscCallMPIA(MPI_Comm_rank(PETSC_COMM_WORLD,rank,ierr))
52: n = 30
53: PetscCallA(PetscOptionsGetInt(PETSC_NULL_OPTIONS,PETSC_NULL_CHARACTER,'-n',n,flg,ierr))
55: if (rank .eq. 0) then
56: write(*,100) n
57: endif
58: 100 format (/'1-D Laplacian Eigenproblem, n =',I3,' (Fortran)')
60: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
61: ! Compute the operator matrix that defines the eigensystem, Ax=kx
62: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
64: PetscCallA(MatCreate(PETSC_COMM_WORLD,A,ierr))
65: PetscCallA(MatSetSizes(A,PETSC_DECIDE,PETSC_DECIDE,n,n,ierr))
66: PetscCallA(MatSetFromOptions(A,ierr))
68: i1 = 1
69: i2 = 2
70: i3 = 3
71: PetscCallA(MatGetOwnershipRange(A,Istart,Iend,ierr))
72: if (Istart .eq. 0) then
73: i = 0
74: col(1) = 0
75: col(2) = 1
76: value(1) = 2.0
77: value(2) = -1.0
78: PetscCallA(MatSetValues(A,i1,[i],i2,col,value,INSERT_VALUES,ierr))
79: Istart = Istart+1
80: endif
81: if (Iend .eq. n) then
82: i = n-1
83: col(1) = n-2
84: col(2) = n-1
85: value(1) = -1.0
86: value(2) = 2.0
87: PetscCallA(MatSetValues(A,i1,[i],i2,col,value,INSERT_VALUES,ierr))
88: Iend = Iend-1
89: endif
90: value(1) = -1.0
91: value(2) = 2.0
92: value(3) = -1.0
93: do i=Istart,Iend-1
94: col(1) = i-1
95: col(2) = i
96: col(3) = i+1
97: PetscCallA(MatSetValues(A,i1,[i],i3,col,value,INSERT_VALUES,ierr))
98: enddo
100: PetscCallA(MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY,ierr))
101: PetscCallA(MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY,ierr))
103: PetscCallA(MatCreateVecs(A,v(1),PETSC_NULL_VEC,ierr))
104: one = 1.0
105: if (Istart .eq. 0) then
106: PetscCallA(VecSetValue(v(1),0,one,INSERT_VALUES,ierr))
107: endif
108: PetscCallA(VecAssemblyBegin(v(1),ierr))
109: PetscCallA(VecAssemblyEnd(v(1),ierr))
111: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
112: ! Create the eigensolver and display info
113: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
115: ! ** Create eigensolver context
116: PetscCallA(EPSCreate(PETSC_COMM_WORLD,eps,ierr))
118: ! ** Set operators. In this case, it is a standard eigenvalue problem
119: PetscCallA(EPSSetOperators(eps,A,PETSC_NULL_MAT,ierr))
120: PetscCallA(EPSSetProblemType(eps,EPS_HEP,ierr))
122: ! ** Set solver parameters at runtime
123: PetscCallA(EPSSetFromOptions(eps,ierr))
125: ! ** Set initial vectors
126: nini = 1
127: PetscCallA(EPSSetInitialSpace(eps,nini,v,ierr))
129: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
130: ! Solve the eigensystem
131: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
133: PetscCallA(EPSSolve(eps,ierr))
135: ! ** Optional: Get some information from the solver and display it
136: PetscCallA(EPSGetType(eps,tname,ierr))
137: if (rank .eq. 0) then
138: write(*,120) tname
139: endif
140: 120 format (' Solution method: ',A)
141: PetscCallA(EPSGetDimensions(eps,nev,PETSC_NULL_INTEGER,PETSC_NULL_INTEGER,ierr))
142: if (rank .eq. 0) then
143: write(*,130) nev
144: endif
145: 130 format (' Number of requested eigenvalues:',I2)
147: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
148: ! Display solution and clean up
149: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
151: PetscCallA(EPSErrorView(eps,EPS_ERROR_RELATIVE,PETSC_NULL_VIEWER,ierr))
152: PetscCallA(EPSDestroy(eps,ierr))
153: PetscCallA(MatDestroy(A,ierr))
154: PetscCallA(VecDestroy(v(1),ierr))
156: PetscCallA(SlepcFinalize(ierr))
157: end
159: !/*TEST
160: !
161: ! test:
162: ! suffix: 1
163: ! args: -eps_nev 4 -eps_ncv 19
164: ! filter: sed -e "s/83791/83792/"
165: !
166: !TEST*/