! F02FKF Example Program Text
! Mark 27.0 Release. NAG Copyright 2019.
Module f02fkfe_mod
! F02FKF Example Program Module:
! Parameters and User-defined Routines
! .. Use Statements ..
Use nag_library, Only: nag_wp
! .. Implicit None Statement ..
Implicit None
! .. Accessibility Statements ..
Private
Public :: mymonit, myoption
! .. Parameters ..
Integer, Parameter, Public :: nin = 5, nout = 6
Contains
Subroutine myoption(icomm,comm,istat,iuser,ruser)
! .. Use Statements ..
Use nag_library, Only: f12fdf
! .. Implicit None Statement ..
Implicit None
! .. Scalar Arguments ..
Integer, Intent (Inout) :: istat
! .. Array Arguments ..
Real (Kind=nag_wp), Intent (Inout) :: comm(*), ruser(*)
Integer, Intent (Inout) :: icomm(*), iuser(*)
! .. Local Scalars ..
Integer :: ifail1
Character (25) :: rec
! .. Intrinsic Procedures ..
Intrinsic :: max
! .. Executable Statements ..
Continue
istat = 0
If (iuser(1)>0) Then
Write (rec,99999) 'Print Level=', iuser(1)
ifail1 = 1
Call f12fdf(rec,icomm,comm,ifail1)
istat = max(istat,ifail1)
End If
If (iuser(2)>100) Then
Write (rec,99999) 'Iteration Limit=', iuser(2)
ifail1 = 1
Call f12fdf(rec,icomm,comm,ifail1)
istat = max(istat,ifail1)
End If
If (iuser(3)>0) Then
ifail1 = 1
Call f12fdf('Shifted Inverse',icomm,comm,ifail1)
istat = max(istat,ifail1)
End If
99999 Format (A,I5)
End Subroutine myoption
Subroutine mymonit(ncv,niter,nconv,w,rzest,istat,iuser,ruser)
! .. Implicit None Statement ..
Implicit None
! .. Scalar Arguments ..
Integer, Intent (Inout) :: istat
Integer, Intent (In) :: nconv, ncv, niter
! .. Array Arguments ..
Real (Kind=nag_wp), Intent (Inout) :: ruser(*)
Real (Kind=nag_wp), Intent (In) :: rzest(ncv), w(ncv)
Integer, Intent (Inout) :: iuser(*)
! .. Local Scalars ..
Integer :: i
! .. Executable Statements ..
Continue
If (iuser(4)>0) Then
If (niter==1 .And. iuser(3)>0) Then
Write (nout,99999) ' Arnoldi basis vectors used:', ncv
Write (nout,*) &
' The following Ritz values (mu) are related to the'
Write (nout,*) &
' true eigenvalues (lambda) by lambda = sigma + 1/mu'
End If
Write (nout,*)
Write (nout,99999) ' Iteration number ', niter
Write (nout,99998) ' Ritz values converged so far (', nconv, &
') and their Ritz estimates:'
Do i = 1, nconv
Write (nout,99997) i, w(i), rzest(i)
End Do
Write (nout,*) ' Next (unconverged) Ritz value:'
Write (nout,99996) nconv + 1, w(nconv+1)
End If
istat = 0
99999 Format (1X,A,I4)
99998 Format (1X,A,I4,A)
99997 Format (1X,1X,I4,1X,E13.5,1X,E13.5)
99996 Format (1X,1X,I4,1X,E13.5)
End Subroutine mymonit
End Module f02fkfe_mod
Program f02fkfe
! Example problem for F02FKF.
! .. Use Statements ..
Use f02fkfe_mod, Only: mymonit, myoption, nin, nout
Use nag_library, Only: f02fkf, nag_wp, x04abf, x04caf
! .. Implicit None Statement ..
Implicit None
! .. Parameters ..
Real (Kind=nag_wp), Parameter :: one = 1.0_nag_wp
Integer, Parameter :: iset = 1
! .. Local Scalars ..
Real (Kind=nag_wp) :: h2, sigma
Integer :: i, ifail, imon, j, k, ldv, lo, &
maxit, mode, n, nconv, ncv, nev, &
nnz, nx, outchn, prtlvl
! .. Local Arrays ..
Real (Kind=nag_wp), Allocatable :: a(:), d_print(:,:), resid(:), &
v(:,:), w(:)
Real (Kind=nag_wp) :: ruser(1)
Integer, Allocatable :: icol(:), irow(:)
Integer :: iuser(4)
! .. Intrinsic Procedures ..
Intrinsic :: real
! .. Executable Statements ..
Write (nout,*) 'F02FKF Example Program Results'
Write (nout,*)
! Skip heading in data file
Read (nin,*)
Read (nin,*) nx
Read (nin,*) nev
Read (nin,*) ncv
Read (nin,*) sigma
! Construct the matrix A in sparse form and store in A.
! The main diagonal of A is full and there are two subdiagonals of A:
! the first and the nx-th.
n = nx*nx
nnz = 3*n - 2*nx
Allocate (a(nnz),irow(nnz),icol(nnz))
! Zero out A.
a(1:nnz) = 0.0_nag_wp
! Main diagonal of A.
h2 = one/real((nx+1)*(nx+1),kind=nag_wp)
a(1:n) = 4.0_nag_wp/h2
Do i = 1, n
irow(i) = i
icol(i) = i
End Do
! First subdiagonal of A.
k = n
Do i = 1, nx
lo = (i-1)*nx
Do j = lo + 1, lo + nx - 1
k = k + 1
irow(k) = j + 1
icol(k) = j
a(k) = -one/h2
End Do
End Do
! nx-th subdiagonal
Do i = 1, nx - 1
lo = (i-1)*nx
Do j = lo + 1, lo + nx
k = k + 1
irow(k) = j + nx
icol(k) = j
a(k) = -one/h2
End Do
End Do
! Set some options via iuser array and routine argument OPTION.
! iuser(1) = print level, iuser(2) = iteration limit,
! iuser(3)>0 means shifted-invert mode
! iuser(4)>0 means print monitoring info
Read (nin,*) prtlvl
Read (nin,*) maxit
Read (nin,*) mode
Read (nin,*) imon
ruser(1) = one
iuser(1) = prtlvl
iuser(2) = maxit
iuser(3) = mode
iuser(4) = imon
! Find eigenvalues of largest magnitude and the corresponding
! eigenvectors.
ldv = n
Allocate (w(ncv),v(ldv,ncv),resid(n))
ifail = -1
Call f02fkf(n,nnz,a,irow,icol,nev,ncv,sigma,mymonit,myoption,nconv,w,v, &
ldv,resid,iuser,ruser,ifail)
If (ifail/=0) Then
Go To 100
End If
! Print Eigenvalues and the residual norm ||A*x - lambda*x||.
Allocate (d_print(nconv,2))
d_print(1:nconv,1) = w(1:nconv)
d_print(1:nconv,2) = resid(1:nconv)
Write (nout,*)
Flush (nout)
outchn = nout
Call x04abf(iset,outchn)
ifail = 0
Call x04caf('G','N',nconv,2,d_print,nconv,' Ritz values and residuals', &
ifail)
100 Continue
End Program f02fkfe