NAG Library Manual, Mark 28.5
Interfaces:  FL   CL   CPP   AD 

NAG FL Interface Introduction
Example description
!   D03PDF Example Program Text
!   Mark 28.5 Release. NAG Copyright 2022.

    Module d03pdfe_mod

!     D03PDF Example Program Module:
!            Parameters and User-defined Routines

!     .. Use Statements ..
      Use nag_library, Only: nag_wp
!     .. Implicit None Statement ..
      Implicit None
!     .. Accessibility Statements ..
      Private
      Public                           :: bndary, pdedef, uinit
!     .. Parameters ..
      Integer, Parameter, Public       :: nin = 5, nout = 6, npde = 2
    Contains
      Subroutine uinit(npde,npts,x,u)

!       .. Use Statements ..
        Use nag_library, Only: x01aaf
!       .. Scalar Arguments ..
        Integer, Intent (In)           :: npde, npts
!       .. Array Arguments ..
        Real (Kind=nag_wp), Intent (Out) :: u(npde,npts)
        Real (Kind=nag_wp), Intent (In) :: x(npts)
!       .. Local Scalars ..
        Real (Kind=nag_wp)             :: piby2
        Integer                        :: i
!       .. Intrinsic Procedures ..
        Intrinsic                      :: sin
!       .. Executable Statements ..
        piby2 = 0.5_nag_wp*x01aaf(piby2)
        Do i = 1, npts
          u(1,i) = -sin(piby2*x(i))
          u(2,i) = -piby2*piby2*u(1,i)
        End Do
        Return
      End Subroutine uinit

      Subroutine pdedef(npde,t,x,nptl,u,ux,p,q,r,ires)

!       .. Scalar Arguments ..
        Real (Kind=nag_wp), Intent (In) :: t
        Integer, Intent (Inout)        :: ires
        Integer, Intent (In)           :: npde, nptl
!       .. Array Arguments ..
        Real (Kind=nag_wp), Intent (Out) :: p(npde,npde,nptl), q(npde,nptl),   &
                                          r(npde,nptl)
        Real (Kind=nag_wp), Intent (In) :: u(npde,nptl), ux(npde,nptl),        &
                                          x(nptl)
!       .. Local Scalars ..
        Integer                        :: i
!       .. Executable Statements ..
        Do i = 1, nptl
          q(1,i) = u(2,i)
          q(2,i) = u(1,i)*ux(2,i) - ux(1,i)*u(2,i)
          r(1,i) = ux(1,i)
          r(2,i) = ux(2,i)
          p(1,1,i) = 0.0_nag_wp
          p(1,2,i) = 0.0_nag_wp
          p(2,1,i) = 0.0_nag_wp
          p(2,2,i) = 1.0_nag_wp
        End Do
        Return
      End Subroutine pdedef

      Subroutine bndary(npde,t,u,ux,ibnd,beta,gamma,ires)

!       .. Scalar Arguments ..
        Real (Kind=nag_wp), Intent (In) :: t
        Integer, Intent (In)           :: ibnd, npde
        Integer, Intent (Inout)        :: ires
!       .. Array Arguments ..
        Real (Kind=nag_wp), Intent (Out) :: beta(npde), gamma(npde)
        Real (Kind=nag_wp), Intent (In) :: u(npde), ux(npde)
!       .. Executable Statements ..
        If (ibnd==0) Then
          beta(1) = 1.0_nag_wp
          gamma(1) = 0.0_nag_wp
          beta(2) = 0.0_nag_wp
          gamma(2) = u(1) - 1.0_nag_wp
        Else
          beta(1) = 1.0E+0_nag_wp
          gamma(1) = 0.0_nag_wp
          beta(2) = 0.0_nag_wp
          gamma(2) = u(1) + 1.0_nag_wp
        End If
        Return
      End Subroutine bndary
    End Module d03pdfe_mod

    Program d03pdfe

!     D03PDF Example Main Program

