! D04AAF Example Program Text ! Mark 24 Release. NAG Copyright 2012. Module d04aafe_mod ! D04AAF Example Program Module: ! Parameters and User-defined Routines ! .. Use Statements .. Use nag_library, Only: nag_wp ! .. Implicit None Statement .. Implicit None ! .. Parameters .. Real (Kind=nag_wp), Parameter :: h_init = 0.5_nag_wp Real (Kind=nag_wp), Parameter :: h_reduce = 0.1_nag_wp Real (Kind=nag_wp), Parameter :: xval = 0.5_nag_wp Integer, Parameter :: nder = -7, nout = 6 ! 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. 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 nag_library, Only: d04aaf, nag_wp Use d04aafe_mod, Only: fun, h_init, h_reduce, nder, nout, xval ! .. 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 ! .. 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 Error estimate' Do i = 1, l, j Write (nout,99997) i, der(i), erest(i) 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,2E21.4) End Program d04aafe