Actual source code: ex15f.F
slepc-3.9.1 2018-05-02
1: !
2: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
3: ! SLEPc - Scalable Library for Eigenvalue Problem Computations
4: ! Copyright (c) 2002-2018, 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> ./ex15f [-help] [-n <n>] [-mu <mu>] [all SLEPc options]
11: !
12: ! Description: Singular value decomposition of the Lauchli matrix.
13: !
14: ! The command line options are:
15: ! -n <n>, where <n> = matrix dimension.
16: ! -mu <mu>, where <mu> = subdiagonal value.
17: !
18: ! ----------------------------------------------------------------------
19: !
20: program main
21: #include <slepc/finclude/slepcsvd.h>
22: use slepcsvd
23: implicit none
25: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
26: ! Declarations
27: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
28: !
29: ! Variables:
30: ! A operator matrix
31: ! svd singular value solver context
33: Mat A
34: SVD svd
35: SVDType tname
36: PetscReal tol, error, sigma, mu
37: PetscInt n, i, j, Istart, Iend
38: PetscInt nsv, maxit, its, nconv
39: PetscMPIInt rank
40: PetscErrorCode ierr
41: PetscBool flg
42: PetscScalar one
44: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
45: ! Beginning of program
46: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
48: call SlepcInitialize(PETSC_NULL_CHARACTER,ierr)
49: call MPI_Comm_rank(PETSC_COMM_WORLD,rank,ierr)
50: n = 100
51: call PetscOptionsGetInt(PETSC_NULL_OPTIONS,PETSC_NULL_CHARACTER, &
52: & '-n',n,flg,ierr)
53: mu = PETSC_SQRT_MACHINE_EPSILON
54: call PetscOptionsGetReal(PETSC_NULL_OPTIONS,PETSC_NULL_CHARACTER, &
55: & '-mu',mu,flg,ierr)
57: if (rank .eq. 0) then
58: write(*,100) n, mu
59: endif
60: 100 format (/'Lauchli SVD, n =',I3,', mu=',E12.4,' (Fortran)')
62: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
63: ! Build the Lauchli matrix
64: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
66: call MatCreate(PETSC_COMM_WORLD,A,ierr)
67: call MatSetSizes(A,PETSC_DECIDE,PETSC_DECIDE,n+1,n,ierr)
68: call MatSetFromOptions(A,ierr)
69: call MatSetUp(A,ierr)
71: call MatGetOwnershipRange(A,Istart,Iend,ierr)
72: one = 1.0
73: do i=Istart,Iend-1
74: if (i .eq. 0) then
75: do j=0,n-1
76: call MatSetValue(A,i,j,one,INSERT_VALUES,ierr)
77: end do
78: else
79: call MatSetValue(A,i,i-1,mu,INSERT_VALUES,ierr)
80: end if
81: enddo
83: call MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY,ierr)
84: call MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY,ierr)
86: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
87: ! Create the singular value solver and display info
88: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
90: ! ** Create singular value solver context
91: call SVDCreate(PETSC_COMM_WORLD,svd,ierr)
93: ! ** Set operator
94: call SVDSetOperator(svd,A,ierr)
96: ! ** Use thick-restart Lanczos as default solver
97: call SVDSetType(svd,SVDTRLANCZOS,ierr)
99: ! ** Set solver parameters at runtime
100: call SVDSetFromOptions(svd,ierr)
102: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
103: ! Solve the singular value system
104: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
106: call SVDSolve(svd,ierr)
107: call SVDGetIterationNumber(svd,its,ierr)
108: if (rank .eq. 0) then
109: write(*,110) its
110: endif
111: 110 format (/' Number of iterations of the method:',I4)
113: ! ** Optional: Get some information from the solver and display it
114: call SVDGetType(svd,tname,ierr)
115: if (rank .eq. 0) then
116: write(*,120) tname
117: endif
118: 120 format (' Solution method: ',A)
119: call SVDGetDimensions(svd,nsv,PETSC_NULL_INTEGER, &
120: & PETSC_NULL_INTEGER,ierr)
121: if (rank .eq. 0) then
122: write(*,130) nsv
123: endif
124: 130 format (' Number of requested singular values:',I2)
125: call SVDGetTolerances(svd,tol,maxit,ierr)
126: if (rank .eq. 0) then
127: write(*,140) tol, maxit
128: endif
129: 140 format (' Stopping condition: tol=',1P,E10.4,', maxit=',I4)
131: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
132: ! Display solution and clean up
133: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
135: ! ** Get number of converged singular triplets
136: call SVDGetConverged(svd,nconv,ierr)
137: if (rank .eq. 0) then
138: write(*,150) nconv
139: endif
140: 150 format (' Number of converged approximate singular triplets:',I2/)
142: ! ** Display singular values and relative errors
143: if (nconv.gt.0) then
144: if (rank .eq. 0) then
145: write(*,*) ' sigma relative error'
146: write(*,*) ' ----------------- ------------------'
147: endif
148: do i=0,nconv-1
149: ! ** Get i-th singular value
150: call SVDGetSingularTriplet(svd,i,sigma,PETSC_NULL_VEC, &
151: & PETSC_NULL_VEC,ierr)
153: ! ** Compute the relative error for each singular triplet
154: call SVDComputeError(svd,i,SVD_ERROR_RELATIVE,error,ierr)
155: if (rank .eq. 0) then
156: write(*,160) sigma, error
157: endif
158: 160 format (1P,' ',E12.4,' ',E12.4)
160: enddo
161: if (rank .eq. 0) then
162: write(*,*)
163: endif
164: endif
166: ! ** Free work space
167: call SVDDestroy(svd,ierr)
168: call MatDestroy(A,ierr)
170: call SlepcFinalize(ierr)
171: end