!   F01EFF Example Program Text
!   Mark 23 Release. NAG Copyright 2011.

    MODULE f01effe_mod

!      F01EFF 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
!      .. Parameters ..
       INTEGER, PARAMETER                  :: nin = 5, nout = 6
    CONTAINS
       SUBROUTINE f(iflag,n,x,fx,iuser,ruser)

!         .. Implicit None Statement ..
          IMPLICIT NONE
!         .. 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 Functions ..
          INTRINSIC                              cos
!         .. Executable Statements ..
          fx(1:n) = cos(x(1:n))

          RETURN
       END SUBROUTINE f
    END MODULE f01effe_mod
    PROGRAM f01effe

!      F01EFF Example Main Program

!      .. Use Statements ..
       USE nag_library, ONLY : f01eff, nag_wp, x04caf
       USE f01effe_mod, ONLY : f, nin, nout
!      .. Implicit None Statement ..
       IMPLICIT NONE
!      .. Local Scalars ..
       INTEGER                             :: i, ierr, ifail, iflag, lda, n
       CHARACTER (1)                       :: uplo
!      .. Local Arrays ..
       REAL (KIND=nag_wp), ALLOCATABLE     :: a(:,:)
       REAL (KIND=nag_wp)                  :: ruser(1)
       INTEGER                             :: iuser(1)
!      .. Executable Statements ..
       WRITE (nout,*) 'F01EFF 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 f01eff(uplo,n,a,lda,f,iuser,ruser,iflag,ifail)

!      Print solution

       ierr = 0
       CALL x04caf(uplo,'N',n,n,a,lda,'Symmetric f(A)',ierr)

    END PROGRAM f01effe