! F01FFF Example Program Text
! Mark 27.1 Release. NAG Copyright 2020.
Module f01fffe_mod
! F01FFF Example Program Module:
! Parameters and User-defined Routines
! nin: the input channel number
! nout: the output channel number
! .. Use Statements ..
Use nag_library, Only: nag_wp
! .. Implicit None Statement ..
Implicit None
! .. Accessibility Statements ..
Private
Public :: f
! .. Parameters ..
Integer, Parameter, Public :: nin = 5, nout = 6
Contains
Subroutine f(iflag,n,x,fx,iuser,ruser)
! .. Scalar Arguments ..
Integer, Intent (Inout) :: iflag
Integer, Intent (In) :: n
! .. Array Arguments ..
Real (Kind=nag_wp), Intent (Out) :: fx(n)
Real (Kind=nag_wp), Intent (Inout) :: ruser(*)
Real (Kind=nag_wp), Intent (In) :: x(n)
Integer, Intent (Inout) :: iuser(*)
! .. Intrinsic Procedures ..
Intrinsic :: cos
! .. Executable Statements ..
fx(1:n) = cos(x(1:n))
Return
End Subroutine f
End Module f01fffe_mod
Program f01fffe
! F01FFF Example Main Program
! .. Use Statements ..
Use f01fffe_mod, Only: f, nin, nout
Use nag_library, Only: f01fff, nag_wp, x04daf
! .. Implicit None Statement ..
Implicit None
! .. Local Scalars ..
Integer :: i, ierr, ifail, iflag, lda, n
Character (1) :: uplo
! .. Local Arrays ..
Complex (Kind=nag_wp), Allocatable :: a(:,:)
Real (Kind=nag_wp) :: ruser(1)
Integer :: iuser(1)
! .. Executable Statements ..
Write (nout,*) 'F01FFF Example Program Results'
Write (nout,*)
Flush (nout)
! Skip heading in data file
Read (nin,*)
Read (nin,*) n
Read (nin,*) uplo
lda = n
Allocate (a(lda,n))
! Read A from data file
If (uplo=='U' .Or. uplo=='u') Then
Read (nin,*)(a(i,i:n),i=1,n)
Else
Read (nin,*)(a(i,1:i),i=1,n)
End If
! Find f( A )
ifail = 0
Call f01fff(uplo,n,a,lda,f,iuser,ruser,iflag,ifail)
! Print solution
ierr = 0
Call x04daf(uplo,'N',n,n,a,lda,'Hermitian f(A)',ierr)
End Program f01fffe