Program e02bc_t1w_fe
! E02BC_T1W_F Example Program Text
! Mark 30.2 Release. NAG Copyright 2024.
! .. Use Statements ..
Use iso_c_binding, Only: c_ptr
Use nagad_library, Only: e02bc_t1w_f, nagad_t1w_get, nagad_t1w_set, &
nagad_t1w_w_rtype, x10aa_t1w_f, x10ab_t1w_f, &
Assignment (=)
Use nag_library, Only: nag_wp, x04caf
! .. Implicit None Statement ..
Implicit None
! .. Parameters ..
Integer, Parameter :: nin = 5, nout = 6
! .. Local Scalars ..
Type (c_ptr) :: ad_handle
Type (nagad_t1w_w_rtype) :: x
Integer :: i, ifail, j, l, left, m, ncap, ncap7
! .. Local Arrays ..
Type (nagad_t1w_w_rtype), Allocatable :: c(:), lamda(:)
Type (nagad_t1w_w_rtype) :: s(4)
Real (Kind=nag_wp), Allocatable :: dsdc(:,:,:), dsdl(:,:,:)
! .. Executable Statements ..
Write (nout,*) 'E02BC_T1W_F Example Program Results'
! Skip heading in data file
Read (nin,*)
Read (nin,*) ncap, m
ncap7 = ncap + 7
Allocate (lamda(ncap7),c(ncap7),dsdl(ncap7,m,2),dsdc(ncap7,m,2))
lamda = 0.0_nag_wp
c = 0.0_nag_wp
Read (nin,*) lamda(1:ncap7)%value
Read (nin,*) c(1:(ncap+3))%value
! Create AD configuration data object
ifail = 0
Call x10aa_t1w_f(ad_handle,ifail)
Do i = 1, m
x = 0.0_nag_wp
Read (nin,*) x%value
Do left = 1, 2
ifail = 0
Call e02bc_t1w_f(ad_handle,ncap7,lamda,c,x,left,s,ifail)
If (left==1) Then
If (i==1) Then
Write (nout,*)
Write (nout,99999) 'x', 'Spline', '1st deriv', '2nd deriv', &
'3rd deriv'
End If
99999 Format (6X,A,13X,A,4X,A,3X,A,3X,A)
Write (nout,*)
Write (nout,99998) x%value, ' Left', (s(l)%value,l=1,4)
Else
Write (nout,99998) x%value, ' Right', (s(l)%value,l=1,4)
End If
Do j = 1, ncap7
Call nagad_t1w_set(lamda(j),1.0_nag_wp,1)
Call e02bc_t1w_f(ad_handle,ncap7,lamda,c,x,left,s,ifail)
Call nagad_t1w_set(lamda(j),0.0_nag_wp,1)
Call nagad_t1w_get(s(1),dsdl(j,i,left),1)
End Do
Do j = 1, ncap7
Call nagad_t1w_set(c(j),1.0_nag_wp,1)
Call e02bc_t1w_f(ad_handle,ncap7,lamda,c,x,left,s,ifail)
Call nagad_t1w_set(c(j),0.0_nag_wp,1)
Call nagad_t1w_get(s(1),dsdc(j,i,left),1)
End Do
End Do
End Do
Write (nout,*)
Write (nout,*) ' Derivatives of spline values with respect to knots'
Call x04caf('General',' ',ncap7,m,dsdl,ncap7,'Left: ds/dlamda',ifail)
Write (nout,*)
Call x04caf('General',' ',ncap7,m,dsdl(1,1,2),ncap7,'Right: ds/dlamda', &
ifail)
Write (nout,*)
Write (nout,*) ' Derivatives with respect to spline coefficients'
Call x04caf('General',' ',ncap7,m,dsdc,ncap7,'Left: ds/dc',ifail)
Write (nout,*)
Call x04caf('General',' ',ncap7,m,dsdc(1,1,2),ncap7,'Right: ds/dc', &
ifail)
Call x10ab_t1w_f(ad_handle,ifail)
99998 Format (1X,E10.2,A,4E12.4)
End Program e02bc_t1w_fe