Actual source code: test14f.F

slepc-3.7.2 2016-07-19
Report Typos and Errors
  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