! E04AB_A1W_F Example Program Text
! Mark 30.0 Release. NAG Copyright 2024.
Module e04ab_a1w_fe_mod
! E04AB_A1W_F Example Program Module:
! Parameters and User-defined Routines
! .. Use Statements ..
Use iso_c_binding, Only: c_ptr
Use nagad_library, Only: nagad_a1w_w_rtype, sin, Assignment (=), &
Operator (/), Operator (*)
! .. Implicit None Statement ..
Implicit None
! .. Accessibility Statements ..
Private
Public :: funct_a1w
! .. Parameters ..
Integer, Parameter, Public :: nout = 6
! .. Local Scalars ..
Type (nagad_a1w_w_rtype), Public, Save :: t
Contains
Subroutine funct_a1w(ad_handle,xc,fc,iuser,ruser)
! Routine to evaluate F(x) at any point in (A, B)
! .. Scalar Arguments ..
Type (c_ptr), Intent (Inout) :: ad_handle
Type (nagad_a1w_w_rtype), Intent (Out) :: fc
Type (nagad_a1w_w_rtype), Intent (In) :: xc
! .. Array Arguments ..
Type (nagad_a1w_w_rtype), Intent (Inout) :: ruser(*)
Integer, Intent (Inout) :: iuser(*)
! .. Executable Statements ..
fc = sin(t*xc)/(xc)
Return
End Subroutine funct_a1w
End Module e04ab_a1w_fe_mod
Program e04abf_a1w_e
! E04AB_A1W_F Example Main Program
! .. Use Statements ..
Use e04ab_a1w_fe_mod, Only: funct_a1w, nout, t
Use iso_c_binding, Only: c_ptr
Use nagad_library, Only: e04ab_a1w_f, nagad_a1w_get_derivative, &
nagad_a1w_inc_derivative, &
nagad_a1w_ir_create => x10za_a1w_f, &
nagad_a1w_ir_interpret_adjoint_sparse, &
nagad_a1w_ir_register_variable, &
nagad_a1w_ir_remove, nagad_a1w_w_rtype, &
x10aa_a1w_f, x10ab_a1w_f, Assignment (=), &
Operator (*)
Use nag_library, Only: nag_wp
! .. Implicit None Statement ..
Implicit None
! .. Local Scalars ..
Type (nagad_a1w_w_rtype) :: a, b, e1, e2, f, x
Type (c_ptr) :: ad_handle
Real (Kind=nag_wp) :: tmp
Integer :: adifail, ifail, maxcal
! .. Local Arrays ..
Type (nagad_a1w_w_rtype) :: ruser(1)
Integer :: iuser(1)
! .. Executable Statements ..
Write (nout,*) 'E04AB_A1W_F Example Program Results'
ifail = 0
Call x10aa_a1w_f(ad_handle,ifail)
Call nagad_a1w_ir_create
! E1 and E2 are set to zero so that E04AB_A1W_F will reset them to
! their default values
e1 = 0.0_nag_wp
e2 = 0.0_nag_wp
! The minimum is known to lie in the range (3.5, 5.0)
a = 3.5_nag_wp
b = 5.0_nag_wp
t = 1.0_nag_wp
! Allow 30 calls of FUNCT
maxcal = 30
Call nagad_a1w_ir_register_variable(t)
ifail = -1
Call e04ab_a1w_f(ad_handle,funct_a1w,e1,e2,a,b,maxcal,x,f,iuser,ruser, &
ifail)
Select Case (ifail)
Case (0,2)
Write (nout,*)
Write (nout,99999) 'The minimum lies in the interval', a%value, ' to', &
b%value
Write (nout,99999) 'Its estimated position is', x%value, ','
Write (nout,99998) 'where the function value is ', f%value
Write (nout,99997) maxcal, 'function evaluations were required'
Case (:-1)
Write (nout,99995) 'Routine e04ab_a1w_f failed with ifail = ', ifail
Go To 100
End Select
x = x*1.0_nag_wp
Call nagad_a1w_inc_derivative(x,1.0_nag_wp)
Call nagad_a1w_ir_interpret_adjoint_sparse(adifail)
tmp = nagad_a1w_get_derivative(t)
Write (nout,99996) 'dx/dt = ', tmp
100 Continue
! Remove computational data object and tape
Call x10ab_a1w_f(ad_handle,ifail)
Call nagad_a1w_ir_remove
99999 Format (1X,A,F11.8,A,F11.8)
99998 Format (1X,A,F7.4)
99997 Format (1X,I2,1X,A)
99996 Format (1X,A,E26.16)
99995 Format (/,1X,A,I0)
End Program e04abf_a1w_e