!     .. Use Statements ..
      Use d03pdfe_mod, Only: bndary, nin, nout, npde, pdedef, uinit
      Use nag_library, Only: d03pdf, d03pyf, nag_wp
!     .. Implicit None Statement ..
      Implicit None
!     .. Local Scalars ..
      Real (Kind=nag_wp)               :: acc, dx, tout, ts
      Integer                          :: i, ifail, ind, intpts, it, itask,    &
                                          itrace, itype, lenode, lisave,       &
                                          lrsave, m, mu, nbkpts, nel, neqn,    &
                                          npl1, npoly, npts, nwkres
!     .. Local Arrays ..
      Real (Kind=nag_wp), Allocatable  :: rsave(:), u(:,:), uout(:,:,:), x(:), &
                                          xbkpts(:), xout(:)
      Integer, Allocatable             :: isave(:)
!     .. Intrinsic Procedures ..
      Intrinsic                        :: real
!     .. Executable Statements ..
      Write (nout,*) 'D03PDF Example Program Results'
!     Skip heading in data file
      Read (nin,*)
      Read (nin,*) intpts, nbkpts, npoly, itype

      nel = nbkpts - 1
      npts = nel*npoly + 1
      mu = npde*(npoly+1) - 1
      neqn = npde*npts
      lisave = neqn + 24
      npl1 = npoly + 1
      nwkres = 3*npl1*npl1 + npl1*(npde*npde+6*npde+nbkpts+1) + 13*npde + 5
      lenode = (3*mu+1)*neqn
      lrsave = 11*neqn + 50 + nwkres + lenode

      Allocate (u(npde,npts),uout(npde,intpts,itype),rsave(lrsave),x(npts),    &
        xbkpts(nbkpts),xout(intpts),isave(lisave))

      Read (nin,*) xout(1:intpts)
      Read (nin,*) acc
      Read (nin,*) m, itrace

!     Set the break-points

      dx = 2.0_nag_wp/real(nbkpts-1,kind=nag_wp)
      xbkpts(1) = -1.0_nag_wp
      Do i = 2, nbkpts - 1
        xbkpts(i) = xbkpts(i-1) + dx
      End Do
      xbkpts(nbkpts) = 1.0_nag_wp

      ind = 0
      itask = 1
      Read (nin,*) ts, tout

!     Loop over output values of t

      Do it = 1, 5
        tout = 10.0_nag_wp*tout

!       ifail: behaviour on error exit
!              =0 for hard exit, =1 for quiet-soft, =-1 for noisy-soft
        ifail = 0
        Call d03pdf(npde,m,ts,tout,pdedef,bndary,u,nbkpts,xbkpts,npoly,npts,x, &
          uinit,acc,rsave,lrsave,isave,lisave,itask,itrace,ind,ifail)

        If (it==1) Then
          Write (nout,99999) npoly, nel
          Write (nout,99998) acc, npts
          Write (nout,99997) xout(1:6)
        End If

!       Interpolate at required spatial points

        ifail = 0
        Call d03pyf(npde,u,nbkpts,xbkpts,npoly,npts,xout,intpts,itype,uout,    &
          rsave,lrsave,ifail)

        Write (nout,99996) ts, uout(1,1:intpts,1)
        Write (nout,99995) uout(2,1:intpts,1)
      End Do

!     Print integration statistics

      Write (nout,99994) isave(1), isave(2), isave(3), isave(5)

99999 Format (' Polynomial degree =',I4,'   No. of elements = ',I4)
99998 Format (' Accuracy requirement =',E10.3,'  Number of points = ',I5,/)
99997 Format ('  T /   X    ',6F8.4,/)
99996 Format (1X,F7.4,' U(1)',6F8.4)
99995 Format (9X,'U(2)',6F8.4,/)
99994 Format (' Number of integration steps in time                   ',I4,/,  &
        ' Number of residual evaluations of resulting ODE system',I4,/,        &
        ' Number of Jacobian evaluations                        ',I4,/,        &
        ' Number of iterations of nonlinear solver              ',I4)
    End Program d03pdfe