! D04AAF Example Program Text
! Mark 26.1 Release. NAG Copyright 2016.
Module d04aafe_mod
! D04AAF Example Program Module:
! Parameters and User-defined Routines
! nder: abs(nder) is largest order derivative required;
! nder < 0 means only odd or even derivatives.
! h_init: initial step size.
! h_reduce: reduction factor applied to successive step sizes.
! xval: derivatives evaluated at x=xval.
! .. Use Statements ..
Use nag_library, Only: nag_wp
! .. Implicit None Statement ..
Implicit None
! .. Accessibility Statements ..
Private
Public :: fun
! .. Parameters ..
Real (Kind=nag_wp), Parameter, Public :: h_init = 0.5_nag_wp
Real (Kind=nag_wp), Parameter, Public :: h_reduce = 0.1_nag_wp
Real (Kind=nag_wp), Parameter, Public :: xval = 0.5_nag_wp
Integer, Parameter, Public :: nder = -7, nout = 6
Contains
Function fun(x)
! .. Function Return Value ..
Real (Kind=nag_wp) :: fun
! .. Scalar Arguments ..
Real (Kind=nag_wp), Intent (In) :: x
! .. Intrinsic Procedures ..
Intrinsic :: exp
! .. Executable Statements ..
fun = 0.5_nag_wp*exp(2.0_nag_wp*x-1.0_nag_wp)
Return
End Function fun
End Module d04aafe_mod
Program d04aafe
! D04AAF Example Main Program
! .. Use Statements ..
Use d04aafe_mod, Only: fun, h_init, h_reduce, nder, nout, xval
Use nag_library, Only: d04aaf, nag_wp
! .. Implicit None Statement ..
Implicit None
! .. Local Scalars ..
Real (Kind=nag_wp) :: hbase
Integer :: i, ifail, j, k, l
! .. Local Arrays ..
Real (Kind=nag_wp) :: der(14), erest(14)
! .. Intrinsic Procedures ..
Intrinsic :: abs, merge
! .. Executable Statements ..
Write (nout,*) 'D04AAF Example Program Results'
Write (nout,*)
Write (nout,*) &
'Four separate runs to calculate the first four odd order ', &
'derivatives of'
Write (nout,*) ' FUN(X) = 0.5*exp(2.0*X-1.0) at X = 0.5.'
Write (nout,*) 'The exact results are 1, 4, 16 and 64'
Write (nout,*)
Write (nout,*) 'Input parameters common to all four runs'
Write (nout,99999) ' XVAL = ', xval, ' NDER = ', nder, &
' IFAIL = 0'
Write (nout,*)
hbase = h_init
l = abs(nder)
If (nder>=0) Then
j = 1
Else
j = 2
End If
Do k = 1, 4
ifail = 0
Call d04aaf(xval,nder,hbase,der,erest,fun,ifail)
Write (nout,*)
Write (nout,99998) 'with step length', hbase, ' the results are'
Write (nout,*) 'Order Derivative Questionable?'
Do i = 1, l, j
Write (nout,99997) i, der(i), merge('Yes','No ',erest(i)<0._nag_wp)
End Do
hbase = hbase*h_reduce
End Do
99999 Format (1X,A,F4.1,A,I2,A)
99998 Format (1X,A,F9.4,A)
99997 Format (1X,I2,E21.4,13X,A)
End Program d04aafe