! D03PDF Example Program Text
! Mark 23 Release. NAG Copyright 2011.
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
! .. Parameters ..
INTEGER, PARAMETER :: nin = 5, nout = 6, npde = 2
CONTAINS
SUBROUTINE uinit(npde,npts,x,u)
! .. Use Statements ..
USE nag_library, ONLY : x01aaf
! .. Implicit None Statement ..
IMPLICIT NONE
! .. 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 Functions ..
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)
! .. Implicit None Statement ..
IMPLICIT NONE
! .. 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)
! .. Implicit None Statement ..
IMPLICIT NONE
! .. 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 nag_library, ONLY : d03pdf, d03pyf, nag_wp
USE d03pdfe_mod, ONLY : bndary, nin, nout, npde, pdedef, uinit
! .. 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 Functions ..
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