*DECK PRO2P6
      SUBROUTINE INITAL
C...
C...  SUBROUTINE INITAL IS CALLED BY MAIN PROGRAM PRO1P3 TO DEFINE THE
C...  INITIAL CONDITION IN THE NUMOL SOLUTION OF EQUATIONS (2.31) TO
C...  (2.35)
C...
      COMMON/T/         T
     1      /Y/    U1(51),    U2(51)
     2      /F/   U1T(51),   U2T(51)
     3      /R/     X(51),   U1X(51),  U1XX(51),    UE(51),  DIFF(51),
     4                  L,        PI,        DX
     5      /I/         N
C...
C...  TYPE SELECTED VARIABLES AS REAL
      REAL L
C...
C...  CALCULATE PI FOR USE IN DO LOOP 1
      PI=ACOS(-1.0)
C...
C...  LENGTH
      L=1.0
C...
C...  GRID SPACING
      N=51
      DX=L/FLOAT(N-1)
C...
C...  INITIAL CONDITIONS (2.32), (2.33)
      DO 1 I=1,N
         X(I)=FLOAT(I-1)*DX
        U1(I)=SIN(PI*X(I)/L)
        U2(I)=0.
1     CONTINUE
      RETURN
      END
      SUBROUTINE DERV
C...
C...  SUBROUTINE DERV IS CALLED BY INTEGRATOR RKF45 TO DEFINE THE
C...  ODES IN THE NUMOL SOLUTION OF EQUATIONS (2.30) TO (2.35)
C...
      COMMON/T/         T
     1      /Y/    U1(51),    U2(51)
     2      /F/   U1T(51),   U2T(51)
     3      /R/     X(51),   U1X(51),  U1XX(51),    UE(51),  DIFF(51),
     4                  L,        PI,        DX
     5      /I/         N
C...
C...  TYPE SELECTED VARIABLES AS REAL
      REAL L
C...
C...  BOUNDARY CONDITION (2.34)
       U1(1)=0.
       U2(1)=0.
      U1T(1)=0.
      U2T(1)=0.
C...
C...  BOUNDARY CONDITION (2.35)
       U1(N)=0.
       U2(N)=0.
      U1T(N)=0.
      U2T(N)=0.
C...
C...  DERIVATIVE UX
      CALL DSS002(0.,L,N,U1,U1X)
C...
C...  DERIVATIVE UXX
      CALL DSS002(0.,L,N,U1X,U1XX)
C...
C...  PDES
      DO 2 I=2,N-1
C...
C...     EQUATION (2.31)
         U1T(I)=U2(I)
C...
C...     EQUATION (2.30)
         U2T(I)=U1XX(I)
2     CONTINUE
      RETURN
      END
      SUBROUTINE PRINT(NI,NO)
C...
C...  SUBROUTINE PRINT IS CALLED BY MAIN PROGRAM PRO1P3 TO PRINT THE
C...  NUMOL SOLUTION OF EQUATIONS (2.30) TO (2.35)
C...
      COMMON/T/         T
     1      /Y/    U1(51),    U2(51)
     2      /F/   U1T(51),   U2T(51)
     3      /R/     X(51),   U1X(51),  U1XX(51),    UE(51),  DIFF(51),
     4                  L,        PI,        DX
     5      /I/         N
C...
C...  TYPE SELECTED VARIABLES AS REAL
      REAL L
C...
C...  CALCULATE THE EXACT SOLUTION, AND THE DIFFERENCE BETWEEN THE
C...  NUMOL AND EXACT SOLUTIONS
      DO 3 I=1,N,10
      UE(I)=EXACT(I)
      DIFF(I)=U1(I)-UE(I)
3     CONTINUE
C...
C...  PRINT THE NUMOL SOLUTION TO EQUATIONS (2.30) TO (2.35)
      WRITE(NO,2)   T,(U1(I),I=1,N,10),
     1                (UE(I),I=1,N,10),
     2              (DIFF(I),I=1,N,10)
2     FORMAT(' TIME = ',F6.2,/,15X,'  X=0',5X,'X=0.2',5X,'X=0.4',5X,
     1                             'X=0.6',5X,'X=0.8',5X,'  X=1',/,
     2                         '    U(X,T)',6F10.6,/,
     3                         '   TE(X,T)',6F10.6,/,
     4                         ' DIFF(X,T)',6F10.6,/)
      RETURN
      END
      REAL FUNCTION EXACT(I)
C...
C...  FUNCTION EXACT COMPUTES THE EXACT SOLUTION TO EQUATIONS (2.30)
C...  TO (2.35), I.E., EQUATION (2.36), AT GRID INDEX I AND TIME T
C...
      COMMON/T/         T
     1      /Y/    U1(51),    U2(51)
     2      /F/   U1T(51),   U2T(51)
     3      /R/     X(51),   U1X(51),  U1XX(51),    UE(51),  DIFF(51),
     4                  L,        PI,        DX
     5      /I/         N
C...
C...  TYPE SELECTED VARIABLES AS REAL
      REAL L
C...
C...  EXACT SOLUTION AT X AND T
      EXACT=COS(PI*T/L)*SIN(PI*X(I)/L)
      RETURN
      END
