Actual source code: ex1f.F90
slepc-3.21.1 2024-04-26
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> ./ex1f [-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 val(3)
45: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
46: ! Beginning of program
47: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
49: one = 1
50: two = 2
51: three = 3
52: PetscCallA(SlepcInitialize(PETSC_NULL_CHARACTER,"ex1f test"//c_new_line,ierr))
53: if (ierr .ne. 0) then
54: print*,'SlepcInitialize failed'
55: stop
56: endif
57: PetscCallMPIA(MPI_Comm_rank(PETSC_COMM_WORLD,rank,ierr))
58: n = 30
59: PetscCallA(PetscOptionsGetInt(PETSC_NULL_OPTIONS,PETSC_NULL_CHARACTER,'-n',n,flg,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: PetscCallA(MatCreate(PETSC_COMM_WORLD,A,ierr))
71: PetscCallA(MatSetSizes(A,PETSC_DECIDE,PETSC_DECIDE,n,n,ierr))
72: PetscCallA(MatSetFromOptions(A,ierr))
74: PetscCallA(MatGetOwnershipRange(A,Istart,Iend,ierr))
75: if (Istart .eq. 0) then
76: row(1) = 0
77: col(1) = 0
78: col(2) = 1
79: val(1) = 2.0
80: val(2) = -1.0
81: PetscCallA(MatSetValues(A,one,row,two,col,val,INSERT_VALUES,ierr))
82: Istart = Istart+1
83: endif
84: if (Iend .eq. n) then
85: row(1) = n-1
86: col(1) = n-2
87: col(2) = n-1
88: val(1) = -1.0
89: val(2) = 2.0
90: PetscCallA(MatSetValues(A,one,row,two,col,val,INSERT_VALUES,ierr))
91: Iend = Iend-1
92: endif
93: val(1) = -1.0
94: val(2) = 2.0
95: val(3) = -1.0
96: do i=Istart,Iend-1
97: row(1) = i
98: col(1) = i-1
99: col(2) = i
100: col(3) = i+1
101: PetscCallA(MatSetValues(A,one,row,three,col,val,INSERT_VALUES,ierr))
102: enddo
104: PetscCallA(MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY,ierr))
105: PetscCallA(MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY,ierr))
107: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
108: ! Create the eigensolver and display info
109: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
111: ! ** Create eigensolver context
112: PetscCallA(EPSCreate(PETSC_COMM_WORLD,eps,ierr))
114: ! ** Set operators. In this case, it is a standard eigenvalue problem
115: PetscCallA(EPSSetOperators(eps,A,PETSC_NULL_MAT,ierr))
116: PetscCallA(EPSSetProblemType(eps,EPS_HEP,ierr))
118: ! ** Set solver parameters at runtime
119: PetscCallA(EPSSetFromOptions(eps,ierr))
121: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
122: ! Solve the eigensystem
123: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
125: PetscCallA(EPSSolve(eps,ierr))
127: ! ** Optional: Get some information from the solver and display it
128: PetscCallA(EPSGetType(eps,tname,ierr))
129: if (rank .eq. 0) then
130: write(*,120) tname
131: endif
132: 120 format (' Solution method: ',A)
133: PetscCallA(EPSGetDimensions(eps,nev,PETSC_NULL_INTEGER,PETSC_NULL_INTEGER,ierr))
134: if (rank .eq. 0) then
135: write(*,130) nev
136: endif
137: 130 format (' Number of requested eigenvalues:',I4)
139: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
140: ! Display solution and clean up
141: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
143: ! ** show detailed info unless -terse option is given by user
144: PetscCallA(PetscOptionsHasName(PETSC_NULL_OPTIONS,PETSC_NULL_CHARACTER,'-terse',terse,ierr))
145: if (terse) then
146: PetscCallA(EPSErrorView(eps,EPS_ERROR_RELATIVE,PETSC_NULL_VIEWER,ierr))
147: else
148: PetscCallA(PetscViewerPushFormat(PETSC_VIEWER_STDOUT_WORLD,PETSC_VIEWER_ASCII_INFO_DETAIL,ierr))
149: PetscCallA(EPSConvergedReasonView(eps,PETSC_VIEWER_STDOUT_WORLD,ierr))
150: PetscCallA(EPSErrorView(eps,EPS_ERROR_RELATIVE,PETSC_VIEWER_STDOUT_WORLD,ierr))
151: PetscCallA(PetscViewerPopFormat(PETSC_VIEWER_STDOUT_WORLD,ierr))
152: endif
153: PetscCallA(EPSDestroy(eps,ierr))
154: PetscCallA(MatDestroy(A,ierr))
156: PetscCallA(SlepcFinalize(ierr))
157: end
159: !/*TEST
160: !
161: ! build:
162: ! requires: defined(PETSC_USING_F2003) defined(PETSC_USING_F90FREEFORM)
163: !
164: ! test:
165: ! args: -eps_nev 4 -terse
166: ! filter: sed -e "s/3.83791/3.83792/"
167: !
168: !TEST*/