! 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