NAG Library Manual, Mark 30.1
Interfaces:  FL   CL   CPP   AD 

NAG FL Interface Introduction
Example description
!   F01FFF Example Program Text
!   Mark 30.1 Release. NAG Copyright 2024.

    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