Actual source code: test14f.F
slepc-3.7.2 2016-07-19
1: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2: ! SLEPc - Scalable Library for Eigenvalue Problem Computations
3: ! Copyright (c) 2002-2016, Universitat 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: mpiexec -n <np> ./test14f [-help] [-n <n>] [all SLEPc options]
21: !
22: ! Description: Simple example that tests solving a DSNHEP problem.
23: !
24: ! The command line options are:
25: ! -n <n>, where <n> = matrix size
26: !
27: ! ----------------------------------------------------------------------
28: !
29: program main
30: implicit none
32: #include <petsc/finclude/petscsys.h>
33: #include <petsc/finclude/petscmat.h>
34: #include <slepc/finclude/slepcds.h>
36: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
37: ! Declarations
38: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
39: !
40: ! Variables:
41: ! A problem matrix
42: ! ds dense solver context
44: Mat A
45: DS ds
46: PetscInt n, i, ld, zero
47: PetscMPIInt rank
48: PetscErrorCode ierr
49: PetscBool flg
50: PetscScalar aa(1), wr(100), wi(100)
51: PetscReal re, im
52: PetscOffset ia
54: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
55: ! Beginning of program
56: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
58: zero = 0
59: call SlepcInitialize(PETSC_NULL_CHARACTER,ierr)
60: call MPI_Comm_rank(PETSC_COMM_WORLD,rank,ierr)
61: n = 10
62: call PetscOptionsGetInt(PETSC_NULL_OBJECT,PETSC_NULL_CHARACTER, &
63: & '-n',n,flg,ierr)
64: if (n .gt. 100) then
65: if (rank .eq. 0) then
66: write(*,100) n
67: endif
68: SETERRQ(PETSC_COMM_SELF,1,' ',ierr)
69: endif
70: 100 format (/'Program currently limited to n=100, you set n=',I3)
72: if (rank .eq. 0) then
73: write(*,110) n
74: endif
75: 110 format (/'Solve a Dense System of type NHEP, n =',I3,' (Fortran)')
77: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
78: ! Create DS object
79: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
81: call DSCreate(PETSC_COMM_WORLD,ds,ierr)
82: call DSSetType(ds,DSNHEP,ierr)
83: call DSSetFromOptions(ds,ierr)
84: ld = n
85: call DSAllocate(ds,ld,ierr)
86: call DSSetDimensions(ds,n,zero,zero,zero,ierr)
88: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
89: ! Fill with Grcar matrix
90: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
92: call DSGetMat(ds,DS_MAT_A,A,ierr)
93: call MatDenseGetArray(A,aa,ia,ierr)
94: call FillUpMatrix(n,aa(ia+1))
95: call MatDenseRestoreArray(A,aa,ia,ierr)
96: call DSRestoreMat(ds,DS_MAT_A,A,ierr)
97: call DSSetState(ds,DS_STATE_INTERMEDIATE,ierr)
99: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
100: ! Solve the problem and show eigenvalues
101: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
103: call DSSolve(ds,wr,wi,ierr)
104: ! call DSSort(ds,wr,wi,PETSC_NULL_SCALAR,PETSC_NULL_SCALAR, &
105: ! & PETSC_NULL_INTEGER,ierr)
107: if (rank .eq. 0) then
108: write(*,*) 'Computed eigenvalues ='
109: do i=1,n
110: #if defined(PETSC_USE_COMPLEX)
111: re = PetscRealPart(wr(i))
112: im = PetscImaginaryPart(wr(i))
113: #else
114: re = wr(i)
115: im = wi(i)
116: #endif
117: if (abs(im).lt.1.d-10) then
118: write(*,120) re
119: else
120: write(*,130) re, im
121: endif
122: end do
123: endif
124: 120 format (' ',F8.5)
125: 130 format (' ',F8.5,SP,F8.5,'i')
127: ! *** Clean up
128: call DSDestroy(ds,ierr)
129: call SlepcFinalize(ierr)
130: end
132: ! -----------------------------------------------------------------
134: subroutine FillUpMatrix(n,X)
135: PetscInt n,i,j
136: PetscScalar X(n,n)
138: do i=2,n
139: X(i,i-1) = -1.d0
140: end do
141: do j=0,3
142: do i=1,n-j
143: X(i,i+j) = 1.d0
144: end do
145: end do
146: return
147: end