! D03PXF Example Program Text ! Mark 24 Release. NAG Copyright 2012. Module d03pxfe_mod ! D03PXF Example Program Module: ! Parameters and User-defined Routines ! .. Use Statements .. Use nag_library, Only: nag_wp ! .. Implicit None Statement .. Implicit None ! .. Parameters .. Real (Kind=nag_wp), Parameter :: alpha_l = 460.894_nag_wp Real (Kind=nag_wp), Parameter :: alpha_r = 46.095_nag_wp Real (Kind=nag_wp), Parameter :: beta_l = 19.5975_nag_wp Real (Kind=nag_wp), Parameter :: beta_r = 6.19633_nag_wp Real (Kind=nag_wp), Parameter :: half = 0.5_nag_wp Integer, Parameter :: itrace = 0, ncode = 0, nin = 5, & nout = 6, npde = 3, nxi = 0 ! .. Local Scalars .. Real (Kind=nag_wp) :: el0, er0, gamma, rl0, rr0, ul0, & ur0 Contains Subroutine bndary(npde,npts,t,x,u,ncode,v,vdot,ibnd,g,ires) ! .. Scalar Arguments .. Real (Kind=nag_wp), Intent (In) :: t Integer, Intent (In) :: ibnd, ncode, npde, npts Integer, Intent (Inout) :: ires ! .. Array Arguments .. Real (Kind=nag_wp), Intent (Out) :: g(npde) Real (Kind=nag_wp), Intent (In) :: u(npde,npts), v(ncode), & vdot(ncode), x(npts) ! .. Executable Statements .. If (ibnd==0) Then g(1) = u(1,1) - rl0 g(2) = u(2,1) - ul0 g(3) = u(3,1) - el0 Else g(1) = u(1,npts) - rr0 g(2) = u(2,npts) - ur0 g(3) = u(3,npts) - er0 End If Return End Subroutine bndary Subroutine numflx(npde,t,x,ncode,v,uleft,uright,flux,ires) ! .. Use Statements .. Use nag_library, Only: d03pxf ! .. Scalar Arguments .. Real (Kind=nag_wp), Intent (In) :: t, x Integer, Intent (Inout) :: ires Integer, Intent (In) :: ncode, npde ! .. Array Arguments .. Real (Kind=nag_wp), Intent (Out) :: flux(npde) Real (Kind=nag_wp), Intent (In) :: uleft(npde), uright(npde), & v(ncode) ! .. Local Scalars .. Real (Kind=nag_wp) :: tol Integer :: ifail, niter ! .. Executable Statements .. tol = 0.0_nag_wp niter = 0 ifail = 0 Call d03pxf(uleft,uright,gamma,tol,niter,flux,ifail) Return End Subroutine numflx End Module d03pxfe_mod Program d03pxfe ! D03PXF Example Main Program ! .. Use Statements .. Use nag_library, Only: d03pek, d03plf, d03plp, nag_wp Use d03pxfe_mod, Only: alpha_l, alpha_r, beta_l, beta_r, bndary, el0, & er0, gamma, half, itrace, ncode, nin, nout, npde, & numflx, nxi, rl0, rr0, ul0, ur0 ! .. Implicit None Statement .. Implicit None ! .. Local Scalars .. Real (Kind=nag_wp) :: d, p, tout, ts, v Integer :: i, ifail, ind, itask, itol, k, & lenode, mlu, neqn, niw, npts, & nw, nwkres Character (1) :: laopt, norm ! .. Local Arrays .. Real (Kind=nag_wp) :: algopt(30), atol(1), rtol(1), & ue(3,9), xi(1) Real (Kind=nag_wp), Allocatable :: u(:,:), w(:), x(:) Integer, Allocatable :: iw(:) ! .. Intrinsic Procedures .. Intrinsic :: real ! .. Executable Statements .. Write (nout,*) 'D03PXF Example Program Results' ! Skip heading in data file Read (nin,*) Read (nin,*) npts nwkres = npde*(2*npts+3*npde+32) + 7*npts + 4 mlu = 3*npde - 1 neqn = npde*npts + ncode niw = neqn + 24 lenode = 9*neqn + 50 nw = (3*mlu+1)*neqn + nwkres + lenode Allocate (u(npde,npts),w(nw),x(npts),iw(niw)) Read (nin,*) gamma, rl0, rr0, ul0, ur0 el0 = alpha_l/(gamma-1.0_nag_wp) + half*rl0*beta_l**2 er0 = alpha_r/(gamma-1.0_nag_wp) + half*rr0*beta_r**2 ! Initialise mesh Do i = 1, npts x(i) = real(i-1,kind=nag_wp)/real(npts-1,kind=nag_wp) End Do xi(1) = 0.0_nag_wp ! Initial values Do i = 1, npts If (x(i)