Actual source code: ex15f.F
1: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2: ! SLEPc - Scalable Library for Eigenvalue Problem Computations
3: ! Copyright (c) 2002-2010, Universidad Politecnica de Valencia, Spain
4: !
5: ! This file is part of SLEPc.
6: !
7: ! SLEPc is free software: you can redistribute it and/or modify it under the
8: ! terms of version 3 of the GNU Lesser General Public License as published by
9: ! the Free Software Foundation.
10: !
11: ! SLEPc is distributed in the hope that it will be useful, but WITHOUT ANY
12: ! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
13: ! FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for
14: ! more details.
15: !
16: ! You should have received a copy of the GNU Lesser General Public License
17: ! along with SLEPc. If not, see <http://www.gnu.org/licenses/>.
18: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
19: !
20: ! Program usage: mpirun -np n ex15f [-help] [-n <n>] [-mu <mu>] [all SLEPc options]
21: !
22: ! Description: Singular value decomposition of the Lauchli matrix.
23: !
24: ! The command line options are:
25: ! -n <n>, where <n> = matrix dimension.
26: ! -mu <mu>, where <mu> = subdiagonal value.
27: !
28: ! ----------------------------------------------------------------------
29: !
30: program main
31: implicit none
33: #include "finclude/petscsys.h"
34: #include "finclude/petscvec.h"
35: #include "finclude/petscmat.h"
36: #include finclude/slepcsys.h
37: #include finclude/slepcsvd.h
39: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
40: ! Declarations
41: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
42: !
43: ! Variables:
44: ! A operator matrix
45: ! svd singular value solver context
47: Mat A
48: SVD svd
49: SVDType tname
50: PetscReal tol, error, sigma, mu
51: PetscInt n, i, j, Istart, Iend
52: PetscInt nsv, maxit, its, nconv
53: PetscMPIInt rank
54: PetscErrorCode ierr
55: PetscTruth flg
57: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
58: ! Beginning of program
59: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
61: call SlepcInitialize(PETSC_NULL_CHARACTER,ierr)
62: call MPI_Comm_rank(PETSC_COMM_WORLD,rank,ierr)
63: n = 100
64: call PetscOptionsGetInt(PETSC_NULL_CHARACTER,'-n',n,flg,ierr)
65: mu = PETSC_SQRT_MACHINE_EPSILON
66: call PetscOptionsGetReal(PETSC_NULL_CHARACTER,'-mu',mu,flg,ierr)
68: if (rank .eq. 0) then
69: write(*,100) n, mu
70: endif
71: 100 format (/'Lauchli SVD, n =',I3,', mu=',E12.4,' (Fortran)')
73: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
74: ! Build the Lauchli matrix
75: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
77: call MatCreate(PETSC_COMM_WORLD,A,ierr)
78: call MatSetSizes(A,PETSC_DECIDE,PETSC_DECIDE,n+1,n,ierr)
79: call MatSetFromOptions(A,ierr)
81: call MatGetOwnershipRange(A,Istart,Iend,ierr)
82: do i=Istart,Iend-1
83: if (i .eq. 0) then
84: do j=0,n-1
85: call MatSetValue(A,i,j,1.d0,INSERT_VALUES,ierr)
86: end do
87: else
88: call MatSetValue(A,i,i-1,mu,INSERT_VALUES,ierr)
89: end if
90: enddo
92: call MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY,ierr)
93: call MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY,ierr)
95: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
96: ! Create the singular value solver and display info
97: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
99: ! ** Create singular value solver context
100: call SVDCreate(PETSC_COMM_WORLD,svd,ierr)
102: ! ** Set operator
103: call SVDSetOperator(svd,A,ierr)
105: ! ** Use thick-restart Lanczos as default solver
106: call SVDSetType(svd,SVDTRLANCZOS,ierr)
108: ! ** Set solver parameters at runtime
109: call SVDSetFromOptions(svd,ierr)
111: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
112: ! Solve the singular value system
113: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
115: call SVDSolve(svd,ierr)
116: call SVDGetIterationNumber(svd,its,ierr)
117: if (rank .eq. 0) then
118: write(*,110) its
119: endif
120: 110 format (/' Number of iterations of the method:',I4)
121:
122: ! ** Optional: Get some information from the solver and display it
123: call SVDGetType(svd,tname,ierr)
124: if (rank .eq. 0) then
125: write(*,120) tname
126: endif
127: 120 format (' Solution method: ',A)
128: call SVDGetDimensions(svd,nsv,PETSC_NULL_INTEGER, &
129: & PETSC_NULL_INTEGER,ierr)
130: if (rank .eq. 0) then
131: write(*,130) nsv
132: endif
133: 130 format (' Number of requested singular values:',I2)
134: call SVDGetTolerances(svd,tol,maxit,ierr)
135: if (rank .eq. 0) then
136: write(*,140) tol, maxit
137: endif
138: 140 format (' Stopping condition: tol=',1P,E10.4,', maxit=',I4)
140: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
141: ! Display solution and clean up
142: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
144: ! ** Get number of converged singular triplets
145: call SVDGetConverged(svd,nconv,ierr)
146: if (rank .eq. 0) then
147: write(*,150) nconv
148: endif
149: 150 format (' Number of converged approximate singular triplets:',I2/)
151: ! ** Display singular values and relative errors
152: if (nconv.gt.0) then
153: if (rank .eq. 0) then
154: write(*,*) ' sigma residual norm'
155: write(*,*) ' ----------------- ------------------'
156: endif
157: do i=0,nconv-1
158: ! ** Get converged singular triplet: i-th singular value is stored in sigma
159: call SVDGetSingularTriplet(svd,i,sigma,PETSC_NULL_OBJECT, &
160: & PETSC_NULL_OBJECT,ierr)
162: ! ** Compute the relative error associated to each eigenpair
163: call SVDComputeRelativeError(svd,i,error,ierr)
164: if (rank .eq. 0) then
165: write(*,160) sigma, error
166: endif
167: 160 format (1P,' ',E12.4,' ',E12.4)
169: enddo
170: if (rank .eq. 0) then
171: write(*,*)
172: endif
173: endif
175: ! ** Free work space
176: call SVDDestroy(svd,ierr)
177: call MatDestroy(A,ierr)
179: call SlepcFinalize(ierr)
180: end