      SUBROUTINE INITAL
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      PARAMETER (NX=11)
      COMMON/T/         T,      NFIN,     NORUN
     1      /Y/     U(NX)
     2      /F/    UT(NX)
     3      /S/    UX(NX),   UXX(NX),     X(NX)
     4      /C/         A,         B,         C,         D
C...
C...  CONSTANTS IN THE ANALYTICAL SOLUTION
      A= 1.0D+00
      B= 1.0D+00
      C= 1.0D+00
      D= 1.0D+00
C...
C...  SPATIAL GRID AND THE INITIAL CONDITION
      DO 1 I=1,NX
         X(I)=DFLOAT(I-1)/DFLOAT(NX-1)
         CALL UE(X(I),T,U(I))
1     CONTINUE
C...
C...  INITIAL DERIVATIVES
      CALL DERV
      RETURN
      END
      SUBROUTINE DERV
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      PARAMETER (NX=11)
      COMMON/T/         T,      NFIN,     NORUN
     1      /Y/     U(NX)
     2      /F/    UT(NX)
     3      /S/    UX(NX),   UXX(NX),     X(NX)
     4      /C/         A,         B,         C,         D
C...
C...  BOUNDARY CONDITIONS
C...
C...     CASE 1 - DIRICHLET BOUNDARY CONDITIONS
         IF(NORUN.EQ.1)THEN
            NL=1
            NU=1
            CALL UE(X( 1),T,U( 1))
            CALL UE(X(NX),T,U(NX))
         END IF
C...
C...  UX
      CALL DSS020(0.0D0,1.0D0,NX,U,UX,1.0D+00)
C...
C...     CASE 2 - NEUMANN BOUNDARY CONDITIONS
         IF(NORUN.EQ.2)THEN
            NL=2
            NU=2
            CALL UXE(X( 1),T,UX( 1))
            CALL UXE(X(NX),T,UX(NX))
         END IF
C...
C...  UXX
      CALL DSS044(0.0D0,1.0D0,NX,U,UX,UXX,NL,NU)
C...
C...  MODIFIED BURGERS EQUATION
      DO 2 I=1,NX
         UT(I)=U(I)*UXX(I)-U(I)*UX(I)
2     CONTINUE
      RETURN
      END
      SUBROUTINE UE(X,T,U)
C...
C...  SUBROUTINE EXACT COMPUTES THE EXACT SOLUTION FOR COMPARISON
C...  WITH THE NUMERICAL SOLUTION.  IT IS ALSO USED TO DEFINE THE
C...  INITIAL AND BOUNDARY CONDITIONS FOR THE NUMERICAL SOLUTION
C...
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      COMMON/C/         A,         B,         C,         D
C...
C...  ANALYTICAL SOLUTION TO MODIFIED BURGERS EQUATION
      U=(A+B*DEXP(X)+C*X)/(C*T+D)
      RETURN
      END
      SUBROUTINE UXE(X,T,UX)
C...
C...  SUBROUTINE EXACT COMPUTES THE SPATIAL DERIVATIVE OF THE
C...  EXACT SOLUTION FOR COMPARISON WITH THE NUMERICAL SOLUTION.
C...  IT IS ALSO USED TO DEFINE THE BOUNDARY CONDITIONS FOR THE
C...  NUMERICAL SOLUTION
C...
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      COMMON/C/         A,         B,         C,         D
C...
C...  ANALYTICAL DERIVATIVE FOR MODIFIED BURGERS EQUATION
      UX=(B*DEXP(X)+C)/(C*T+D)
      RETURN
      END
      SUBROUTINE PRINT(NI,NO)
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      PARAMETER (NX=11)
      COMMON/T/         T,      NFIN,     NORUN
     1      /Y/     U(NX)
     2      /F/    UT(NX)
     3      /S/    UX(NX),   UXX(NX),     X(NX)
     4      /C/         A,         B,         C,         D
     5      /P/  UN(6,NX),        IP
C...
C...  INITIALIZE A COUNTER FOR THE PLOTTING
      DATA IP/0/
C...
C...  MONITOR THE SOLUTION
      IP=IP+1
      WRITE(*,*)NORUN,IP,T
