! D03PCA Example Program Text
! Mark 27.1 Release. NAG Copyright 2020.
Module d03pcae_mod
! D03PCA 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 pdedef(npde,t,x,u,ux,p,q,r,ires,iuser,ruser)
! .. Scalar Arguments ..
Real (Kind=nag_wp), Intent (In) :: t, x
Integer, Intent (Inout) :: ires
Integer, Intent (In) :: npde
! .. Array Arguments ..
Real (Kind=nag_wp), Intent (Out) :: p(npde,npde), q(npde), r(npde)
Real (Kind=nag_wp), Intent (Inout) :: ruser(*)
Real (Kind=nag_wp), Intent (In) :: u(npde), ux(npde)
Integer, Intent (Inout) :: iuser(*)
! .. Local Scalars ..
Real (Kind=nag_wp) :: alpha
! .. Executable Statements ..
alpha = ruser(1)
q(1) = 4.0_nag_wp*alpha*(u(2)+x*ux(2))
q(2) = 0.0_nag_wp
r(1) = x*ux(1)
r(2) = ux(2) - u(1)*u(2)
p(1,1:2) = 0.0_nag_wp
p(2,1) = 0.0_nag_wp
p(2,2) = 1.0_nag_wp - x*x
Return
End Subroutine pdedef
Subroutine bndary(npde,t,u,ux,ibnd,beta,gamma,ires,iuser,ruser)
! .. 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 (Inout) :: ruser(*)
Real (Kind=nag_wp), Intent (In) :: u(npde), ux(npde)
Integer, Intent (Inout) :: iuser(*)
! .. Executable Statements ..
If (ibnd==0) Then
beta(1) = 0.0_nag_wp
beta(2) = 1.0_nag_wp
gamma(1) = u(1)
gamma(2) = -u(1)*u(2)
Else
beta(1) = 1.0_nag_wp
beta(2) = 0.0_nag_wp
gamma(1) = -u(1)
gamma(2) = u(2)
End If
Return
End Subroutine bndary
Subroutine uinit(u,x,npts,iuser,ruser)
! Routine for PDE initial conditon
! .. Scalar Arguments ..
Integer, Intent (In) :: npts
! .. Array Arguments ..
Real (Kind=nag_wp), Intent (Inout) :: ruser(*)
Real (Kind=nag_wp), Intent (Out) :: u(2,npts)
Real (Kind=nag_wp), Intent (In) :: x(npts)
Integer, Intent (Inout) :: iuser(*)
! .. Local Scalars ..
Real (Kind=nag_wp) :: alpha
Integer :: i
! .. Executable Statements ..
alpha = ruser(1)
Do i = 1, npts
u(1,i) = 2.0_nag_wp*alpha*x(i)
u(2,i) = 1.0_nag_wp
End Do
Return
End Subroutine uinit
End Module d03pcae_mod
Program d03pcae
! D03PCA Example Main Program
! .. Use Statements ..
Use d03pcae_mod, Only: bndary, nin, nout, npde, pdedef, uinit
Use nag_library, Only: d03pca, d03pzf, nag_wp, x01aaf
! .. Implicit None Statement ..
Implicit None
! .. Local Scalars ..
Real (Kind=nag_wp) :: acc, alpha, hx, pi, piby2, tout, ts
Integer :: i, ifail, ind, intpts, it, itask, &
itrace, itype, m, neqn, niw, npts, &
nw, nwk
! .. Local Arrays ..
Real (Kind=nag_wp) :: ruser(1), rwsav(1100)
Real (Kind=nag_wp), Allocatable :: u(:,:), uout(:,:,:), w(:), x(:), &
xout(:)
Integer :: iuser(1), iwsav(505)
Integer, Allocatable :: iw(:)
Logical :: lwsav(100)
Character (80) :: cwsav(10)
! .. Intrinsic Procedures ..
Intrinsic :: real, sin
! .. Executable Statements ..
Write (nout,*) 'D03PCA Example Program Results'
! Skip heading in data file
Read (nin,*)
Read (nin,*) intpts, npts, itype
neqn = npde*npts
niw = neqn + 24
nwk = (10+6*npde)*neqn
nw = nwk + (21+3*npde)*npde + 7*npts + 54
Allocate (u(npde,npts),uout(npde,intpts,itype),w(nw),x(npts), &
xout(intpts),iw(niw))
Read (nin,*) xout(1:intpts)
Read (nin,*) acc, alpha
Read (nin,*) m, itrace
ruser(1) = alpha
ind = 0
itask = 1
! Set spatial mesh points
piby2 = 0.5_nag_wp*x01aaf(pi)
hx = piby2/real(npts-1,kind=nag_wp)
x(1) = 0.0_nag_wp
x(npts) = 1.0_nag_wp
Do i = 2, npts - 1
x(i) = sin(hx*real(i-1,kind=nag_wp))
End Do
! Set initial conditions
Read (nin,*) ts, tout
! Set the initial values
Call uinit(u,x,npts,iuser,ruser)
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 d03pca(npde,m,ts,tout,pdedef,bndary,u,npts,x,acc,w,nw,iw,niw, &
itask,itrace,ind,iuser,ruser,cwsav,lwsav,iwsav,rwsav,ifail)
If (it==1) Then
Write (nout,99999) acc, alpha
Write (nout,99998) xout(1:6)
End If
! Interpolate at required spatial points
ifail = 0
Call d03pzf(npde,m,u,npts,x,xout,intpts,itype,uout,ifail)
Write (nout,99996) tout, uout(1,1:intpts,1)
Write (nout,99995) uout(2,1:intpts,1)
End Do
! Print integration statistics
Write (nout,99997) iw(1), iw(2), iw(3), iw(5)
99999 Format (/,/,' Accuracy requirement = ',E12.5,/,' Parameter ALPHA =', &
' ',E12.3,/)
99998 Format (' T / X ',6F8.4,/)
99997 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)
99996 Format (1X,F7.4,' U(1)',6F8.4)
99995 Format (9X,'U(2)',6F8.4,/)
End Program d03pcae