C...
C...  STORE THE NUMERICAL SOLUTION FOR SUBSEQUENT PLOTTING VIA SUBROU-
C...  TINE PLOT1
      DO 10 I=1,NX
         UN(IP,I)=U(I)
10    CONTINUE
C...
C...  PRINT THE NUMERICAL AND ANALYTICAL SOLUTIONS, THE DIFFERENCE
C..   BETWEEN THE SOLUTIONS AND THE TERMS IN BURGERS EQUATION
      WRITE(NO,2)T
2     FORMAT(1H ,//,5H T = ,F5.2,//,
     1 9X,1HX,5X,5HU NUM,4X,6HU ANAL,5X,5HERROR,5X,5HU*UXX,5X,5H-U*UX,
     2 8X,2HUT)
      DO 3 I=1,NX
         CALL UE(X(I),T,UANAL)
         ERROR=U(I)-UANAL
         DIFF= U(I)*UXX(I)
         CONV=-U(I)*UX( I)
         WRITE(NO,4)X(I),U(I),UANAL,ERROR,DIFF,CONV,UT(I)
4        FORMAT(F10.3,6F10.5)
3     CONTINUE
C...
C...  PLOT THE SOLUTION
      CALL PLOT1
C...
C...  REINITIALIZE THE COUNTER FOR PLOTTING
      IF(IP.EQ.6)IP=0
      RETURN
      END
      SUBROUTINE PLOT1
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      PARAMETER (NX=11)
      COMMON/T/         T,      NFIN,     NORUN
     1      /Y/     U(NX)
     2      /F/    UT(NX)
     3      /S/    UX(NX),   UXX(NX),     X(NX)
     4      /C/         A,         B,         C,         D
     5      /P/  UN(6,NX),        IP
C...
C...  WRITE A FILE FOR TOP DRAWER PLOTTING
      IF(IP.EQ.1)THEN
         OPEN(2,FILE='T.TOP',STATUS='NEW')
         WRITE(2,12)
12       FORMAT(' SET LIMITS X FROM 0 TO 1 Y FROM 0 TO 5',/,
     1          ' SET FONT DUPLEX')
      END IF
C...
C...  WRITE THE ANALYTICAL SOLUTION
      DO 16 I=1,NX
         CALL UE(X(I),T,UANAL)
         WRITE(2,11)X(I),UANAL
11       FORMAT(F10.3,F10.5)
16    CONTINUE
      WRITE(2,13)
13    FORMAT(' JOIN 1')
C...
C...  WRITE THE NUMERICAL SOLUTION AND PLOT LABELS
      IF(IP.EQ.6)THEN
         WRITE(2,1)
1        FORMAT(' SET SYMBOL 0')
         WRITE(2,11)(X(I),UN(1,I),I=1,NX)
         WRITE(2,2)
2        FORMAT(' SET SYMBOL 1')
         WRITE(2,11)(X(I),UN(2,I),I=1,NX)
         WRITE(2,3)
3        FORMAT(' SET SYMBOL 2')
         WRITE(2,11)(X(I),UN(3,I),I=1,NX)
         WRITE(2,4)
4        FORMAT(' SET SYMBOL 3')
         WRITE(2,11)(X(I),UN(4,I),I=1,NX)
         WRITE(2,5)
5        FORMAT(' SET SYMBOL 4')
         WRITE(2,11)(X(I),UN(5,I),I=1,NX)
         WRITE(2,6)
6        FORMAT(' SET SYMBOL 5')
         WRITE(2,11)(X(I),UN(6,I),I=1,NX)
      WRITE(2,14)NORUN
14    FORMAT(
     +' SET FONT DUPLEX'
     +,/,' TITLE 4.5 9.5',
     +   ' "Figure ',I2,'a: Modified Burgers Equation"'
     +,/,' TITLE LEFT "         u(x,t)"'
     +,/,' TITLE BOTTOM "x"'
     +,/,' TITLE 6.25 0.75 "u(x,t) vs  x"'
     +,/,' TITLE 4.25 0.30 "t = 0, 1,..., 5, NX = 11',
     +   ' Uniform Grid"')
C...
C...  NEXT PLOT
      WRITE(2,15)
15    FORMAT('NEW FRAME')
      END IF
      RETURN
      END
