*APP MATH01
      SUBROUTINE INITAL
C...
C...  ALTERNATE IMPLEMENTATIONS OF TIME-DEPENDENT DIRICHLET BOUNDARY
C...  CONDITIONS IN THE NUMERICAL METHOD OF LINES
C...
C...  SEVERAL ALTERNATIVE IMPLEMENTATIONS OF TIME-DEPENDENT DIRICHLET
C...  BOUNDARY CONDITIONS ARE PROGRAMMED FOR THE FOLLOWING PARTIAL
C...  DIFFERENTIAL EQUATION (PDE)
C...
C...     U  = -U                                                   (1)
C...      T     X
C...
C...     U(0,T) = 1 + (1/2)*SIN(-4*PI*T)                           (2)
C...
C...     U(X,0) = 1 + (1/2)*SIN( 4*PI*X)                           (3)
C...
C...  THE EXACT SOLUTION TO EQUATIONS (1) TO (3) IS
C...
C...     U(X,T) = 1 + (1/2)*SIN(4*PI*(X - T))                      (4)
C...
C...  WHICH SERVES AS A STANDARD FOR EVALUATING THE NUMERICAL SOLUTIONS
C...  FOR THE VARIOUS IMLEMENTATIONS OF THE DIRICHLET BOUNDARY CONDI-
C...  TION (2).
C...
C...  IN ADDITION TO COMPARING THE NUMERICAL SOLUTIONS FOR THE VARIOUS
C...  BC IMPLEMENTATIONS, A COUNTER IN DERV IS USED TO ASSESS THE RELA-
C...  TIVE COMPUTATIONAL EFFORT OF EACH IMPLEMENTATION.
C...
      COMMON/T/T,NFIN,NORUN
     1      /Y/ U(41)
     2      /F/UT(41)
     3     /SD/UX(41)
     4      /X/ X(41)
     5      /P/    PI,     N,NCALL
C...
C...  SET THE NUMBER OF INTERVALS AND COMPUTE THE VALUES OF X IN THE
C...  SPATIAL GRID
      N=41
      DX=1./FLOAT(N-1)
      DO 1 I=1,N
      X(I)=DX*FLOAT(I-1)
1     CONTINUE
C...
C...  SET THE INITIAL CONDITION, EQUATION (2)
      PI=4.*ATAN(1.)
      DO 2 I=1,N
      U(I)=1.+0.5*SIN(4.*PI*X(I))
2     CONTINUE
C...
C...  INITIALIZE THE COUNTER FOR SUBROUTINE DERV
      NCALL=0
      RETURN
      END
      SUBROUTINE DERV
      COMMON/T/T,NFIN,NORUN
     1      /Y/ U(41)
     2      /F/UT(41)
     3     /SD/UX(41)
     4      /X/ X(41)
     5      /P/    PI,     N,NCALL
C...
C...  APPLY BOUNDARY CONDITION (3)
C...
C...  FIRST IMPLEMENTATION
      IF(NORUN.EQ.1)THEN
      U(1)=1.+0.5*SIN(-4.*PI*T)
      UT(1)=0.
C...
C...  SECOND IMPLEMENTATION
      ELSE IF(NORUN.EQ.2)THEN
      U(1)=1.+0.5*SIN(-4.*PI*T)
C...
C...  THIRD IMPLEMENTATION
      ELSE IF(NORUN.EQ.3)THEN
      U(1)=1.+0.5*SIN(-4.*PI*T)
      UT(1)=-0.5*4.*PI*COS(-4.*PI*T)
      END IF
C...
C...  DEFINE THE LIMITS OF THE X DOMAIN
      XL=X(1)
      XU=X(N)
C...
C...  COMPUTE THE SPATIAL DERIVATIVE, U , IN EQUATION (1)
C...                                   X
      CALL DSS020(XL,XU,N,U,UX,1.)
C...
C...  EQUATION (1)
      DO 1 I=2,N
      UT(I)=-UX(I)
1     CONTINUE
C...
C...  INCREMENT THE COUNTER FOR SUBROUTINE DERV
      NCALL=NCALL+1
      RETURN
      END
      SUBROUTINE PRINT(NI,NO)
      COMMON/T/T,NFIN,NORUN
     1      /Y/ U(41)
     2      /F/UT(41)
     3     /SD/UX(41)
     4      /X/ X(41)
     5      /P/    PI,     N,NCALL
     6     /UA/UA(41), E(41),TP(11),EP(3,11)
C...
C...  INITIALIZE AND INCREMENT A COUNTER FOR PLOTTING
      DATA IP/0/
      IP=IP+1
C...
C...  COMPUTE THE ANALYTICAL SOLUTION, EQUATION (2.4), FOR COMPARISON
C...  WITH THE NUMERICAL SOLUTION
      DO 1 I=1,N
      UA(I)=1.+0.5*SIN(4.*PI*(X(I)-T))
       E(I)=U(I)-UA(I)
1     CONTINUE
C...
C...  SELECT THE MAXIMUM ERROR IN THE NUMERICAL SOLUTION OVER THE DOMAIN
C...  0 LE X LE 1
      EMAX=0.
      DO 3 I=1,N
      EMAX=AMAX1(ABS(E(I)),EMAX)
3     CONTINUE
C...
C...  PRINT THE MAXIMUM ERROR IN THE NUMERICAL SOLUTION VS T
      WRITE(NO,2)T,EMAX
2     FORMAT(1H ,/,20X,4HT = ,F6.3,3X,7HEMAX = ,E10.3)
C...
C...  STORE T AND EMAX FOR SUBSEQUENT PLOTTING
      TP(IP)=T
      EP(NORUN,IP)=EMAX
C...
C...  TEST FOR THE END OF A RUN
      IF(IP.LT.11)RETURN
C...
C...  PRINT THE NUMBER OF CALLS TO SUBROUTINE DERV FOR THE COMPLETED
C...  RUN AND INITIATE THE NEXT RUN
      WRITE(NO,6)NCALL
6     FORMAT(1H ,//,27H NUMBER OF CALLS TO DERV = ,I4)
C...
C...  TEST FOR THE END OF THE THIRD RUN WHEN THE NUMERICAL DATA ARE
C...  PLOTTED
      IF(NORUN.EQ.3)GO TO 5
      IP=0
      RETURN
5     CALL TPLOTS(NORUN,IP,TP,EP)
C...
C...  LABEL THE PLOT
      WRITE(NO,4)
4     FORMAT(1H ,//,46H EMAX VS T, THREE BC IMPLEMENTATIONS IN DERV  ,/,
     1              46H FIVE-POINT BIASED UPWIND APPROXIMATION OF UX )
      RETURN
      END
MADSEN, ET AL, LAPIDUS, ET AL, NUM METH FOR DIFF SYSTEMS, PP.236-237
0.        2.0       0.2
   41 2000    1    1  ABS 0.001
MADSEN, ET AL, LAPIDUS, ET AL, NUM METH FOR DIFF SYSTEMS, PP.236-237
0.        2.0       0.2
   41 2000    1    1  ABS 0.001
MADSEN, ET AL, LAPIDUS, ET AL, NUM METH FOR DIFF SYSTEMS, PP.236-237
0.        2.0       0.2
   41 2000    1    1  ABS 0.001
END OF RUNS
*APP MATH02
      SUBROUTINE INITAL
C...
C...  DAVIDENKO*S METHOD (A DIFFERENTIAL FORM OF NEWTON*S METHOD)
C...
C...  THE FOLLOWING SYSTEM OF SIX NONLINEAR ALGEBRAIC EQUATIONS IS
C...  SOLVED BY DAVIDENKO*S METHOD FOR THE SIX UNKNOWNS QC, QD, QE,
C...  P2, P3, P4
C...
C...     F1 = QC + QD - QE = 0                                       (1)
C...
C...     F2 = P2 - A1 + B1*QC**2 = 0                                 (2)
C...
C...     F3 = P3 - A2 + B2*QD**2 = 0                                 (3)
C...
C...     F4 = 2.31*(P4 - P2) + 8.69E-4*(QC**2)*LC/DC**5 = 0          (4)
C...
C...     F5 = 2.31*(P4 - P3) + 8.69E-4*(QD**2)*LC/DD**5 = 0          (5)
C...
C...     F6 = 2.31*(0  - P4) + 8.69E-4*(QE**2)*LC/DE**5
C...                                                                 (6)
C...                         + (Z5 - Z4) = 0
C...
C...  WHERE
C...
C...     QC, QD, QE     THREE FLOWS TO BE CALCULATED
C...
C...     P2, P3, P4     THREE PRESSURES TO BE CALCULATED
C...
C...     A1, B1         CONSTANTS FOR PUMP NO. 1
C...
C...     A2, B2         CONSTANTS FOR PUMP NO. 2
C...
C...     LC, DC         LENGTH AND DIAMETER OF PIPE SECTION C
C...
C...     LD, DD         LENGTH AND DIAMETER OF PIPE SECTION D
C...
C...     LE, DE         LENGTH AND DIAMETER OF PIPE SECTION E
C...
C...     Z5 - Z4        VERTICAL RISE OF PIPE SECTION E
C...
C...  THE INTERCONNECTION OF PUMPS, PIPES AND TANKS IS DESCRIBED IN THE
C...  REFERENCE CITED ON THE FIRST DATA LINE.
C...
C...  THE DAVIDENKO DIFFERENTIAL EQUATION FOR EQUATIONS (1) TO (6) CAN
C...  BE WRITTEN IN MATRIX FORM AS
C...
C...     -  -       -  -       -
C...     J*DX/DT = -F, X(T0) = X0                                 (7)(8)
C...
C...  WHERE
C...
C...     -
C...     J              JACOBIAN MATRIX FOR EQUATIONS (1) TO (6)
C...
C...     -
C...     X              SOLUTION VECTOR FOR EQUATIONS (1) TO (6) WHEN
C...                    -       -
C...                    DX/DT = 0
C...
C...     T              INDEPENDENT VARIABLE IN THE DAVIDENKO METHOD
C...
C...     T0             INITIAL VALUE OF T
C...
C...     -
C...     X0             INITIAL CONDITION VECTOR FOR EQUATION (7)
C...
C...                                    -                           -
C...  IN THE CODING IN SUBROUTINE DERV, J IS STORED IN ARRAY A, AND F IS
C...  STORED IN ARRAY B.  THE UNCOUPLING OF THE DERIVATIVES IN EQUATION
C...  (7) IS DONE IN SUBROUTINE DERV BY A CALL TO SUBROUTINES DECOMP AND
C...  SOLVE (LISTED AND DISCUSSED IN DETAIL IN FORSYTHE, G. E., M. A.
C...  MALCOLM AND C. B. MOLER, COMPUTER METHODS FOR MATHEMATICAL COMPU-
C...  TATAIONS, CHAPTER 3, PRENTICE-HALL, ENGLEWOOD-CLIFFS, N.J., 1977).
C...  ANY OTHER ROUTINE(S) FOR LINEAR ALGEBRAIC EQUATIONS CAN BE USED IN
C...                                                    --   -
C...  PLACE OF DECOMP AND SOLVE (THE GENERAL PROBLEM IS AX = B).
C...
C...                                                      -   -
C...  THE PROGRAMMING OF EQUATION (7) IN TERMS OF VECTORS X, DX/DT AND
C...  -             -
C...  F, AND MATRIX J, IS INTENDED TO ILLUSTRATE THE GENERAL FEATURES OF
C...  DAVIDENKO*S METHOD, I.E., THESE VECTORS AND MATRIX CAN BE EXPANDED
C...  TO ACCOMMODATE A PROBLEM OF ANY SIZE.
C...
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/      X(6)
     2      /F/   DXDT(6)
     3     /CV/        QC,        QD,        QE,        P2,        P3,
     4                 P4,        A1,        B1,        A2,        B2,
     5                 CC,        CD,        CE,     Z5MZ4,    A(6,6),
     6               B(6),   WORK(6),   IPVT(6),         N
C...
C...  SET THE MODEL CONSTANTS
      A1=156.5
      B1=0.00752
      A2=117.1
      B2=0.00427
      CC=8.69E-4*125./1.278**5
      CD=8.69E-4*125./2.067**5
      CE=8.69E-4*145./2.469**5
      Z5MZ4=70.
C...
C...  SET THE MODEL INITIAL CONDITIONS (TRIAL VALUES OF THE UNKNOWNS)
      QC=50.
      QD=100.
      QE=160.
      P2=100.
      P3=80.
      P4=60.
C...
C...  TRANSFER THE UNKNOWNS TO THE VECTOR X.  NOTE THAT THESE STATEMENTS
C...  CONSTITUTE A DEFINITION OF THE ELEMENTS OF X.  THIS IS ALSO AN
C...  IMPLEMENTATION OF INITIAL CONDITION (8)
      X(1)=QC
      X(2)=QD
      X(3)=QE
      X(4)=P2
      X(5)=P3
      X(6)=P4
C...
C...  INITIALIZE ALL OF THE MODEL CALCULATIONS
      N=6
      CALL DERV
      RETURN
      END
      SUBROUTINE DERV
      COMMON/T/         T,     NSTOP,     NORUN
C...
C...  THE CALCULATION OF THE DERIVATIVE VECTOR, DX/DT, IS SLIGHTLY
C...  DIFFERENT IN SUBROUTINES DERV1 AND DERV2.  SEE THE COMMENTS JUST
C...  BEFORE THE CALL TO SUBROUTINE DECOMP IN DERV1 AND DERV2 WHICH
C...  EXPLAIN THE DIFFERENCES IN THE CALCULATION OF DX/DT
C...
      IF(NORUN.EQ.1)CALL DERV1
      IF(NORUN.EQ.2)CALL DERV2
      RETURN
      END
      SUBROUTINE DERV1
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/      X(6)
     2      /F/   DXDT(6)
     3     /CV/        QC,        QD,        QE,        P2,        P3,
     4                 P4,        A1,        B1,        A2,        B2,
     5                 CC,        CD,        CE,     Z5MZ4,    A(6,6),
     6               B(6),   WORK(6),   IPVT(6),         N
      COMMON/IO/       NI,        NO
C...
C...  COMPUTE THE ELEMENTS OF THE JACOBIAN MATRIX FOR EQUATIONS (1) TO
C...  (6)
      DO 1 I=1,N
      DO 1 J=1,N
      A(I,J)=0.
1     CONTINUE
      A(1,1)=1.
      A(1,2)=1.
      A(1,3)=-1.
      A(2,1)=2.*B1*X(1)
      A(2,4)=1.
      A(3,2)=2.*B2*X(2)
      A(3,5)=1.
      A(4,1)=2.*CC*X(1)
      A(4,4)=-2.31
      A(4,6)= 2.31
      A(5,2)=2.*CD*X(2)
      A(5,5)=-2.31
      A(5,6)= 2.31
      A(6,3)=2.*CE*X(3)
      A(6,6)=-2.31
C...
C...  COMPUTE THE RIGHT HAND SIDE VECTOR FOR THE DAVIDENKO DIFFERENTIAL
C...  EQUATIONS.  NOTE THAT THESE STATEMENTS CONSTITUTE A DEFINITION OF
C...  THE ELEMENTS OF B (OR VECTOR F IN EQUATION (7)).  THEY FOLLOW
C...  DIRECTLY FROM THE STATEMENT OF EQUATIONS (1) TO (6) IN SUBROUTINE
C...  INITAL
      B(1)=-(X(1)+X(2)-X(3))
      B(2)=-(X(4)-A1+B1*X(1)**2)
      B(3)=-(X(5)-A2+B2*X(2)**2)
      B(4)=-(2.31*(X(6)-X(4))+CC*X(1)**2)
      B(5)=-(2.31*(X(6)-X(5))+CD*X(2)**2)
      B(6)=-(2.31*(0.  -X(6))+CE*X(3)**2+Z5MZ4)
C...
C...  SOLVE FOR THE VECTOR OF DERIVATIVES, DX/DT, IN EQUATION (7) (IN
C...  EFFECT, EQUATION (7) IS PREMULTIPLIED BY THE INVERSE OF JACOBIAN
C...  MATRIX J).  IN DERV1, ARRAY B IS USED TO STORE THE RIGHT HAND
C...  SIDE FUNCTION VECTOR, F.  THE SOLUTION RETURNED FROM THE CALL
C...  TO SUBROUTINE SOLVE, ALSO IN ARRAY B, IS THE DERIVATIVE VECTOR,
C...  DX/DT, WHICH IS MOVED FROM B TO THE ARRAY DXDT IN THIS FIRST
C...  APPROACH.  IN SUBROUTINE DERV2, THE ARRAY DXDT IS FIRST USED TO
C...  STORE THE FUNCTION VECTOR, F.  ARRAY DXDT IS THEN UPDATED BY THE
C...  CALL TO SUBROUTINE SOLVE SO THAT IT CONTAINS THE DERIVATIVE VECTOR
C...  DX/DT IN EQUATION (7) BEFORE THE RETURN FROM DERV2
      CALL DECOMP(N,N,A,COND,IPVT,WORK)
C...
C...  CHECK THE CONDITION OF MATRIX A BEFORE COMPUTING THE DERIVATIVE
C...  VECTOR, DX/DT.  IF A IS NEAR SINGULAR, TERMINATE THE CURRENT RUN
      IF(COND.LT.1.0E+20)GO TO 3
      WRITE(NO,4)COND
4     FORMAT(1H ,//,
     1 30H THE CONDITION NUMBER OF A IS ,E10.3,33H SO THE CURRENT RUN IS  G
     1 TERMINATED)
      NSTOP=1
C...
C...  COMPUTE THE DERIVATIVE VECTOR DX/DT (INDIRECTLY VIA ARRAY B)
3     CALL SOLVE(N,N,A,B,IPVT)
C...
C...  TRANSFER ARRAY B TO ARRAY DXDT SO THE DERIVATIVE VECTOR, DX/DT,
C...  IS AVAILABLE IN COMMON/F/
      DO 2 I=1,N
      DXDT(I)=B(I)
2     CONTINUE
      RETURN
      END
      SUBROUTINE DERV2
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/      X(6)
     2      /F/   DXDT(6)
     3     /CV/        QC,        QD,        QE,        P2,        P3,
     4                 P4,        A1,        B1,        A2,        B2,
     5                 CC,        CD,        CE,     Z5MZ4,    A(6,6),
     6               B(6),   WORK(6),   IPVT(6),         N
      COMMON/IO/       NI,        NO
C...
C...  COMPUTE THE ELEMENTS OF THE JACOBIAN MATRIX FOR EQUATIONS (1) TO
C...  (6)
      DO 1 I=1,N
      DO 1 J=1,N
      A(I,J)=0.
1     CONTINUE
      A(1,1)=1.
      A(1,2)=1.
      A(1,3)=-1.
      A(2,1)=2.*B1*X(1)
      A(2,4)=1.
      A(3,2)=2.*B2*X(2)
      A(3,5)=1.
      A(4,1)=2.*CC*X(1)
      A(4,4)=-2.31
      A(4,6)= 2.31
      A(5,2)=2.*CD*X(2)
      A(5,5)=-2.31
      A(5,6)= 2.31
      A(6,3)=2.*CE*X(3)
      A(6,6)=-2.31
C...
C...  COMPUTE THE RIGHT HAND SIDE VECTOR FOR THE DAVIDENKO DIFFERENTIAL
C...  EQUATIONS (NOTE THE TEMPORARY STORAGE IN ARRAY DXDT)
      DXDT(1)=-(X(1)+X(2)-X(3))
      DXDT(2)=-(X(4)-A1+B1*X(1)**2)
      DXDT(3)=-(X(5)-A2+B2*X(2)**2)
      DXDT(4)=-(2.31*(X(6)-X(4))+CC*X(1)**2)
      DXDT(5)=-(2.31*(X(6)-X(5))+CD*X(2)**2)
      DXDT(6)=-(2.31*(0.  -X(6))+CE*X(3)**2+Z5MZ4)
C...
C...  SOLVE FOR THE VECTOR OF DERIVATIVES, DX/DT, IN EQUATION (7) (IN
C...  EFFECT, EQUATION (7) IS PREMULTIPLIED BY THE INVERSE OF JACOBIAN
C...  MATRIX J).  IN DERV1, ARRAY B IS USED TO STORE THE RIGHT HAND SIDE
C...  VECTOR OF FUNCTIONS, F, IN EQUATION (7), WHICH IS THE MOST OBVIOUS
C...  APPROACH.  IN SUBROUTINE DERV2, THE ARRAY DXDT IS FIRST USED TO
C...  STORE THE FUNCTION VECTOR, F.  ARRAY DXDT IS THEN UPDATED BY THE
C...  CALL TO SUBROUTINE SOLVE SO THAT IT CONTAINS THE DERIVATIVE VECTOR
C...  DX/DT IN EQUATION (7) BEFORE THE RETURN FROM DERV2
      CALL DECOMP(N,N,A,COND,IPVT,WORK)
C...
C...  CHECK THE CONDITION OF MATRIX A BEFORE COMPUTING THE DERIVATIVE
C...  VECTOR, DX/DT.  IF A IS NEAR SINGULAR, TERMINATE THE CURRENT RUN
      IF(COND.LT.1.0E+20)GO TO 3
      WRITE(NO,4)COND
4     FORMAT(1H ,//,
     1 30H THE CONDITION NUMBER OF A IS ,E10.3,33H SO THE CURRENT RUN IS  G
     1 TERMINATED)
      NSTOP=1
C...
C...  COMPUTE THE DERIVATIVE VECTOR DX/DT
3     CALL SOLVE(N,N,A,DXDT,IPVT)
C...
C...  AT THIS POINT, THE DERIVATIVE VECTOR, DX/DT, AS COMPUTED BY SOLVE
C...  IS IN ARRAY DXDT, SO ALL OF THE DERIVATIVES IN COMMON/F/ HAVE BEEN
C...  COMPUTED
      RETURN
      END
      SUBROUTINE PRINT(NI,NO)
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/      X(6)
     2      /F/   DXDT(6)
     3     /CV/        QC,        QD,        QE,        P2,        P3,
     4                 P4,        A1,        B1,        A2,        B2,
     5                 CC,        CD,        CE,     Z5MZ4,    A(6,6),
     6               B(6),   WORK(6),   IPVT(6),         N
C...
C...  DIMENSION THE ARRAYS TO STORE THE RESIDUALS OF EQUATIONS (1) TO
C...  (6) FOR SUBSEQUENT PLOTTING
      DIMENSION F1R(11), F2R(11), F3R(11), F4R(11), F5R(11), F6R(11),
     1           TP(11)
C...
C...  PRINT A HEADING FOR THE NUMERICAL SOLUTION
      IF(T.GT.0.05)GO TO 3
      WRITE(NO,1)
1     FORMAT(9X,1HT,8X,2HQC,8X,2HQD,8X,2HQE,8X,2HP2,8X,2HP3,8X,2HP4,/,
     1      12X,8HDX(1)/DT,2X,8HDX(2)/DT,2X,8HDX(3)/DT,2X,8HDX(4)/DT,
     2       2X,8HDX(5)/DT,2X,8HDX(6)/DT,/,
     3      18X,2HF1,8X,2HF2,8X,2HF3,8X,2HF4,8X,2HF5,8X,2HF6,/)
      IP=0
C...
C...  PRINT THE NUMERICAL SOLUTION.  THE ELEMENTS OF B MUST FIRST BE
C...  RECOMPUTED SINCE B CONTAINS THE VECTOR DX/DT AFTER THE CALL TO
C...  SOLVE IN SUBROUTINE DERV
3     B(1)=-(X(1)+X(2)-X(3))
      B(2)=-(X(4)-A1+B1*X(1)**2)
      B(3)=-(X(5)-A2+B2*X(2)**2)
      B(4)=-(2.31*(X(6)-X(4))+CC*X(1)**2)
      B(5)=-(2.31*(X(6)-X(5))+CD*X(2)**2)
      B(6)=-(2.31*(0.  -X(6))+CE*X(3)**2+Z5MZ4)
      WRITE(NO,2)T,(X(I),I=1,N),(DXDT(I),I=1,N),(B(I),I=1,N)
2     FORMAT(F10.1,6F10.3,/,10X,6F10.3,/,10X,6F10.3,/)
C...
C...  PLOT THE LOG OF THE RESIDUALS OF EQUATION (1) TO (6) VS T TO
C...  INVESTIGATE THE EXPONENTIAL CONVERGENCE OF DAVIDENKO*S ALGORITHM.
C...  PLOTTING IS DONE ONLY ONCE IN RUN 2 (NORUN = 2) SINCE THE NUMERI-
C...  CAL OUTPUT OF RUNS 1 AND 2 IS THE SAME
      IF(NORUN.EQ.1)RETURN
C...
C...  STORE THE RESIDUALS FOR PLOTTING
      IP=IP+1
      F1R(IP)=ALOG(ABS(B(1)))
      F2R(IP)=ALOG(ABS(B(2)))
      F3R(IP)=ALOG(ABS(B(3)))
      F4R(IP)=ALOG(ABS(B(4)))
      F5R(IP)=ALOG(ABS(B(5)))
      F6R(IP)=ALOG(ABS(B(6)))
      TP(IP)=T
C...
C...  AT THE END OF RUN 2, PLOT THE RESIDUALS
      IF(T.LT.9.75)RETURN
      CALL TPLOTS(1,IP,TP,F1R)
      WRITE(NO,11)
      CALL TPLOTS(1,IP,TP,F2R)
      WRITE(NO,12)
      CALL TPLOTS(1,IP,TP,F3R)
      WRITE(NO,13)
      CALL TPLOTS(1,IP,TP,F4R)
      WRITE(NO,14)
      CALL TPLOTS(1,IP,TP,F5R)
      WRITE(NO,15)
      CALL TPLOTS(1,IP,TP,F6R)
      WRITE(NO,16)
11    FORMAT(1H ,//,16X,43HLOG OF RESIDUAL OF EQUATION 1 VS T         )
12    FORMAT(1H ,//,16X,43HLOG OF RESIDUAL OF EQUATION 2 VS T         )
13    FORMAT(1H ,//,16X,43HLOG OF RESIDUAL OF EQUATION 3 VS T         )
14    FORMAT(1H ,//,16X,43HLOG OF RESIDUAL OF EQUATION 4 VS T         )
15    FORMAT(1H ,//,16X,43HLOG OF RESIDUAL OF EQUATION 5 VS T         )
16    FORMAT(1H ,//,16X,43HLOG OF RESIDUAL OF EQUATION 6 VS T         )
      RETURN
      END
      SUBROUTINE DECOMP(NDIM,N,A,COND,IPVT,WORK)
C
      INTEGER NDIM,N
      REAL A(NDIM,N),COND,WORK(N)
      INTEGER IPVT(N)
C
C     DECOMPOSES A REAL MATRIX BY GAUSSIAN ELIMINATION
C     AND ESTIMATES THE CONDITION OF THE MATRIX.
C
C     USE SOLVE TO COMPUTE SOLUTIONS TO LINEAR SYSTEMS.
C
C     INPUT..
C
C        NDIM = DECLARED ROW DIMENSION OF THE ARRAY CONTAINING  A.
C
C        N = ORDER OF THE MATRIX.
C
C        A = MATRIX TO BE TRIANGULARIZED.
C
C     OUTPUT..
C
C        A  CONTAINS AN UPPER TRIANGULAR MATRIX  U  AND A PERMUTED
C          VERSION OF A LOWER TRIANGULAR MATRIX  I-L  SO THAT
C          (PERMUTATION MATRIX)*A = L*U .
C
C        COND = AN ESTIMATE OF THE CONDITION OF  A .
C           FOR THE LINEAR SYSTEM  A*X = B, CHANGES IN  A  AND  B
C           MAY CAUSE CHANGES  COND  TIMES AS LARGE IN  X .
C           IF  COND+1.0 .EQ. COND , A IS SINGULAR TO WORKING
C           PRECISION.  COND  IS SET TO  1.0E+32  IF EXACT
C           SINGULARITY IS DETECTED.
C
C        IPVT = THE PIVOT VECTOR.
C           IPVT(K) = THE INDEX OF THE K-TH PIVOT ROW
C           IPVT(N) = (-1)**(NUMBER OF INTERCHANGES)
C
C     WORK SPACE..  THE VECTOR  WORK  MUST BE DECLARED AND INCLUDED
C                   IN THE CALL.  ITS INPUT CONTENTS ARE IGNORED.
C                   ITS OUTPUT CONTENTS ARE USUALLY UNIMPORTANT.
C
C     THE DETERMINANT OF A CAN BE OBTAINED ON OUTPUT BY
C        DET(A) = IPVT(N) * A(1,1) * A(2,2) * ... * A(N,N).
C
      REAL EK, T, ANORM, YNORM, ZNORM
      INTEGER NM1, I, J, K, KP1, KB, KM1, M
C
      IPVT(N) = 1
      IF (N .EQ. 1) GO TO 80
      NM1 = N - 1
C
C     COMPUTE 1-NORM OF A
C
      ANORM = 0.0
      DO 10 J = 1, N
         T = 0.0
         DO 5 I = 1, N
            T = T + ABS(A(I,J))
    5    CONTINUE
         IF (T .GT. ANORM) ANORM = T
   10 CONTINUE
C
C     GAUSSIAN ELIMINATION WITH PARTIAL PIVOTING
C
      DO 35 K = 1,NM1
         KP1= K+1
C
C        FIND PIVOT
C
         M = K
         DO 15 I = KP1,N
            IF (ABS(A(I,K)) .GT. ABS(A(M,K))) M = I
   15    CONTINUE
         IPVT(K) = M
         IF (M .NE. K) IPVT(N) = -IPVT(N)
         T = A(M,K)
         A(M,K) = A(K,K)
         A(K,K) = T
C
C        SKIP STEP IF PIVOT IS ZERO
C
         IF (T .EQ. 0.0) GO TO 35
C
C        COMPUTE MULTIPLIERS
C
         DO 20 I = KP1,N
             A(I,K) = -A(I,K)/T
   20    CONTINUE
C
C        INTERCHANGE AND ELIMINATE BY COLUMNS
C
         DO 30 J = KP1,N
             T = A(M,J)
             A(M,J) = A(K,J)
             A(K,J) = T
             IF (T .EQ. 0.0) GO TO 30
             DO 25 I = KP1,N
                A(I,J) = A(I,J) + A(I,K)*T
   25        CONTINUE
   30    CONTINUE
   35 CONTINUE
C
C     COND = (1-NORM OF A)*(AN ESTIMATE OF 1-NORM OF A-INVERSE)
C     ESTIMATE OBTAINED BY ONE STEP OF INVERSE ITERATION FOR THE
C     SMALL SINGULAR VECTOR.  THIS INVOLVES SOLVING TWO SYSTEMS
C     OF EQUATIONS, (A-TRANSPOSE)*Y = E  AND  A*Z = Y  WHERE  E
C     IS A VECTOR OF +1 OR -1 CHOSEN TO CAUSE GROWTH IN Y.
C     ESTIMATE = (1-NORM OF Z)/(1-NORM OF Y)
C
C     SOLVE (A-TRANSPOSE)*Y = E
C
      DO 50 K = 1, N
         T = 0.0
         IF (K .EQ. 1) GO TO 45
         KM1 = K-1
         DO 40 I = 1, KM1
            T = T + A(I,K)*WORK(I)
   40    CONTINUE
   45    EK = 1.0
         IF (T .LT. 0.0) EK = -1.0
         IF (A(K,K) .EQ. 0.0) GO TO 90
         WORK(K) = -(EK + T)/A(K,K)
   50 CONTINUE
      DO 60 KB = 1, NM1
         K = N - KB
         T = 0.0
         KP1 = K+1
         DO 55 I = KP1, N
            T = T + A(I,K)*WORK(K)
   55    CONTINUE
         WORK(K) = T
         M = IPVT(K)
         IF (M .EQ. K) GO TO 60
         T = WORK(M)
         WORK(M) = WORK(K)
         WORK(K) = T
   60 CONTINUE
C
      YNORM = 0.0
      DO 65 I = 1, N
         YNORM = YNORM + ABS(WORK(I))
   65 CONTINUE
C
C     SOLVE A*Z = Y
C
      CALL SOLVE(NDIM, N, A, WORK, IPVT)
C
      ZNORM = 0.0
      DO 70 I = 1, N
         ZNORM = ZNORM + ABS(WORK(I))
   70 CONTINUE
C
C     ESTIMATE CONDITION
C
      COND = ANORM*ZNORM/YNORM
      IF (COND .LT. 1.0) COND = 1.0
      RETURN
C
C     1-BY-1
C
   80 COND = 1.0
      IF (A(1,1) .NE. 0.0) RETURN
C
C     EXACT SINGULARITY
C
   90 COND = 1.0E+32
      RETURN
      END
      SUBROUTINE SOLVE(NDIM, N, A, B, IPVT)
C
      INTEGER NDIM, N, IPVT(N)
      REAL A(NDIM,N),B(N)
C
C   SOLUTION OF LINEAR SYSTEM, A*X = B .
C   DO NOT USE IF DECOMP HAS DETECTED SINGULARITY.
C
C   INPUT..
C
C     NDIM = DECLARED ROW DIMENSION OF ARRAY CONTAINING A .
C
C     N = ORDER OF MATRIX.
C
C     A = TRIANGULARIZED MATRIX OBTAINED FROM DECOMP .
C
C     B = RIGHT HAND SIDE VECTOR.
C
C     IPVT = PIVOT VECTOR OBTAINED FROM DECOMP .
C
C   OUTPUT..
C
C     B = SOLUTION VECTOR, X .
C
      INTEGER KB, KM1, NM1, KP1, I, K, M
      REAL T
C
C     FORWARD ELIMINATION
C
      IF (N .EQ. 1) GO TO 50
      NM1 = N-1
      DO 20 K = 1, NM1
         KP1 = K+1
         M = IPVT(K)
         T = B(M)
         B(M) = B(K)
         B(K) = T
         DO 10 I = KP1, N
             B(I) = B(I) + A(I,K)*T
   10    CONTINUE
   20 CONTINUE
C
C     BACK SUBSTITUTION
C
      DO 40 KB = 1,NM1
         KM1 = N-KB
         K = KM1+1
         B(K) = B(K)/A(K,K)
         T = -B(K)
         DO 30 I = 1, KM1
             B(I) = B(I) + A(I,K)*T
   30    CONTINUE
   40 CONTINUE
   50 B(1) = B(1)/A(1,1)
      RETURN
      END
CARNAHAN, B., ET AL, DIGITAL COMPUTING AND NUM METHODS, WILEY, PP377-378
0.        10.0      1.0
    6 1000    1    1  REL 0.001
CARNAHAN, B., ET AL, DIGITAL COMPUTING AND NUM METHODS, WILEY, PP377-378
0.        10.0      1.0
    6 1000    1    1  REL 0.001
END OF RUNS
*APP MATH03
      SUBROUTINE INITAL
C...
C...  THE QUASI STEADY STATE APPROXIMATION
C...
C...  THE QUASI STEADY STATE APPROXIMATION IS A COMPUTATIONAL PROCEDURE
C...  IN WHICH THE DERIVATIVES OF SELECTED ORDINARY DIFFERENTIAL EQUA-
C...  TIONS (ODES) IN A SET OF ODES ARE SET TO ZERO.  THUS, THESE SE-
C...  LECTED ODES ARE CONVERTED TO ALGEBRAIC EQUATIONS, WHICH ARE THEN
C...  SOLVED ALONG WITH THE REMAINING ODES.
C...
C...  THE CHOICE OF WHICH DERIVATIVES TO SET TO ZERO IS MADE LARGELY
C...  ON PHYSICAL GROUNDS, E.G. THE ZEROED DERIVATIVES ARE FOR SO-CALLED
C...  FAST ODES, FOR WHICH THE DEPENDENT VARIABLES ARE ESSENTIALLY AT
C...  A STEADY STATE CONDITION THROUGHOUT THE ENTIRE SOLUTION OF THE
C...  ODE SYSTEM.  THE ARGUMENT IS SIMPLY THAT IF THESE DEPENDENT VARI-
C...  ABLES ESSENTIALLY ALWAYS HAVE AN INSTANTANEOUS STEADY STATE VALUE,
C...  THEY MAY AS WELL BE COMPUTED FROM STEADY STATE EQUATIONS, I.E.,
C...  ODES FOR WHICH THE DERIVATIVES HAVE BEEN SET TO ZERO.
C...
C...  THE MOST COMMON REASON ADVANCED FOR USING THE QUASI STEADY STATE
C...  APPROXIMATION IS THAT IT CAN REDUCE THE TOTAL NUMBER OF ODES, AND
C...  FURTHER, IT ELIMINATES THE FAST ODES SO THAT THE NUMERICAL INTE-
C...  GRATION OF THE REMAINING ODES IS FACILITATED.  IT IS NOT CLEAR
C...  WHETHER THE QUASI STEADY STATE APPROXIMATION DOES IN FACT FACILI-
C...  TATE THE SOLUTION OF THE ORIGINAL ODE MODEL SINCE THE CURRENT
C...  STATE-OF-THE-ART ODE INTEGRATORS CAN EASILY ACCOMMODATE LARGE
C...  SETS OF ODES WITH SLOW AND FAST EQUATIONS WHICH ARE, LOOSELY
C...  SPEAKING, CALLED STIFF ODE SYSTEMS.
C...
C...  IN ANY CASE, THE FOLLOWING EXAMPLE ILLUSTRATES HOW THE QUASI
C...  STEADY STATE APPROXIMATION IS USED.  THE PROBLEM IS FIRST SOLVED
C...  WITH TWO ODES (THE FULL SET OF ODES), AND THEN IS SOLVED WITH ONE
C...  OF THE TWO ODES CONVERTED TO AN ALGEBRAIC EQUATION BY SETTING THE
C...  DERIVATIVE TO ZERO.  THUS, A COMPARISON OF THE TWO SOLUTIONS GIVES
C...  A DIRECT INDICATION OF THE EFFECT OF THE QUASI STEADY STATE APPRO-
C...  XIMATION ON THE SOLUTION.
C...
C...  THE PHYSICAL PROBLEM INVOLVES THE DRAINAGE OF A CYLINDRICAL TANK
C...  THROUGH A PIPE CONNECTED TO THE BOTTOM OF THE TANK.  A MATHEMATI-
C...  CAL MODEL FOR THE TANK IS DERIVED AS FOLLOWS
C...
C...  MASS BALANCE ON THE LIQUID IN THE TANK
C...
C...     D(RHO*AT*H)/DT = 0 - (-V)*AP*RHO                          (1)
C...
C...  WHERE
C...
C...     H       HEIGHT OF LIQUID IN THE TANK (CM)
C...
C...     T       TIME (SEC)
C...
C...     AT      TANK CROSS SECTIONAL AREA (CM**2)
C...
C...     RHO     LIQUID DENSITY (GM/CM**3)
C...
C...     V       VELOCITY OF LIQUID IN THE PIPE (CM/SEC)
C...
C...     AP      PIPE CROSS SECTIONAL AREA (CM**2)
C...
C...  MOMENTUM BALANCE ON THE LIQUID IN THE PIPE (NEWTON*S SECOND LAW),
C...  ASSUMING AN INCOMPRESSIBLE LIQUID
C...
C...     (1/GC)*D(L*AP*RHO*V)/DT = -(PA + (G/GC)*RHO*H)*AP
C...                                                               (2)
C...                               -(1/GC)*L*AP*RHO*G + PA*AP + FF
C...
C...     GC      CONVERSION FACTOR BETWEEN FORCE AND MASS = 1 GM-CM/
C...             DYNE-SEC**2
C...
C...     L       PIPE LENGTH (CM)
C...
C...     PA      ATMOSPHERIC PRESSURE (DYNES/CM**2)
C...
C...     G       ACCELERATION OF GRAVITY = 980 CM/SEC**2
C...
C...     FF      FRICTIONAL FORCE = F*RHO*(V**2)*L*AP/(2*DP*GC) (DYNES)
C...
C...     F       FRICTION FACTOR (A FUNCTION OF THE REYNOLDS NUMBER, RE)
C...             (DIMENSIONLESS)
C...
C...     RE      REYNOLDS NUMBER = DP*V*RHO/VIS (DIMENSIONLESS)
C...
C...     VIS  DLIQUID VISCOSITY (GM/CM-SEC)
C...
C...  IF THE CONSTANTS ARE DIVIDED OUT OF THE DERIVATIVE OF EQUATION
C...  (1), THE RESULTING EQUATION (WITH AN INITIAL CONDITION) IS
C...
C...     DH/DT = (AP/AT)*V, H(0) = H0                              (3)
C...
C...  IF THE CONSTANTS ARE DIVIDED OUT OF THE DERIVATIVE OF EQUATION
C...  (2), THE RESULTING EQUATION (WITH AN INITIAL CONDITION) IS
C...
C...  DV/DT = -G*(1 + H/L) + (F*V**2)/(2*DP), V(0) = V0            (4)
C...
C...  THE FRICTION FACTOR CORRELATIONS ARE
C...
C...  F = 64/RE, 0 LE RE LE 2000, F = 0.189/RE**0.2, RE GT 2000
C...
C...  EQUATIONS (3) AND (4) ARE THE FULL (TWO) ODE MODEL.  THE EFFLUX
C...  TIME (THE TIME FOR THE TANK TO DRAIN) IS COMPUTED FOR THE FOLLOW-
C...  ING CASES
C...
C...     (A)  DP = 0.5 CM, DV/DT NE 0
C...
C...     (B)  DP = 1.0 CM, DV/DT NE 0
C...
C...     (C)  DP = 0.5 CM, DV/DT = 0
C...
C...     (D)  DP = 1.0 CM, DV/DT = 0
C...
C...  THE LIQUID IS WATER AT ROOM TEMPERATURE.  THE OTHER MODEL PARA-
C...  METERS ARE - TANK DIAMETER = 25 CM, PIPE LENGTH = 1 METER, H(0) =
C...  50 CM, V(0) = 0.  THE NUMERICAL VALUES OF THESE PARAMETERS ARE
C...  SET BELOW.
C...
      COMMON/T/      T,   NFIN,  NORUN
     1      /Y/      H,      V
     2      /F/   DHDT,   DVDT
     3      /C/     AP,     AT,      G,      L,     DP,    RHO,    VIS,
     4              RE,      F,     FF,     IP
      REAL           L
C...
C...  SET THE MODEL PARAMETERS
      PI=4.*ATAN(1.)
      DT=25.
      AT=PI*(DT**2)/4.
      G=980.
      L=100.
      RHO=1.
      VIS=0.01
      IF(NORUN.EQ.1)DP=0.5
      IF(NORUN.EQ.2)DP=1.0
      IF(NORUN.EQ.3)DP=0.5
      IF(NORUN.EQ.4)DP=1.0
      AP=PI*(DP**2)/4.
C...
C...  SET THE MODEL INITIAL CONDITIONS
      H=50.
      V=0.
C...
C...  INITIALIZE A COUNTER FOR USE IN SUBROUTINE PRINT
      IP=0
C...
C...  COMPUTE THE INITIAL DERIVATIVES
      IF(NORUN.GT.2)GO TO 1
      CALL DERV
      RETURN
C...
C...  FOR THE RUNS USING THE QUASI STEADY STATE APPROXIMATION, SET AN
C...  ESTIMATE OF THE FRICTION FACTOR (WHICH IS THEN UPDATED OR CORRECT-
C...  ED IN SUBROUTINE DERV) AND ZERO THE DERIVATIVE DV/DT (SO THAT IT
C...  IS NOT PRINTED AS A NONZERO VALUE REMAINING FROM THE RUNS WITH
C...  DV/DT NE 0)
1     F=0.03
      DVDT=0.
      CALL DERV
      RETURN
      END
      SUBROUTINE DERV
      COMMON/T/      T,   NFIN,  NORUN
C...
C...  MODEL WITH DV/DT NE 0
      IF(NORUN.LE.2)CALL DERV1
C...
C...  MODEL WITH DV/DT = 0
      IF(NORUN.GT.2)CALL DERV2
      RETURN
      END
      SUBROUTINE DERV1
      COMMON/T/      T,   NFIN,  NORUN
     1      /Y/      H,      V
     2      /F/   DHDT,   DVDT
     3      /C/     AP,     AT,      G,      L,     DP,    RHO,    VIS,
     4              RE,      F,     FF,     IP
      REAL           L
C...
C...  MODEL WITH FULL (TWO) ODE SYSTEM
C...
C...  IF THE VELOCITY IS ZERO, THE FRICTION TERM IS ZERO
      RE=0.
      F=0.
      FF=0.
      IF(ABS(V).LT.1.0E-04)GO TO 1
C...
C...  REYNOLDS NUMBER
      RE=DP*ABS(V)*RHO/VIS
C...
C...  SELECT THE EQUATION FOR THE FRICTION FACTOR
      IF(RE.LE.2000)F=64./RE
      IF(RE.GT.2000)F=0.189/RE**0.2
C...
C...  FRICTION TERM FOR NONZERO VELOCITY
      FF=F*(V**2)/(2.*DP)
C...
C...  DIFFERENTIAL EQUATIONS
1     DHDT=(AP/AT)*V
      DVDT=-G*(1.+H/L)+FF
C...
C...  TEST IF THE TANK HAS DRAINED
      IF(H.LE.0.)NFIN=1
      RETURN
      END
      SUBROUTINE DERV2
      COMMON/T/      T,   NFIN,  NORUN
     1      /Y/      H,      V
     2      /F/   DHDT,   DVDT
     3      /C/     AP,     AT,      G,      L,     DP,    RHO,    VIS,
     4              RE,      F,     FF,     IP
      REAL           L
      COMMON/IO/    NI,     NO
C...
C...  MODEL WITH QUASI STEADY STATE APPROXIMATION
C...
C...  COMPUTE THE VELOCITY ITERATIVELY BY ALGEBRAIC EQUATIONS (RATHER
C...  THAN VIA A DIFFERENTIAL EQUATION AS IN THE PRECEDING CODING)
C...
C...  BEGIN THE ITERATIVE CALCULATION OF THE VELOCITY
      ITER=0
C...
C...  UPDATE THE VELOCITY IN THE ITERATIVE CALCULATION OF THE VELOCITY
1     VOLD=V
      V=-SQRT(2.*DP*G*(1.+H/L)/F)
C...
C...  CHECK FOR CONVERGENCE OF THE VELOCITY CALCULATION
      IF(ABS(V-VOLD).LT.1.)GO TO 2
C...
C...  UPDATE THE FRICTION FACTOR
      RE=DP*ABS(V)*RHO/VIS
      IF(RE.LE.2000.)F=64./RE
      IF(RE.GT.2000.)F=0.189/RE**0.2
C...
C...  CHECK FOR LACK OF CONVERGENCE
      ITER=ITER+1
      IF(ITER.LT.100)GO TO 1
C...
C...  PRINT AN ERROR MESSAGE THAT THE ITERATION HAS NOT CONVERGED
C...  AND GO ON TO THE NEXT RUN
      WRITE(NO,3)ITER
3     FORMAT(1H ,//,36H CONVERGENCE OF V NOT ACHIEVED AFTER,I5,
     1              11H ITERATIONS)
      NFIN=1
      RETURN
C...
C...  CONTINUE THE CALCULATIONS WITH THE NEW VELOCITY
2     DHDT=(AP/AT)*V
C...
C...  COMPUTE THE FRICTION FORCE TERM SO THAT IT CAN BE PRINTED IN
C...  SUBROUTINE PRINT
      FF=F*(V**2)/(2.*DP)
C...
C...  TEST IF THE TANK HAS DRAINED
      IF(H.LE.0.)NFIN=1
      RETURN
      END
      SUBROUTINE PRINT(NI,NO)
      COMMON/T/      T,   NFIN,  NORUN
     1      /Y/      H,      V
     2      /F/   DHDT,   DVDT
     3      /C/     AP,     AT,      G,      L,     DP,    RHO,    VIS,
     4              RE,      F,     FF,     IP
      REAL           L
C...
C...  PRINT A HEADING FOR THE NUMERICAL SOLUTION
      IF(IP.EQ.0)WRITE(NO,1)
1     FORMAT(9X,1HT,9X,1HH,9X,1HV,5X,5HDH/DT,5X,5HDV/DT,
     1       8X,2HRE,9X,1HF,8X,2HFF)
C...
C...  PRINT THE SOLUTION
      WRITE(NO,2)T,H,V,DHDT,DVDT,RE,F,FF
2     FORMAT(F10.1,F10.3,F10.2,F10.4,F10.2,F10.0,F10.4,F10.1)
      IP=IP+1
      RETURN
      END
THE QUASI STEADY STATE APPROXIMATION, DV/DT NE 0, DP = 0.5
0.        1000.     100.
    2 1000    1    1  REL 0.001
THE QUASI STEADY STATE APPROXIMATION, DV/DT NE 0, DP = 1.0
0.        200.      20.
    2 1000    1    1  REL 0.001
THE QUASI STEADY STATE APPROXIMATION, DV/DT = 0, DP = 0.5
0.        1000.     100.
    1 1000    1    1  REL 0.001
THE QUASI STEADY STATE APPROXIMATION, DV/DT = 0, DP = 1.0
0.        200.      20.
    1 1000    1    1  REL 0.001
END OF RUNS
*APP MATH04
      SUBROUTINE INITAL
C...
C...  MULTIPLE STEADY STATES OF A NONLINEAR DISTRIBUTED (PDE) SYSTEM
C...
C...  CONSIDER THE HEATING OF A SOLID IN WHICH AN EXOTHERMIC REACTION
C...  TAKES PLACE.  A STEADY STATE ENERGY BALANCE ON A SECTION OF THE
C...  SOLID OF THICKNESS OF DX GIVES:
C...
C...     A*Q(X) - A*Q(X+DX) = HR*A*DX*RHO*K0*EXP(-E/(R*T))
C...
C...  WHERE
C...
C...     Q       HEAT FLUX BY CONDUCTION (CAL/CM**2-SEC)
C...
C...     T       ABSOLUTE TEMPERATURE (K)
C...
C...     X       DISTANCE ALONG THE SOLID (CM)
C...
C...     A       CROSS SECTIONAL AREA OF THE SECTION (CM**2)
C...
C...     HR      HEAT OF REACTION (CAL/GM)
C...
C...     RHO     DENSITY (GM/CM**3)
C...
C...     K0      PRE-EXPONENTIAL FACTOR (1/SEC)
C...
C...     E       ACTIVATION ENERGY (CAL/GM MOL)
C...
C...     R       GAS CONSTANT (CAL/GM MOL-K)
C...
C...  DIVISION BY A*DX, FOLLOWED BY DX ---> 0 GIVES
C...
C...     -Q  = HR*RHO*K0*EXP(-E/*R*T))                          (1)
C...       X
C...
C...  WHERE A LETTER SUBSCRIPT DENOTES A DERIVATIVE, E.G., Q  = DQ/DX.
C...                                                        X
C...
C...  EQUATION (1) CONTAINS TWO DEPENDENT VARIABLES, Q AND T, SO THAT
C...  A SECOND EQUATION IS REQUIRED
C...
C...     Q = -K*T                                               (2)
C...             X
C...
C...  EQUATION (2) IS FOURIER'S FIRST LAW.  SUBSTUTION OF EQUATION (2)
C...  IN (1) GIVES
C...
C...     T   = (HR*RHO/K)*K0*EXP(-E/(R*T))                      (3)
C...      XX
C...
C...  EQUATION (3) IS A NONLINEAR, BOUNDARY VALUE ORDINARY DIFFERENTIAL
C...  EQUATION, WHICH WILL BE INTEGRATED NUMERICALLY SUBJECT TO THE TWO
C...  BOUNDARY CONDITIONS
C...
C...     T(0) = TA, T (L) = 0                                (4)(5)
C...                 X
C...
C...     TA      AMBIENT TEMPERATURE (K)
C...
C...     L       LENGTH OF THE SOLID (CM)
C...
C...  IF THE SECOND DERIVATIVE IN EQUATION (3) IS REPLACED WITH A SECOND
C...  ORDER APPROXIMATION
C...
C...     T   = (T(I+1) - 2*T(I) + T(I-1))/DX**2
C...      XX
C...
C...  EQUATION (3) BECOMES
C...
C...     (T(I+1) - 2*T(I) + T(I-1))/DX**2 - D*EXP(-E/(R*T(I)) = 0    (6)
C...
C...  WHERE
C...
C...     D       HR*RHO*K0/K (K/CM**2)
C...
C...     DX      GRID SPACING (CM)
C...
C...  IF EQUATION (6) IS NOW WRITTEN FOR THE N+1 GRID POINTS, I = 0,
C...  1, 2,..., N, A SYSTEM OF NONLINEAR TRIDIAGONAL TRANSCENDENTAL
C...  EQUATIONS RESULTS, WHICH CAN BE APPROXIMATED BY LINEAR FUNCTIONS
C...  AS EXPLAINED IN CLASS.
C...
C...  COMPUTE A SOLUTION TO THE NONLINEAR PROBLEM, I.E., T(X), USING
C...  LEQT1B, FOR:
C...
C...     HR = -10000 CAL/GM, RHO = 1 GM/CM**3, K0 = 30.0 (1/SEC)
C...
C...     K = 0.01 CAL-CM/SEC-CM**2-K, E = 10000 CAL/GM MOL, R =
C...
C...     CAL/GM MOL-K, TA = 350 K, L = 1 CM
C...
C...  (6) IS A SET OF NONLINEAR, TRIDIAGONAL TRANSCENDENTAL EQUATIONS.
C...  WE WILL COMPUTE A SOLUTION BY NEWTON'S METHOD, WHICH IS ALSO
C...  CALLED QUASILINEARIZATION.  IF THE NONLINEAR EXPONENTIAL TERM
C...  IS EXPANDED IN A TAYLOR SERIES
C...
C...                   K+1                  K
C...     EXP(-E/(R*T(I)   ) = EXP(-E/(R*T(I) )) +
C...
C...                                          K            K+1       K
C...                        + D(EXP(-E/(R*T(I) )))/DT*(T(I)    - T(I) )
C...
C...                                          K+1
C...                        = A(I) + B(I)*T(I)    + C(I)
C...
C...  WHERE
C...
C...     K       ITERATION COUNTER
C...
C...                           K
C...     A(I)    EXP(-E/(R*T(I) ))
C...
C...                             K
C...     B(I)    D(EXP(-E/(R*T(I) )))/DT =
C...
C...                           K
C...             EXP(-E/(R*T(I) ))*(E/(R*T(I)**2))
C...
C...                        K
C...     C(I)    B(I)*(-T(I) )
C...
C...  THEN EQUATIONS (6) CAN BE WRITTEN IN APPROXIMATE LINEAR FORM AS
C...  (WITH THE ITERATION COUNTER K DROPPED)
C...
C...     - (2 + (DX**2)*D*B(1))*T(1) + T(2) =
C...
C...          - TA + (DX**2)*D*(A(1) + C(1))
C...
C...     T(1) - (2 + (DX**2)*D*B(2))*T(2) + T(3) =
C...
C...                (DX**2)*D*(A(2) + C(2))
C...       .                                      .
C...       .                                      .             (7)
C...       .                                      .
C...
C...     T(N-2) - (2 + (DX**2)*D*B(N-1))*T(N-1) + T(N) =
C...
C...                (DX**2)*D*(A(N-1) + C(N-1))
C...
C...     2*T(N-1) - (2 + (DX**2)*D*B(N))*T(N) =
C...
C...                (DX**2)*D*(A(N) + C(N))
C...
C...  NOTE THAT A, B AND C IN EACH EQUATION ARE FUNCTIONS OF I, AND
C...  THEREFORE MUST BE EVALUATED FOR EACH EQUATION.
C...
C...  (7) IS A SET OF LINEAR, TRIDIAGONAL ALGEBRAIC EQUATIONS WHICH
C...  CAN BE SOLVED BY A BANDED SOLVER.  IT WILL BE NECESSARY TO ASSUME
C...  A TRIAL SOLUTION FOR ITERATION K = 0.  THEN (7) CAN BE SOLVED
C...  FOR THE K = 1 SOLUTION, AND THIS SOLUTION CAN BE USED IN PLACE OF
C...  THE ASSUMED K = 0 SOLUTION TO COMPUTE THE K = 2 SOLUTION, ETC.,
C...  UNTIL CONVERGENCE IS ACHIEVED.
C...
C...  TWO SOLUTIONS TO EQUATION (3) ARE COMPUTED BY THIS METHOD FOR
C...  N = 10 AND N = 20.  SOLUTIONS ARE ALSO COMPUTED BY IMSL ROUTINE
C...  ZSPOW WHICH CAN ACCEPT THE NONLINEAR EQUATIONS (EQUATIONS (6))
C...  DIRECTLY.
C...
C...  A SECOND APPROACH TO THE SOLUTION OF EQUATION (3) IS TO CONVERT
C...  IT TO A TRANSIENT (TIME DEPENDENT) EQUATION BY ADDING A TIME
C...  DERIVATIVE
C...
C...     RHO*CP*T   = K*T   - (HR*RHO)*K0*EXP(-E/(R*T))       (8)
C...             TM      XX
C...
C...  WHICH CAN BE INTEGRATED UNTIL THE TIME DERIVATIVE, T  ---+ 0.
C...                                                      TM
C...  THIS APPROACH, WHICH IS ALSO IMPLEMENTED IN THE FOLLOWING
C...  CODING, IS CALLED THE METHOD OF FALSE TRANSIENTS.
C...
C...  INPUT/OUTPUT (I/O) UNIT NUMBERS ARE IN COMMON/IO/
      COMMON/IO/ NI, NO
C...
C...  DSS/2 COMMON AREA
      COMMON/T/   TIME,  NSTOP,  NORUN
     1      /Y/ TC(21)
     2      /F/ TT(21)
     3      /S/ TX(21),TXX(21)
     4      /C/      N,     IP
C...
C...  COMMON AREA FOR ACCESS IN FUNCTIONS AND SUBROUTINES USED BY
C...  LEQT1B, ZSPOW, AND THE USUAL DSS/2 SUBROUTINES (INITAL, DERV,
C...  PRINT)
      COMMON/C1/ T0(20), D, E, R, DXS, TA, DF
C...
C...  DIMENSION THE ARRAYS REQUIRED BY SUBROUTINE LEQT1B
      DIMENSION ABSM(20,3), BRHS(20), XL(40), X(20), II(20)
C...
C...  DIMENSION THE ARRAYS REQUIRED BY SUBROUTINE ZSPOW
      DIMENSION T(20), F(20), WK(750), PAR(1)
C...
C...  EXTERNAL THE ROUTINE CALLED BY ZSPOW TO EVALUATE THE FUNCTIONS
      EXTERNAL FCN
C...
C...  REAL SELECTED VARIABLES
      REAL K0, K, L
C...
C...  SET THE MODEL PARAMETERS
      HR=-10000.
      RHO=1.0
      CP=1.0
      K0=30.0
      K=0.01
      E=10000.
      R=1.987
      TA=350.
      L=1.
C...
C...  STEP THROUGH TWO CASES
      DO 7 NCASE=1,2
C...
C...  FOR THE FIRST CASE, N = 10
      IF(NCASE.EQ.1)N=10
C...
C...  FOR THE SECOND CASE, N = 20
      IF(NCASE.EQ.2)N=20
C...
C...  ****************************************************************
C...
C...  COMPUTE A SOLUTION BY IMSL ROUTINE LEQT1B USING QUASILINEARIZATION
C...
C...  CONSTANT D IN EQUATIONS (7)
      D=HR*RHO*K0/K
C...
C...  GRID SPACING AND ITS SQUARE
      DX=L/FLOAT(N)
      DXS=DX*DX
C...
C...  DEFINE THE INITIAL TRIAL SOLUTION, SPATIAL GRID AND INDEX
      DO 6 I=1,N
      T0(I)=400.
      X(I)=DX*FLOAT(I)
      II(I)=I
6     CONTINUE
C...
C...  STEP THROUGH A SERIES OF ITERATIONS
      DO 8 ITER=1,100
C...
C...  SET UP THE COEFFICIENT MATRIX IN BAND STORAGE MODE (STORED IN
C...  ABSM)                            -    -       -
C...
C...  LOWER DIAGONAL
      DO 1 I=1,N
      IF(I.EQ.1)ABSM(1,1)=0.
      IF((I.GT.1).AND.(I.LT.N))ABSM(I,1)=1.0
      IF(I.EQ.N)ABSM(N,1)=2.0
1     CONTINUE
C...
C...  MAIN DIAGONAL
      DO 2 I=1,N
      ABSM(I,2)=-(2.0+DXS*D*B(I))
2     CONTINUE
C...
C...  UPPER DIAGONAL
      DO 3 I=1,N
      IF(I.NE.N)ABSM(I,3)=1.0
      IF(I.EQ.N)ABSM(N,3)=0.
3     CONTINUE
C...
C...  RIGHT HAND SIDE VECTOR
      DO 4 I=1,N
      IF(I.EQ.1)BRHS(1)=-TA+DXS*D*(A(I)+C(I))
      IF(I.NE.1)BRHS(I)=   +DXS*D*(A(I)+C(I))
4     CONTINUE
C...
C...  INPUT PARAMETERS FOR SUBROUTINE LEQT1B
      NLC=1
      NUC=1
      IA=20
      M=1
      IB=20
      IJOB=0
C...
C...  SOLVE THE LINEAR ALGEBRAIC EQUATIONS BY IMSL SUBROUTINE LEQT1B
      CALL LEQT1B(ABSM,N,NLC,NUC,IA,BRHS,M,IB,IJOB,XL,IER)
C...
C...  CHECK FOR CONVERGENCE
      DO 9 I=1,N
      IF(ABS(BRHS(I)-T0(I)).GT.0.001)GO TO 10
9     CONTINUE
C...
C...  CONVERGENCE HAS BEEN ACHIEVED, SO PRINT THE SOLUTION VECTOR
      WRITE(NO,5)N,ITER,IER,(II(I),X(I),BRHS(I),I=1,N)
5     FORMAT(1H ,//,
     1 ' N = ',I5,3X,' ITER = ',I5,3X,' IER = ',I5,//,
     2 9X,'I',9X,'X',11X,'T(X)',/,(I10,F10.3,F15.4))
      GO TO 12
C...
C...  CONVERGENCE HAS NOT BEEN ACHIEVED, SO CONTINUE THE ITERATIONS
10    DO 11 I=1,N
      T0(I)=BRHS(I)
11    CONTINUE
C...
C...  GO ON TO THE NEXT ITERATION
8     CONTINUE
C...
C...  ****************************************************************
C...
C...  COMPUTE A SOLUTION BY IMSL ROUTINE ZSPOW
C...
C...  DEFINE THE PARAMETERS FOR ZSPOW
12    NSIG=4
      ITMAX=200
C...
C...  SET THE INITIAL ESTIMATE OF THE SOLUTION
      DO 100 I=1,N
      T(I)=400.0
100   CONTINUE
C...
C...  CALL SUBROUTINE ZSPOW TO COMPUTE A SOLUTION TO EQUATION (6)
      CALL ZSPOW(FCN,NSIG,N,ITMAX,PAR,T,FNORM,WK,IER)
C...
C...  PRINT THE SOLUTION
      WRITE(NO,101)N,FNORM,IER,(II(I),X(I),T(I),I=1,N)
101   FORMAT(1H ,//,
     1 ' N = ',I5,3X,' FNORM = ',E11.3,3X,' IER = ',I5,//,
     2 9X,'I',9X,'X',11X,'T(X)',/,(I10,F10.3,F15.4))
C...
C...  GO ON TO THE NEXT CASE
7     CONTINUE
C...
C...  ****************************************************************
C...
C...  COMPUTE A SOLUTION BY THE METHOD OF FALSE TRANSIENTS
C...
C...  INITIAL CONDITIONS
      N=21
      TC(1)=TA
      DO 102 I=2,N
C...
C...     CASE 1 (NORUN = 1), UNIFORM TEMPERATURE.  THIS INITIAL CONDI-
C...     GIVES A FINAL (STEADY STATE SOLUTION) WHICH IS SIGNIFICANTLY
C...     DIFFERENT THAN THE SOLUTION BY QUASILINEARIZATION
         IF(NORUN.EQ.1)TC(I)=400.
C...
C...     CASE 2 (NORUN = 2), TEMPERATURES FROM QUASILINEARIZATION.  THIS
C...     SOLUTION DOES NOT REMAIN AT THE QUASILINEARIZATION SOLUTION,
C...     BUT RATHER, CONVERGES TO THE SOLUTION OF CASE 1.  THIS INDICATES
C...     AN APPARENT INSTABILITY IN THE QUASILINEARIZATION SOLUTION,
C...     SO THAT THIS SOLUTION MOVES TO ANOTHER STABLE SOLUTION.  THUS,
C...     WE HAVE THE EVIDENCE FOR MULTIPLE STEADY STATE SOLUTIONS TO
C...     EQUATION (8), BOTH STABLE AND UNSTABLE.
C...
C...     FINALLY, IF THE INITIAL ESTIMATE OF THE SOLUTION IS CHANGED
C...     TO 350 (RATHER THAN 400), ALL THREE APPROACHES (LEQT1B, ZSPOW
C...     AND THE METHOD OF LINES) CONVERGE TO THE SAME SOLUTION (TO
C...     WITHIN 1 PART IN 1.0E+05).  THIS CAN EASILY BE VERIFIED BY
C...     USING AN EDITOR TO CHANGE =400 TO =350 IN THE THREE PRECEDING
C...     STATEMENTS
C...
C...                            T0(I)=400.
C...                            (FOR LEQT1B)
C...
C...                            T(I)=400.
C...                            (FOR ZSPOW)
C...
C...                            IF(NORUN.EQ.1)TC(I)=400.
C...                            (FOR THE METHOD OF LINES)
C...
C...     THIS RESULT (THE SAME SOLUTIONS FOR AN INITIAL ESTIMATE OF
C...     350 AND DIFFERENT SOLUTIONS FOR AN INITIAL ESTIMATE OF 400,
C...     WITH THE LATTER PRODUCING AN UNSTABLE SOLUTION BY LEQT1B AND
C...     AND SUBROUTINE ZSPOW) GIVES SOME INDICATION OF THE INTERESTING
C...     AND FREQUENTLY UNPREDICTABLE PROPERTIES OF NONLINEAR SYSTEMS.
C...     ON THE OTHER HAND, WELL-CONDITIONED LINEAR PROBLEMS GENERALLY
C...     HAVE UNIQUE AND PREDICTABLE SOLUTIONS.
C...
         IF(NORUN.EQ.2)TC(I)=BRHS(I-1)
102   CONTINUE
C...
C...  RECOMPUTE CONSTANT D TO INCLUDE CP
      D=D*K/(RHO*CP)
C...
C...  THERMAL DIFFUSIVITY
      DF=K/(RHO*CP)
C...
C...  INITIAL DERIVATIVES
      CALL DERV
      IP=0
      END
      FUNCTION A(I)
C...
C...  FUNCTION A COMPUTES THE FIRST TERM IN THE LINEAR APPROXIMATION
C...  OF EXP(-E/(R*T)) AS DISCUSSED PREVIOUSLY
C...
      COMMON/C1/ T0(20), D, E, R, DXS, TA, DF
      A=EXP(-E/(R*T0(I)))
      RETURN
      END
      FUNCTION B(I)
C...
C...  FUNCTION B COMPUTES THE SECOND TERM IN THE LINEAR APPROXIMATION
C...  OF EXP(-E/(R*T)) AS DISCUSSED PREVIOUSLY
C...
      COMMON/C1/ T0(20), D, E, R, DXS, TA, DF
      B=A(I)*(E/(R*(T0(I)**2)))
      RETURN
      END
      FUNCTION C(I)
C...
C...  FUNCTION C COMPUTES THE THIRD TERM IN THE LINEAR APPROXIMATION
C...  OF EXP(-E/(R*T)) AS DISCUSSED PREVIOUSLY
C...
      COMMON/C1/ T0(20), D, E, R, DXS, TA, DF
      C=B(I)*(-T0(I))
      RETURN
      END
      SUBROUTINE FCN(T,F,N,PAR)
C...
C...  SUBROUTINE IMPLEMENTS THE NONLINEAR EQUATIONS
C...
      COMMON/C1/ T0(20), D, E, R, DXS, TA, DF
C...
C...  DIMENSION THE ARRAYS USED BY FCN
      DIMENSION T(N), F(N), PAR(1)
C...
C...  IMPLEMENT THE NONLINEAR EQUATIONS
      DO 1 I=1,N
      IF(I.EQ.1)THEN
         F(1)=(T(2)-2.0*T(1)+TA)/DXS-D*EXP(-E/(R*T(1)))
      ELSE IF(I.EQ.N)THEN
         F(N)=(2.0*T(N-1)-2.0*T(N))/DXS-D*EXP(-E/(R*T(N)))
      ELSE
         F(I)=(T(I+1)-2.0*T(I)+T(I-1))/DXS-D*EXP(-E/(R*T(I)))
      END IF
1     CONTINUE
      RETURN
      END
      SUBROUTINE DERV
      COMMON/T/   TIME,  NSTOP,  NORUN
     1      /Y/ TC(21)
     2      /F/ TT(21)
     3      /S/ TX(21),TXX(21)
     4      /C/      N,     IP
      COMMON/C1/ T0(20), D, E, R, DXS, TA, DF
      REAL K0, K, L
C...
C...  BOUNDARY CONDITIONS
      TC(1)=TA
      TX(N)=0.
C...
C...  SECOND ORDER SPATIAL DERIVATIVE
      CALL DSS042(0.,1.,N,TC,TX,TXX,1,2)
C...
C...  PDE
      DO 1 I=1,N
      TT(I)=DF*TXX(I)-D*EXP(-E/(R*TC(I)))
1     CONTINUE
      RETURN
      END
      SUBROUTINE PRINT(NI,NO)
      COMMON/T/   TIME,  NSTOP,  NORUN
     1      /Y/ TC(21)
     2      /F/ TT(21)
     3      /S/ TX(21),TXX(21)
     4      /C/      N,     IP
      COMMON/C1/ T0(20), D, E, R, DXS, TA, DF
C...
C...  REAL SELECTED VARIABLES
      REAL K0, K, L
C...
C...  DIMENSION THE ARRAY FOR THE ARRHENIUS TEMPERATURE DEPENDENCY
      DIMENSION EX(21)
C...
C...  PRINT THE SOLUTION, INCLUDING THE PARTIAL DERIVATIVES AND THE
C...  ARRHENIUS TEMPERATURE DEPENDENCY
      DO 3 I=1,N
      EX(I)=-D*EXP(-E/(R*TC(I)))
3     CONTINUE
         WRITE(NO,2)TIME,( TC(I),I=1,N,5),( TT(I),I=1,N,5),
     1                   (TXX(I),I=1,N,5),( EX(I),I=1,N,5)
2        FORMAT(1H ,//,' T = ',F10.2,/,
     1          '    TC(X,T)',5F10.2,/,
     2          '    TT(X,T)',5E10.2,/,
     3          '   TXX(X,T)',5F10.2,/,
     4          '    EX(X,T)',5F10.4,//)
      RETURN
      END
MULTIPLE STEADY STATES OF A DISTRIBUTED (PDE) SYSTEM
0.        1000.     200.
   2110000    1    1  REL 0.001
MULTIPLE STEADY STATES OF A DISTRIBUTED (PDE) SYSTEM
0.        1000.     200.
   2110000    1    1  REL 0.001
END OF RUNS
*APP MATH05
      SUBROUTINE INITAL
C...
C...  1 + 1 SINE-GORDON EQUATION
C...
C...  THE 1 + 1 SINE-GORDON EQUATION IS DISCUSSED IN DETAIL IN ROGERS,
C...  C. AND W. F. SHADWICK, BACKLUND TRANSFORMATIONS AND THEIR APPLI-
C...  CATIONS, ACADEMIC PRESS, NY, 1982.  THE SINE-GORDON EQUATON HAS
C...  MANY PHYSICAL APPLICATIONS SUCH AS THE ANALYSIS OF ULTRASHORT
C...  OPTICAL PULSE PROPAGATION PHENOMENA.
C...
C...  CONSIDER THE FOLLOWING ONE-DIMENSIONAL SINE-GORDON EQUATION
C...
C...     U   = SIN(U)                                              (1)
C...      XT
C...
C...  WITH THE BOUNDARY AND INITIAL CONDITIONS
C...
C...     U(0,T) = 0, T GE 0, U (X,0) = SIN(PI*X), 0 LE X LE 1   (2)(3)
C...                          X
C...
C...  THE FOLLOWING CODE PRODUCES A NUMERICAL SOLUTION TO EQUATIONS
C...  (1) TO (3) WITH PLOTTING OF THE SOLUTION.
C...
C...  COMMON AREA
      COMMON/T/        T,    NSTOP,    NORUN
     1      /Y/ UX(0:20)
     2      /F/UXT(0:20)
     3      /C/  U(0:20),  X(0:20),       DX,        N
C...
C...  DEFINE THE SPATIAL GRID
      N=20
      DX=1./FLOAT(N)
      X(0)=0.
      DO 1 I=0,N-1
      X(I+1)=X(I)+DX
1     CONTINUE
C...
C...  INITIAL CONDITION (3)
      PI=4.*ATAN(1.)
      DO 2 I=0,N
      UX(I)=SIN(PI*X(I))
2     CONTINUE
C...
C...  CALCULATE INITIAL DERIVATIVES
      CALL DERV
      RETURN
      END
      SUBROUTINE DERV
      COMMON/T/        T,    NSTOP,    NORUN
     1      /Y/ UX(0:20)
     2      /F/UXT(0:20)
     3      /C/  U(0:20),  X(0:20),       DX,        N
C...
C...  BOUNDARY CONDITION (2)
      U(0)=0.
C...
C...  COMPUTE U FROM U  BY TRAPEZOIDAL INTEGRATION
C...                  X
      DO 1 I=1,N
      U(I)=U(I-1)+(UX(I)+UX(I-1))*DX/2.
1     CONTINUE
C...
C...  EQUATION (1)
      DO 2 I=1,N
      UXT(I)=SIN(U(I))
2     CONTINUE
C...
C...  SINCE U(0,T) = 0 FROM BOUNDARY CONDITION (2), U  (0,T) = 0
C...                                                 XT
      UXT(0)=0.
      RETURN
      END
      SUBROUTINE PRINT(NI,NO)
      COMMON/T/        T,    NSTOP,    NORUN
     1      /Y/ UX(0:20)
     2      /F/UXT(0:20)
     3      /C/  U(0:20),  X(0:20),       DX,        N
C...
C...  DIMENSION THE ARRAYS FOR THE PLOTTED SOLUTION
      DIMENSION XP(21), UP1(11,21), UXP1(11,21), UXTP1(11,21),
     1                  UP2( 6,21), UXP2( 6,21), UXTP2( 6,21)
C...
C...  INITIALIZE COUNTERS FOR THE PLOTTED SOLUTIONS
      DATA IP1,IP2/2*0/
C...
C...  PRINT THE NUMERICAL SOLUTION
      WRITE(NO,1)T,(U(I),I=0,N),(UX(I),I=0,N),(UXT(I),I=0,N)
1     FORMAT(1H ,///,5H T = ,F5.1,//,
     1 4H   U,6F10.3,/,14X,5F10.3,/,14X,5F10.3,/,14X,5F10.3,//,
     2 4H  UX,6F10.3,/,14X,5F10.3,/,14X,5F10.3,/,14X,5F10.3,//,
     3 4H UXT,6F10.3,/,14X,5F10.3,/,14X,5F10.3,/,14X,5F10.3)
C...
C...  STORE THE SOLUTION FOR PLOTTING
C...
C...  CONTINUOUS PLOTTER.  THE SOLUTION IS STORED DURING EACH CALL TO
C...  SUBROUTINE PRINT
      IP1=IP1+1
      DO 2 I=0,N
      XP(I+1)=X(I)
      UP1(IP1,I+1)=U(I)
      UXP1(IP1,I+1)=UX(I)
      UXTP1(IP1,I+1)=UXT(I)
2     CONTINUE
C...
C...  DISCRETE (LINE-PRINTER) PLOTTER.  THE SOLUTION IS STORED EVERY
C...  SECOND CALL TO SUBROUTINE PRINT TO PRODUCE A PLOT THAT HAS SIX
C...  SOLUTON CURVES RATHER THAN THE 11 SOLUTION CURVES FROM THE CON-
C...  TINUOUS PLOTTER
      IF(((IP1-1)/2*2).EQ.(IP1-1))THEN
      IP2=IP2+1
      DO 3 I=0,N
      XP(I+1)=X(I)
      UP2(IP2,I+1)=U(I)
      UXP2(IP2,I+1)=UX(I)
      UXTP2(IP2,I+1)=UXT(I)
3     CONTINUE
      END IF
C...
C...  PLOT THE SOLUTION
      IF(IP1.LT.11)RETURN
C...
C...  ******************************************************************
C...
C...  THE FOLLOWING CALLS TO A CONTINUOUS PLOTTER ARE MACHINE DEPENDENT
C...  AND WILL HAVE TO BE CHANGED FOR OTHER COMPUTERS OR CONVERTED TO
C...  COMMENTS
C...
C...  CALL QIKSAX(3,3)
C...  CALL QIKPLT(XP,UP1,N+1,3H*X*,8H*U(X,T)*,
C... 1    28H*1 + 1 SINE-GORDON EQUATION*,IP1)
C...  CALL QIKSAX(3,3)
C...  CALL QIKPLT(XP,UXP1,N+1,3H*X*,9H*UX(X,T)*,
C... 1    28H*1 + 1 SINE-GORDON EQUATION*,IP1)
C...  CALL QIKSAX(3,3)
C...  CALL QIKPLT(XP,UXTP1,N+1,3H*X*,10H*UXT(X,T)*,
C... 1    28H*1 + 1 SINE-GORDON EQUATION*,IP1)
C...
C...  ******************************************************************
C...
      CALL TPLOTS(IP2,N+1,XP,UP2)
      WRITE(NO,11)
11    FORMAT(1H ,//,47H   U(X,T) VS X WITH T AS A PARAMETER           )
      CALL TPLOTS(IP2,N+1,XP,UXP2)
      WRITE(NO,12)
12    FORMAT(1H ,//,47H  UX(X,T) VS X WITH T AS A PARAMETER           )
      CALL TPLOTS(IP2,N+1,XP,UXTP2)
      WRITE(NO,13)
13    FORMAT(1H ,//,47H UXT(X,T) VS X WITH T AS A PARAMETER           )
C...
C...  REINITIALIZE THE PLOTTING COUNTERS FOR ANOTHER RUN
      IP1=0
      IP2=0
      RETURN
      END
1 + 1 SINE-GORDON EQUATION
0.        10.       1.
   21 1000    1    1  REL 0.001
END OF RUNS
*APP MATH06
      SUBROUTINE INITAL
C...
C...  LIOUVILLE*S EQUATION
C...
C...  LIOUVILLE*S EQUATION IS DISCUSSED IN ROGERS, C., AND W. F. SHAD-
C...  WICK, BACKLUND TRANSFORMATIONS AND THEIR APPLICATIONS, ACADEMIC
C...  PRESS, NY, 1982.
C...
C...  CONSIDER THE FOLLOWING ONE-DIMENSIONAL FORM OF LIOUVILLE*S
C...  EQUATION
C...
C...     U   = EXP(U)                                              (1)
C...      XT
C...
C...  WITH THE BOUNDARY AND INITIAL CONDITIONS
C...
C...     U(0,T) = 0, T GE 0, U (X,0) = SIN(PI*X), 0 LE X LE 1   (2)(3)
C...                          X
C...
C...  THE FOLLOWING CODE PRODUCES A NUMERICAL SOLUTION TO EQUATIONS
C...  (1) TO (3) WITH PLOTTING OF THE SOLUTION.
C...
C...  COMMON AREA
      COMMON/T/        T,    NSTOP,    NORUN
     1      /Y/ UX(0:20)
     2      /F/UXT(0:20)
     3      /C/  U(0:20),  X(0:20),       DX,        N
C...
C...  DEFINE THE SPATIAL GRID
      N=20
      DX=1./FLOAT(N)
      X(0)=0.
      DO 1 I=0,N-1
      X(I+1)=X(I)+DX
1     CONTINUE
C...
C...  INITIAL CONDITION (3)
      PI=4.*ATAN(1.)
      DO 2 I=0,N
      UX(I)=SIN(PI*X(I))
2     CONTINUE
C...
C...  CALCULATE INITIAL DERIVATIVES
      CALL DERV
      RETURN
      END
      SUBROUTINE DERV
      COMMON/T/        T,    NSTOP,    NORUN
     1      /Y/ UX(0:20)
     2      /F/UXT(0:20)
     3      /C/  U(0:20),  X(0:20),       DX,        N
C...
C...  BOUNDARY CONDITION (2)
      U(0)=0.
C...
C...  COMPUTE U FROM U  BY TRAPEZOIDAL INTEGRATION
C...                  X
      DO 1 I=1,N
      U(I)=U(I-1)+(UX(I)+UX(I-1))*DX/2.
1     CONTINUE
C...
C...  EQUATION (1)
      DO 2 I=1,N
      UXT(I)=EXP(U(I))
2     CONTINUE
C...
C...  SINCE U(0,T) = 0 FROM BOUNDARY CONDITION (2), U  (0,T) = 0
C...                                                 XT
      UXT(0)=0.
      RETURN
      END
      SUBROUTINE PRINT(NI,NO)
      COMMON/T/        T,    NSTOP,    NORUN
     1      /Y/ UX(0:20)
     2      /F/UXT(0:20)
     3      /C/  U(0:20),  X(0:20),       DX,        N
C...
C...  DIMENSION THE ARRAYS FOR THE PLOTTED SOLUTION
      DIMENSION XP(21), UP1(11,21), UXP1(11,21), UXTP1(11,21),
     1                  UP2( 6,21), UXP2( 6,21), UXTP2( 6,21)
C...
C...  INITIALIZE COUNTERS FOR THE PLOTTED SOLUTIONS
      DATA IP1,IP2/2*0/
C...
C...  PRINT THE NUMERICAL SOLUTION
      WRITE(NO,1)T,(U(I),I=0,N),(UX(I),I=0,N),(UXT(I),I=0,N)
1     FORMAT(1H ,///,5H T = ,F5.1,//,
     1 4H   U,6F10.3,/,14X,5F10.3,/,14X,5F10.3,/,14X,5F10.3,//,
     2 4H  UX,6F10.3,/,14X,5F10.3,/,14X,5F10.3,/,14X,5F10.3,//,
     3 4H UXT,6F10.3,/,14X,5F10.3,/,14X,5F10.3,/,14X,5F10.3)
C...
C...  STORE THE SOLUTION FOR PLOTTING
C...
C...  CONTINUOUS PLOTTER.  THE SOLUTION IS STORED DURING EACH CALL TO
C...  SUBROUTINE PRINT
      IP1=IP1+1
      DO 2 I=0,N
      XP(I+1)=X(I)
      UP1(IP1,I+1)=U(I)
      UXP1(IP1,I+1)=UX(I)
      UXTP1(IP1,I+1)=UXT(I)
2     CONTINUE
C...
C...  DISCRETE (LINE-PRINTER) PLOTTER.  THE SOLUTION IS STORED EVERY
C...  SECOND CALL TO SUBROUTINE PRINT TO PRODUCE A PLOT THAT HAS SIX
C...  SOLUTON CURVES RATHER THAN THE 11 SOLUTION CURVES FROM THE CON-
C...  TINUOUS PLOTTER
      IF(((IP1-1)/2*2).EQ.(IP1-1))THEN
      IP2=IP2+1
      DO 3 I=0,N
      XP(I+1)=X(I)
      UP2(IP2,I+1)=U(I)
      UXP2(IP2,I+1)=UX(I)
      UXTP2(IP2,I+1)=UXT(I)
3     CONTINUE
      END IF
C...
C...  PLOT THE SOLUTION
      IF(IP1.LT.11)RETURN
C...
C...  ******************************************************************
C...
C...  THE FOLLOWING CALLS TO A CONTINUOUS PLOTTER ARE MACHINE DEPENDENT
C...  AND WILL HAVE TO BE CHANGED FOR OTHER COMPUTERS OR CONVERTED TO
C...  COMMENTS
C...
C...  CALL QIKSAX(3,3)
C...  CALL QIKPLT(XP,UP1,N+1,3H*X*,8H*U(X,T)*,
C... 1    28H*   LIOUVILLE'S EQUATION   *,IP1)
C...  CALL QIKSAX(3,3)
C...  CALL QIKPLT(XP,UXP1,N+1,3H*X*,9H*UX(X,T)*,
C... 1    28H*   LIOUVILLE'S EQUATION   *,IP1)
C...  CALL QIKSAX(3,3)
C...  CALL QIKPLT(XP,UXTP1,N+1,3H*X*,10H*UXT(X,T)*,
C... 1    28H*   LIOUVILLE'S EQUATION   *,IP1)
C...
C...  ******************************************************************
C...
      CALL TPLOTS(IP2,N,XP,UP2)
      WRITE(NO,11)
11    FORMAT(1H ,//,47H   U(X,T) VS X WITH T AS A PARAMETER           )
      CALL TPLOTS(IP2,N,XP,UXP2)
      WRITE(NO,12)
12    FORMAT(1H ,//,47H  UX(X,T) VS X WITH T AS A PARAMETER           )
      CALL TPLOTS(IP2,N,XP,UXTP2)
      WRITE(NO,13)
13    FORMAT(1H ,//,47H UXT(X,T) VS X WITH T AS A PARAMETER           )
C...
C...  REINITIALIZE THE PLOTTING COUNTERS FOR ANOTHER RUN
      IP1=0
      IP2=0
      RETURN
      END
LIOUVILLE*S EQUATION
0.        1.        0.1
   21 1000    1    1  REL 0.001
END OF RUNS
*APP MATH07
      SUBROUTINE INITAL
C...
C...  FREQUENCY OF THE JACOBIAN MATRIX UPDATING IN DAVIDENKO*S METHOD
C...
C...  THE FOLLOWING SYSTEM OF TWO TRANSCENDENTAL EQUATIONS IS SOLVED BY
C...  DAVIDENKO*S METHOD FOR THE UNKNOWNS X AND Y
C...
C...                         1/2
C...                      Y(X   )    2
C...     X = 1 + (H**2)*(E       + 3X )                              (1)
C...
C...                           X    2
C...     Y = 0.5 + (H**2)*TAN(E  + Y )                               (2)
C...
C...  WITH H = 0.1
C...
C...  THE DAVIDENKO DIFFERENTIAL EQUATION FOR EQUATIONS (1) AND (2) CAN
C...  BE WRITTEN IN MATRIX FORM AS
C...
C...     -  -       -  -       -
C...     J*DX/DT = -F, X(T0) = X0                                 (3)(4)
C...
C...  WHERE
C...
C...     -
C...     J              JACOBIAN MATRIX FOR EQUATIONS (1) AND (2)
C...
C...     -
C...     X              SOLUTION VECTOR FOR EQUATIONS (1) AND (2) WHEN
C...                    -       -
C...                    DX/DT = 0
C...
C...     T              INDEPENDENT VARIABLE IN THE DAVIDENKO METHOD
C...
C...     T0             INITIAL VALUE OF T
C...
C...     -
C...     X0             INITIAL CONDITION VECTOR FOR EQUATION (3)
C...
C...                                    -                           -
C...  IN THE CODING IN SUBROUTINE DERV, J IS STORED IN ARRAY A, AND F IS
C...  STORED IN ARRAY B.  THE UNCOUPLING OF THE DERIVATIVES IN EQUATION
C...  (3) IS DONE IN SUBROUTINE DERV BY A CALL TO SUBROUTINES DECOMP AND
C...  SOLVE (LISTED AND DISCUSSED IN DETAIL IN FORSYTHE, G. E., M. A.
C...  MALCOLM AND C. B. MOLER, COMPUTER METHODS FOR MATHEMATICAL COMPU-
C...  TATIONS, CHAPTER 3, PRENTICE-HALL, ENGLEWOOD-CLIFFS, N.J., 1977).
C...  ANY OTHER ROUTINE(S) FOR LINEAR ALGEBRAIC EQUATIONS CAN BE USED IN
C...                                                    --   -
C...  PLACE OF DECOMP AND SOLVE (THE GENERAL PROBLEM IS AX = B).
C...
C...                                                      -   -
C...  THE PROGRAMMING OF EQUATION (3) IN TERMS OF VECTORS X, DX/DT AND
C...  -             -
C...  F, AND MATRIX J, IS INTENDED TO ILLUSTRATE THE GENERAL FEATURES OF
C...  DAVIDENKO*S METHOD, I.E., THESE VECTORS AND MATRIX CAN BE EXPANDED
C...  TO ACCOMMODATE A PROBLEM OF ANY SIZE.
C...
C...  THE PURPOSE OF THE FOLLOWING CODING IS TO INVESTIGATE THE PER-
C...  FORMANCE OF DAVIDENKO*S METHOD WHEN THE JACOBIAN MATRIX IS NOT
C...  UPDATED FOR EACH STEP IN THE INTEGRATION OF THE DAVIDENKO DIFFER-
C...  ENTIAL EQUATION
C...
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/      X(2)
     2      /F/   DXDT(2)
     3      /C/        HS,    A(2,2),      B(2),   WORK(2),   IPVT(2),
     4                  N,        IT,        NT
C...
C...  SET THE NUMBER OF EQUATIONS
      N=2
C...
C...  HS IS H**2 IN EQUATIONS (1) AND (2)
      HS=0.01
C...
C...  SET THE FREQUENCY OF THE JACOBIAN EVALUATIONS
      IF(NORUN.EQ.1)NT=1
      IF(NORUN.EQ.2)NT=2
      IF(NORUN.EQ.3)NT=5
      IT=0
C...
C...  SET THE INITIAL CONDITIONS
      X(1)=1.
      X(2)=1.
C...
C...  INITIALIZE THE DERIVATIVE VECTOR IN EQUATION (3).  THE INITIAL
C...  CALL TO JACOB INSURES THAT THE JACOBIAN MATRIX IS AVAILABLE AT
C...  THE BEGINNING OF THE INTEGRATION OF THE DAVIDENKO DIFFERENTIAL
C...  EQUATION, EVEN FOR THOSE CASES WHEN THE JACOBIAN MATRIX IS NOT
C...  EVALUATED DURING EACH CALL TO DERV (NT GT 1).  THE SAME STATE-
C...  MENT APPLIES TO THE INITIAL CALL TO DECOMP (I.E., THE LU DECOM-
C...  POSITION OF THE JACOBIAN MATRIX A IS AVAILABLE AT THE BEGINNING
C...  OF THE INTEGRATION FOR NT GT 1)
      CALL JACOB(N,A)
      CALL DECOMP(N,N,A,COND,IPVT,WORK)
      CALL DERV
      RETURN
      END
      SUBROUTINE DERV
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/      X(2)
     2      /F/   DXDT(2)
     3      /C/        HS,    A(2,2),      B(2),   WORK(2),   IPVT(2),
     4                  N,        IT,        NT
      COMMON/IO/       NI,        NO
C...
C...  COMPUTE THE ELEMENTS OF THE JACOBIAN MATRIX AND THE RHS VECTOR
C...  OF EQUATIONS (1) AND (2).  THE JACOBIAN MATRIX IS UPDATED ONLY
C...  NT CALLS TO DERV THROUGH THE COUNTER IT
      CALL FUNC(N,B)
      IT=IT+1
      IF(IT.LT.NT)GO TO 2
      CALL JACOB(N,A)
C...
C...  SOLVE FOR THE VECTOR OF DERIVATIVES, DX/DT, IN EQUATION (3) (IN
C...  EFFECT, EQUATION (3) IS PREMULTIPLIED BY THE INVERSE OF JACOBIAN
C...  MATRIX J THROUGH CALLS TO SUBROUTINE DECOMP AND SOLVE).  THE LU
C...  DECOMPOSITION OF THE JACOBIAN MATRIX IS DONE ONLY EVERY NT CALLS
C...  TO DERV THROUGH THE COUNTER IT
      CALL DECOMP(N,N,A,COND,IPVT,WORK)
      IT=0
C...
C...  CHECK THE CONDITION OF MATRIX A BEFORE COMPUTING THE DERIVATIVE
C...  VECTOR, DX/DT.  IF A IS NEAR SINGULAR, TERMINATE THE CURRENT RUN
      IF(COND.LT.1.0E+20)GO TO 2
      WRITE(NO,1)COND
1     FORMAT(1H ,//,
     1 30H THE CONDITION NUMBER OF A IS ,E10.3,33H SO THE CURRENT RUN IS
     1 TERMINATED)
      NSTOP=1
C...
C...  COMPUTE THE DERIVATIVE VECTOR DX/DT (INDIRECTLY VIA ARRAY B)
2     CALL SOLVE(N,N,A,B,IPVT)
C...
C...  TRANSFER ARRAY B TO ARRAY DXDT SO THE DERIVATIVE VECTOR, DX/DT,
C...  IS AVAILABLE IN COMMON/F/
      DO 3 I=1,N
      DXDT(I)=B(I)
3     CONTINUE
      RETURN
      END
      SUBROUTINE FUNC(N,F)
C...                                                -
C...  SUBROUTINE FUNC EVALUATES THE FUNCTION VECTOR F IN EQUATION (3)
C...
C...  ARGUMENT LIST
C...
C...     N     LENGTH OF THE FUNCTION VECTOR (INPUT)
C...
C...     F     ONE-DIMENSIONAL ARRAY CONTAINING THE FUNCTION VECTOR
C...           (OUTPUT)
C...
      COMMON/Y/      X(2)
     3      /C/        HS
      DIMENSION      F(N)
C...                     -
C...  DEFINE THE VECTOR -F (NOTE THE SIGN CHANGE AS REQUIRED BY THE
C...  DAVIDENKO DIFFERENTIAL EQUATION (3) IN SUBROUTINE INITAL.  THIS
C...  SIGN CHANGE IS RELATIVE TO THE JACOBIAN MATRIX PARTIAL DERIVA-
C...  TIVES PROGRAMMED IN SUBROUTINE JACOB)
C...
      IF(X(1).LT.0.)STOP
      F(1)=-1.-HS*(EXP(X(2)*SQRT(X(1)))+3.*X(1)**2)+X(1)
      ARG2=EXP(X(1))+X(2)**2
      F(2)=-0.5-HS*SIN(ARG2)/COS(ARG2)+X(2)
      RETURN
      END
      SUBROUTINE JACOB(N,A)
C...                                                 -
C...  SUBROUTINE JACOB EVALUATES THE JACOBIAN MATRIX J IN EQUATION (3)
C...
C...  ARGUMENT LIST
C...
C...     N     ROW AND COLUMN DIMENSION OF THE JACOBIAN MATRIX (INPUT)
C...
C...     A     TWO-DIMENSIONAL ARRAY CONTAINING THE JACOBIAN MATRIX
C...           (OUTPUT)
C...
      COMMON/Y/      X(2)
     3      /C/        HS
      DIMENSION    A(N,N)
C...                                -
C...  DEFINE THE JACOBIAN MATRIX OF F
C...
C...  FIRST ROW
      IF(X(1).LT.0.)STOP
      SR=SQRT(X(1))
      ARG1=EXP(X(2)*SR)
      A(1,1)=HS*(ARG1*0.5*X(2)*(1./SR)+6.*X(1))-1.
      A(1,2)=HS*ARG1*SR
C...
C...  SECOND ROW
      ARG2=EXP(X(1))+X(2)**2
      SECS=(1./COS(ARG2))**2
      A(2,1)=HS*SECS*EXP(X(1))
      A(2,2)=HS*SECS*(2.*X(2))-1.
      RETURN
      END
      SUBROUTINE PRINT(NI,NO)
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/      X(2)
     2      /F/   DXDT(2)
     3      /C/        HS,    A(2,2),      B(2),   WORK(2),   IPVT(2),
     4                  N,        IT,        NT
C...
C...  DIMENSION THE ARRAYS TO STORE THE RESIDUALS OF EQUATIONS (1) TO
C...  (2) FOR SUBSEQUENT PLOTTING
      DIMENSION FR1(3,11),FR2(3,11),TP(11)
C...
C...  PRINT A HEADING FOR THE NUMERICAL SOLUTION
      IF(T.GT.0.05)GO TO 3
      WRITE(NO,1)
1     FORMAT(9X,1HT,11X,1HX,11X,1HY,7X,5HDX/DT,7X,5HDY/DT)
      IP=0
C...
C...  PRINT THE NUMERICAL SOLUTION
C...
C...  PRINT THE NUMERICAL SOLUTION
3     WRITE(NO,2)T,(X(I),I=1,N),(DXDT(I),I=1,N)
2     FORMAT(F10.2,4F12.6)
C...
C...  PLOT THE LOG OF THE RESIDUALS OF EQUATION (1) AND (2) VS T TO
C...  INVESTIGATE THE EXPONENTIAL CONVERGENCE OF DAVIDENKO*S ALGORITHM.
C...  STORE THE RESIDUALS FOR PLOTTING
      IP=IP+1
      CALL FUNC(N,B)
      FR1(NORUN,IP)=ALOG(ABS(B(1)))
      FR2(NORUN,IP)=ALOG(ABS(B(2)))
      TP(IP)=T
C...
C...  AT THE END OF RUN 3, PLOT THE RESIDUALS
      IF(IP.LT.11)RETURN
      IF(NORUN.EQ.3)GO TO 5
      IP=0
      RETURN
5     CALL TPLOTS(NORUN,IP,TP,FR1)
      WRITE(NO,11)
11    FORMAT(1H ,/,
     1 49H LOG/E1/ VS T, 1 - NT = 1, 2 - NT = 2, 3 - NT = 5)
      CALL TPLOTS(NORUN,IP,TP,FR2)
      WRITE(NO,12)
12    FORMAT(1H ,/,
     1 49H LOG/E2/ VS T, 1 - NT = 1, 2 - NT = 2, 3 - NT = 5)
C...
C...  ******************************************************************
C...
C...  THE FOLLOWING CALLS TO A CONTINUOUS PLOTTER ARE MACHINE-DEPENDENT
C...  AND WILL HAVE TO BE CONVERTED FOR OTHER COMPUTERS, OR CONVERTED
C...  TO COMMENTS
C...  CALL QIKSAX(3,3)
C...  CALL QIKPLT(TP,FR1,-IP,3H*T*,9H*LOG/E1/*,2H**,NORUN)
C...  CALL QIKSAX(3,3)
C...  CALL QIKPLT(TP,FR2,-IP,3H*T*,9H*LOG/E2/*,2H**,NORUN)
C...
C...  ******************************************************************
      RETURN
      END
      SUBROUTINE DECOMP(NDIM,N,A,COND,IPVT,WORK)
C
      INTEGER NDIM,N
      REAL A(NDIM,N),COND,WORK(N)
      INTEGER IPVT(N)
C
C     DECOMPOSES A REAL MATRIX BY GAUSSIAN ELIMINATION
C     AND ESTIMATES THE CONDITION OF THE MATRIX.
C
C     USE SOLVE TO COMPUTE SOLUTIONS TO LINEAR SYSTEMS.
C
C     INPUT..
C
C        NDIM = DECLARED ROW DIMENSION OF THE ARRAY CONTAINING  A.
C
C        N = ORDER OF THE MATRIX.
C
C        A = MATRIX TO BE TRIANGULARIZED.
C
C     OUTPUT..
C
C        A  CONTAINS AN UPPER TRIANGULAR MATRIX  U  AND A PERMUTED
C          VERSION OF A LOWER TRIANGULAR MATRIX  I-L  SO THAT
C          (PERMUTATION MATRIX)*A = L*U .
C
C        COND = AN ESTIMATE OF THE CONDITION OF  A .
C           FOR THE LINEAR SYSTEM  A*X = B, CHANGES IN  A  AND  B
C           MAY CAUSE CHANGES  COND  TIMES AS LARGE IN  X .
C           IF  COND+1.0 .EQ. COND , A IS SINGULAR TO WORKING
C           PRECISION.  COND  IS SET TO  1.0E+32  IF EXACT
C           SINGULARITY IS DETECTED.
C
C        IPVT = THE PIVOT VECTOR.
C           IPVT(K) = THE INDEX OF THE K-TH PIVOT ROW
C           IPVT(N) = (-1)**(NUMBER OF INTERCHANGES)
C
C     WORK SPACE..  THE VECTOR  WORK  MUST BE DECLARED AND INCLUDED
C                   IN THE CALL.  ITS INPUT CONTENTS ARE IGNORED.
C                   ITS OUTPUT CONTENTS ARE USUALLY UNIMPORTANT.
C
C     THE DETERMINANT OF A CAN BE OBTAINED ON OUTPUT BY
C        DET(A) = IPVT(N) * A(1,1) * A(2,2) * ... * A(N,N).
C
      REAL EK, T, ANORM, YNORM, ZNORM
      INTEGER NM1, I, J, K, KP1, KB, KM1, M
C
      IPVT(N) = 1
      IF (N .EQ. 1) GO TO 80
      NM1 = N - 1
C
C     COMPUTE 1-NORM OF A
C
      ANORM = 0.0
      DO 10 J = 1, N
         T = 0.0
         DO 5 I = 1, N
            T = T + ABS(A(I,J))
    5    CONTINUE
         IF (T .GT. ANORM) ANORM = T
   10 CONTINUE
C
C     GAUSSIAN ELIMINATION WITH PARTIAL PIVOTING
C
      DO 35 K = 1,NM1
         KP1= K+1
C
C        FIND PIVOT
C
         M = K
         DO 15 I = KP1,N
            IF (ABS(A(I,K)) .GT. ABS(A(M,K))) M = I
   15    CONTINUE
         IPVT(K) = M
         IF (M .NE. K) IPVT(N) = -IPVT(N)
         T = A(M,K)
         A(M,K) = A(K,K)
         A(K,K) = T
C
C        SKIP STEP IF PIVOT IS ZERO
C
         IF (T .EQ. 0.0) GO TO 35
C
C        COMPUTE MULTIPLIERS
C
         DO 20 I = KP1,N
             A(I,K) = -A(I,K)/T
   20    CONTINUE
C
C        INTERCHANGE AND ELIMINATE BY COLUMNS
C
         DO 30 J = KP1,N
             T = A(M,J)
             A(M,J) = A(K,J)
             A(K,J) = T
             IF (T .EQ. 0.0) GO TO 30
             DO 25 I = KP1,N
                A(I,J) = A(I,J) + A(I,K)*T
   25        CONTINUE
   30    CONTINUE
   35 CONTINUE
C
C     COND = (1-NORM OF A)*(AN ESTIMATE OF 1-NORM OF A-INVERSE)
C     ESTIMATE OBTAINED BY ONE STEP OF INVERSE ITERATION FOR THE
C     SMALL SINGULAR VECTOR.  THIS INVOLVES SOLVING TWO SYSTEMS
C     OF EQUATIONS, (A-TRANSPOSE)*Y = E  AND  A*Z = Y  WHERE  E
C     IS A VECTOR OF +1 OR -1 CHOSEN TO CAUSE GROWTH IN Y.
C     ESTIMATE = (1-NORM OF Z)/(1-NORM OF Y)
C
C     SOLVE (A-TRANSPOSE)*Y = E
C
      DO 50 K = 1, N
         T = 0.0
         IF (K .EQ. 1) GO TO 45
         KM1 = K-1
         DO 40 I = 1, KM1
            T = T + A(I,K)*WORK(I)
   40    CONTINUE
   45    EK = 1.0
         IF (T .LT. 0.0) EK = -1.0
         IF (A(K,K) .EQ. 0.0) GO TO 90
         WORK(K) = -(EK + T)/A(K,K)
   50 CONTINUE
      DO 60 KB = 1, NM1
         K = N - KB
         T = 0.0
         KP1 = K+1
         DO 55 I = KP1, N
            T = T + A(I,K)*WORK(K)
   55    CONTINUE
         WORK(K) = T
         M = IPVT(K)
         IF (M .EQ. K) GO TO 60
         T = WORK(M)
         WORK(M) = WORK(K)
         WORK(K) = T
   60 CONTINUE
C
      YNORM = 0.0
      DO 65 I = 1, N
         YNORM = YNORM + ABS(WORK(I))
   65 CONTINUE
C
C     SOLVE A*Z = Y
C
      CALL SOLVE(NDIM, N, A, WORK, IPVT)
C
      ZNORM = 0.0
      DO 70 I = 1, N
         ZNORM = ZNORM + ABS(WORK(I))
   70 CONTINUE
C
C     ESTIMATE CONDITION
C
      COND = ANORM*ZNORM/YNORM
      IF (COND .LT. 1.0) COND = 1.0
      RETURN
C
C     1-BY-1
C
   80 COND = 1.0
      IF (A(1,1) .NE. 0.0) RETURN
C
C     EXACT SINGULARITY
C
   90 COND = 1.0E+32
      RETURN
      END
      SUBROUTINE SOLVE(NDIM, N, A, B, IPVT)
C
      INTEGER NDIM, N, IPVT(N)
      REAL A(NDIM,N),B(N)
C
C   SOLUTION OF LINEAR SYSTEM, A*X = B .
C   DO NOT USE IF DECOMP HAS DETECTED SINGULARITY.
C
C   INPUT..
C
C     NDIM = DECLARED ROW DIMENSION OF ARRAY CONTAINING A .
C
C     N = ORDER OF MATRIX.
C
C     A = TRIANGULARIZED MATRIX OBTAINED FROM DECOMP .
C
C     B = RIGHT HAND SIDE VECTOR.
C
C     IPVT = PIVOT VECTOR OBTAINED FROM DECOMP .
C
C   OUTPUT..
C
C     B = SOLUTION VECTOR, X .
C
      INTEGER KB, KM1, NM1, KP1, I, K, M
      REAL T
C
C     FORWARD ELIMINATION
C
      IF (N .EQ. 1) GO TO 50
      NM1 = N-1
      DO 20 K = 1, NM1
         KP1 = K+1
         M = IPVT(K)
         T = B(M)
         B(M) = B(K)
         B(K) = T
         DO 10 I = KP1, N
             B(I) = B(I) + A(I,K)*T
   10    CONTINUE
   20 CONTINUE
C
C     BACK SUBSTITUTION
C
      DO 40 KB = 1,NM1
         KM1 = N-KB
         K = KM1+1
         B(K) = B(K)/A(K,K)
         T = -B(K)
         DO 30 I = 1, KM1
             B(I) = B(I) + A(I,K)*T
   30    CONTINUE
   40 CONTINUE
   50 B(1) = B(1)/A(1,1)
      RETURN
      END
      SUBROUTINE DECOMP(NDIM,N,A,COND,IPVT,WORK)
C
      INTEGER NDIM,N
      REAL A(NDIM,N),COND,WORK(N)
      INTEGER IPVT(N)
C
C     DECOMPOSES A REAL MATRIX BY GAUSSIAN ELIMINATION
C     AND ESTIMATES THE CONDITION OF THE MATRIX.
C
C     USE SOLVE TO COMPUTE SOLUTIONS TO LINEAR SYSTEMS.
C
C     INPUT..
C
C        NDIM = DECLARED ROW DIMENSION OF THE ARRAY CONTAINING  A.
C
C        N = ORDER OF THE MATRIX.
C
C        A = MATRIX TO BE TRIANGULARIZED.
C
C     OUTPUT..
C
C        A  CONTAINS AN UPPER TRIANGULAR MATRIX  U  AND A PERMUTED
C          VERSION OF A LOWER TRIANGULAR MATRIX  I-L  SO THAT
C          (PERMUTATION MATRIX)*A = L*U .
C
C        COND = AN ESTIMATE OF THE CONDITION OF  A .
C           FOR THE LINEAR SYSTEM  A*X = B, CHANGES IN  A  AND  B
C           MAY CAUSE CHANGES  COND  TIMES AS LARGE IN  X .
C           IF  COND+1.0 .EQ. COND , A IS SINGULAR TO WORKING
C           PRECISION.  COND  IS SET TO  1.0E+32  IF EXACT
C           SINGULARITY IS DETECTED.
C
C        IPVT = THE PIVOT VECTOR.
C           IPVT(K) = THE INDEX OF THE K-TH PIVOT ROW
C           IPVT(N) = (-1)**(NUMBER OF INTERCHANGES)
C
C     WORK SPACE..  THE VECTOR  WORK  MUST BE DECLARED AND INCLUDED
C                   IN THE CALL.  ITS INPUT CONTENTS ARE IGNORED.
C                   ITS OUTPUT CONTENTS ARE USUALLY UNIMPORTANT.
C
C     THE DETERMINANT OF A CAN BE OBTAINED ON OUTPUT BY
C        DET(A) = IPVT(N) * A(1,1) * A(2,2) * ... * A(N,N).
C
      REAL EK, T, ANORM, YNORM, ZNORM
      INTEGER NM1, I, J, K, KP1, KB, KM1, M
C
      IPVT(N) = 1
      IF (N .EQ. 1) GO TO 80
      NM1 = N - 1
C
C     COMPUTE 1-NORM OF A
C
      ANORM = 0.0
      DO 10 J = 1, N
         T = 0.0
         DO 5 I = 1, N
            T = T + ABS(A(I,J))
    5    CONTINUE
         IF (T .GT. ANORM) ANORM = T
   10 CONTINUE
C
C     GAUSSIAN ELIMINATION WITH PARTIAL PIVOTING
C
      DO 35 K = 1,NM1
         KP1= K+1
C
C        FIND PIVOT
C
         M = K
         DO 15 I = KP1,N
            IF (ABS(A(I,K)) .GT. ABS(A(M,K))) M = I
   15    CONTINUE
         IPVT(K) = M
         IF (M .NE. K) IPVT(N) = -IPVT(N)
         T = A(M,K)
         A(M,K) = A(K,K)
         A(K,K) = T
C
C        SKIP STEP IF PIVOT IS ZERO
C
         IF (T .EQ. 0.0) GO TO 35
C
C        COMPUTE MULTIPLIERS
C
         DO 20 I = KP1,N
             A(I,K) = -A(I,K)/T
   20    CONTINUE
C
C        INTERCHANGE AND ELIMINATE BY COLUMNS
C
         DO 30 J = KP1,N
             T = A(M,J)
             A(M,J) = A(K,J)
             A(K,J) = T
             IF (T .EQ. 0.0) GO TO 30
             DO 25 I = KP1,N
                A(I,J) = A(I,J) + A(I,K)*T
   25        CONTINUE
   30    CONTINUE
   35 CONTINUE
C
C     COND = (1-NORM OF A)*(AN ESTIMATE OF 1-NORM OF A-INVERSE)
C     ESTIMATE OBTAINED BY ONE STEP OF INVERSE ITERATION FOR THE
C     SMALL SINGULAR VECTOR.  THIS INVOLVES SOLVING TWO SYSTEMS
C     OF EQUATIONS, (A-TRANSPOSE)*Y = E  AND  A*Z = Y  WHERE  E
C     IS A VECTOR OF +1 OR -1 CHOSEN TO CAUSE GROWTH IN Y.
C     ESTIMATE = (1-NORM OF Z)/(1-NORM OF Y)
C
C     SOLVE (A-TRANSPOSE)*Y = E
C
      DO 50 K = 1, N
         T = 0.0
         IF (K .EQ. 1) GO TO 45
         KM1 = K-1
         DO 40 I = 1, KM1
            T = T + A(I,K)*WORK(I)
   40    CONTINUE
   45    EK = 1.0
         IF (T .LT. 0.0) EK = -1.0
         IF (A(K,K) .EQ. 0.0) GO TO 90
         WORK(K) = -(EK + T)/A(K,K)
   50 CONTINUE
      DO 60 KB = 1, NM1
         K = N - KB
         T = 0.0
         KP1 = K+1
         DO 55 I = KP1, N
            T = T + A(I,K)*WORK(K)
   55    CONTINUE
         WORK(K) = T
         M = IPVT(K)
         IF (M .EQ. K) GO TO 60
         T = WORK(M)
         WORK(M) = WORK(K)
         WORK(K) = T
   60 CONTINUE
C
      YNORM = 0.0
      DO 65 I = 1, N
         YNORM = YNORM + ABS(WORK(I))
   65 CONTINUE
C
C     SOLVE A*Z = Y
C
      CALL SOLVE(NDIM, N, A, WORK, IPVT)
C
      ZNORM = 0.0
      DO 70 I = 1, N
         ZNORM = ZNORM + ABS(WORK(I))
   70 CONTINUE
C
C     ESTIMATE CONDITION
C
      COND = ANORM*ZNORM/YNORM
      IF (COND .LT. 1.0) COND = 1.0
      RETURN
C
C     1-BY-1
C
   80 COND = 1.0
      IF (A(1,1) .NE. 0.0) RETURN
C
C     EXACT SINGULARITY
C
   90 COND = 1.0E+32
      RETURN
      END
      SUBROUTINE SOLVE(NDIM, N, A, B, IPVT)
C
      INTEGER NDIM, N, IPVT(N)
      REAL A(NDIM,N),B(N)
C
C   SOLUTION OF LINEAR SYSTEM, A*X = B .
C   DO NOT USE IF DECOMP HAS DETECTED SINGULARITY.
C
C   INPUT..
C
C     NDIM = DECLARED ROW DIMENSION OF ARRAY CONTAINING A .
C
C     N = ORDER OF MATRIX.
C
C     A = TRIANGULARIZED MATRIX OBTAINED FROM DECOMP .
C
C     B = RIGHT HAND SIDE VECTOR.
C
C     IPVT = PIVOT VECTOR OBTAINED FROM DECOMP .
C
C   OUTPUT..
C
C     B = SOLUTION VECTOR, X .
C
      INTEGER KB, KM1, NM1, KP1, I, K, M
      REAL T
C
C     FORWARD ELIMINATION
C
      IF (N .EQ. 1) GO TO 50
      NM1 = N-1
      DO 20 K = 1, NM1
         KP1 = K+1
         M = IPVT(K)
         T = B(M)
         B(M) = B(K)
         B(K) = T
         DO 10 I = KP1, N
             B(I) = B(I) + A(I,K)*T
   10    CONTINUE
   20 CONTINUE
C
C     BACK SUBSTITUTION
C
      DO 40 KB = 1,NM1
         KM1 = N-KB
         K = KM1+1
         B(K) = B(K)/A(K,K)
         T = -B(K)
         DO 30 I = 1, KM1
             B(I) = B(I) + A(I,K)*T
   30    CONTINUE
   40 CONTINUE
   50 B(1) = B(1)/A(1,1)
      RETURN
      END
DAHLQUIST, G., ET AL, NUMERICAL METHODS, P253
0.        10.0      1.0
    2 1000    1    1  REL 0.001
DAHLQUIST, G., ET AL, NUMERICAL METHODS, P253
0.        10.0      1.0
    2 1000    1    1  REL 0.001
DAHLQUIST, G., ET AL, NUMERICAL METHODS, P253
0.        10.0      1.0
    2 1000    1    1  REL 0.001
END OF RUNS
*APP MATH08
      SUBROUTINE INITAL
C...
C...  AUTOMATIC UPDATING OF THE JACOBIAN MATRIX IN DAVIDENKO*S METHOD
C...
C...  THE FOLLOWING SYSTEM OF TWO TRANSCENDENTAL EQUATIONS IS SOLVED BY
C...  DAVIDENKO*S METHOD FOR THE UNKNOWNS X AND Y
C...
C...                         1/2
C...                      Y(X   )    2
C...     X = 1 + (H**2)*(E       + 3X )                              (1)
C...
C...                           X    2
C...     Y = 0.5 + (H**2)*TAN(E  + Y )                               (2)
C...
C...  WITH H = 0.1
C...
C...  THE DAVIDENKO DIFFERENTIAL EQUATION FOR EQUATIONS (1) AND (2) CAN
C...  BE WRITTEN IN MATRIX FORM AS
C...
C...     -  -       -  -       -
C...     J*DX/DT = -F, X(T0) = X0                                 (3)(4)
C...
C...  WHERE
C...
C...     -
C...     J              JACOBIAN MATRIX FOR EQUATIONS (1) AND (2)
C...
C...     -
C...     X              SOLUTION VECTOR FOR EQUATIONS (1) AND (2) WHEN
C...                    -       -
C...                    DX/DT = 0
C...
C...     T              INDEPENDENT VARIABLE IN THE DAVIDENKO METHOD
C...
C...     T0             INITIAL VALUE OF T
C...
C...     -
C...     X0             INITIAL CONDITION VECTOR FOR EQUATION (3)
C...
C...                                    -                           -
C...  IN THE CODING IN SUBROUTINE DERV, J IS STORED IN ARRAY A, AND F IS
C...  STORED IN ARRAY B.  THE UNCOUPLING OF THE DERIVATIVES IN EQUATION
C...  (3) IS DONE IN SUBROUTINE DERV BY A CALL TO SUBROUTINES DECOMP AND
C...  SOLVE (LISTED AND DISCUSSED IN DETAIL IN FORSYTHE, G. E., M. A.
C...  MALCOLM AND C. B. MOLER, COMPUTER METHODS FOR MATHEMATICAL COMPU-
C...  TATIONS, CHAPTER 3, PRENTICE-HALL, ENGLEWOOD-CLIFFS, N.J., 1977).
C...  ANY OTHER ROUTINE(S) FOR LINEAR ALGEBRAIC EQUATIONS CAN BE USED IN
C...                                                    --   -
C...  PLACE OF DECOMP AND SOLVE (THE GENERAL PROBLEM IS AX = B).
C...
C...                                                      -   -
C...  THE PROGRAMMING OF EQUATION (3) IN TERMS OF VECTORS X, DX/DT AND
C...  -             -
C...  F, AND MATRIX J, IS INTENDED TO ILLUSTRATE THE GENERAL FEATURES OF
C...  DAVIDENKO*S METHOD, I.E., THESE VECTORS AND MATRIX CAN BE EXPANDED
C...  TO ACCOMMODATE A PROBLEM OF ANY SIZE.
C...
C...  THE PURPOSE OF THE FOLLOWING CODING IS TO INVESTIGATE THE PER-
C...  FORMANCE OF DAVIDENKO*S METHOD WHEN THE JACOBIAN MATRIX IS NOT
C...  UPDATED FOR EACH STEP IN THE INTEGRATION OF THE DAVIDENKO DIFFER-
C...  ENTIAL EQUATION IF THE L2 NORM OF THE JACOBIAN MATRIX CHANGES BY
C...  LESS THAN ARBITRARILY SELECTED MAGNITUDES SPECIFIED IN SUBROUTINE
C...  DERV
C...
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/      X(2)
     2      /F/   DXDT(2)
     3      /C/        HS,    A(2,2),      B(2),   WORK(2),   IPVT(2),
     4                  N,        IT,        NT,        E1,        E2,
     5              DELTA
C...
C...  SET THE NUMBER OF EQUATIONS
      N=2
C...
C...  HS IS H**2 IN EQUATIONS (1) AND (2)
      HS=0.01
C...
C...  SET THE INITIAL CONDITIONS
      GO TO(1,2,3),NORUN
1     X(1)=1.
      X(2)=1.
      GO TO 10
2     X(1)=2.
      X(2)=2.
      GO TO 10
3     X(1)=10.
      X(2)=10.
10    CONTINUE
C...
C...  INITIALIZE THE DERIVATIVE VECTOR IN EQUATION (3).  ALSO, IT = -3
C...  SO THAT THE JACOBIAN MATRIX IS UPDATED IN EACH OF THE FIRST THREE
C...  CALLS TO SUBROUTINE DERV (IT = -2, -1, 0) AT THE BEGINNING OF THE
C...  INTEGRATION.  THIS IS DONE TO INSURE THAT THE JACOBIAN MATRIX
C...  CHANGES ENOUGH AT THE BEGINNING OF THE INTEGRATION THAT THE HEUR-
C...  ISTICS FOR LESS FREQUENT UPDATING OF THE JACOBIAN MATRIX ARE USED
C...  WITH THE PROPER EFFECT (THE UPDATING IS LESS FREQUENT WHEN THE
C...  CHANGES IN THE NORM OF THE JACOBIAN MATRIX ARE SMALL)
      IT=-3
      CALL DERV
      END
      SUBROUTINE DERV
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/      X(2)
     2      /F/   DXDT(2)
     3      /C/        HS,    A(2,2),      B(2),   WORK(2),   IPVT(2),
     4                  N,        IT,        NT,        E1,        E2,
     5              DELTA
      COMMON/IO/       NI,        NO
C...
C...  COMPUTE THE ELEMENTS OF THE JACOBIAN MATRIX AND THE RHS VECTOR
C...  OF EQUATIONS (1) AND (2) IN ACCORDANCE WITH THE CHANGE IN THE
C...  JACOBIAN MATRIX
      CALL FUNC(N,B)
      IT=IT+1
C...
C...  AT THE BEGINNING OF THE INTEGRATION, THE JACOBIAN MATRIX IS
C...  UPDATED IN EACH CALL TO SUBROUTINE DERV
      IF(IT.GT.0)GO TO 4
      CALL JACOB(N,A)
      CALL NORM(N,A,E1)
      CALL NORM(N,A,E2)
      DELTA=ABS(E2-E1)/E1
      NT=1
      CALL DECOMP(N,N,A,COND,IPVT,WORK)
      GO TO 2
C...
C...  TESTING FOR LESS FREQUENCT UPDATING OF THE JACOBIAN MATRIX BEGINS
C...  HERE
4     IF(IT.LT.NT)GO TO 2
C...
C...  COMPUTE THE NORM OF THE PRECEDING JACOBIAN MATRIX FOR COMPARISON
C...  WITH THE CURRENT MATRIX
      CALL NORM(N,A,E1)
C...
C...  COMPUTE THE CURRENT JACOBIAN MATRIX AND ITS NORM
      CALL JACOB(N,A)
      CALL NORM(N,A,E2)
C...
C...  APPLY SOME HEURISTICS TO DETERMINE IF THE JACOBIAN MATRIX SHOULD
C...  BE UPDATED
      XLEVEL=0.1
      DELTA=ABS(E2-E1)/E2
      IF(DELTA.GE.     XLEVEL) NT=1
      IF(DELTA.LT.(1.0*XLEVEL))NT=2
      IF(DELTA.LT.(0.8*XLEVEL))NT=4
      IF(DELTA.LT.(0.6*XLEVEL))NT=6
      IF(DELTA.LT.(0.4*XLEVEL))NT=8
      IF(DELTA.LT.(0.2*XLEVEL))NT=10
C...
C...  SOLVE FOR THE VECTOR OF DERIVATIVES, DX/DT, IN EQUATION (3) (IN
C...  EFFECT, EQUATION (3) IS PREMULTIPLIED BY THE INVERSE OF JACOBIAN
C...  MATRIX J THROUGH CALLS TO SUBROUTINE DECOMP AND SOLVE).  THE LU
C...  DECOMPOSITION OF THE JACOBIAN MATRIX IS DONE ONLY EVERY NT CALLS
C...  TO DERV THROUGH THE COUNTER IT
      CALL DECOMP(N,N,A,COND,IPVT,WORK)
      IT=0
C...
C...  CHECK THE CONDITION OF MATRIX A BEFORE COMPUTING THE DERIVATIVE
C...  VECTOR, DX/DT.  IF A IS NEAR SINGULAR, TERMINATE THE CURRENT RUN
      IF(COND.LT.1.0E+20)GO TO 2
      WRITE(NO,1)COND
1     FORMAT(1H ,//,
     1 30H THE CONDITION NUMBER OF A IS ,E10.3,33H SO THE CURRENT RUN IS
     1 TERMINATED)
      NSTOP=1
C...
C...  COMPUTE THE DERIVATIVE VECTOR DX/DT (INDIRECTLY VIA ARRAY B)
2     CALL SOLVE(N,N,A,B,IPVT)
C...
C...  TRANSFER ARRAY B TO ARRAY DXDT SO THE DERIVATIVE VECTOR, DX/DT,
C...  IS AVAILABLE IN COMMON/F/
      DO 3 I=1,N
      DXDT(I)=B(I)
3     CONTINUE
      RETURN
      END
      SUBROUTINE FUNC(N,F)
C...
C...                                                -
C...  SUBROUTINE FUNC EVALUATES THE FUNCTION VECTOR F IN EQUATION (3)
C...
C...  ARGUMENT LIST
C...
C...     N     LENGTH OF THE FUNCTION VECTOR (INPUT)
C...
C...     F     ONE-DIMENSIONAL ARRAY CONTAINING THE FUNCTION VECTOR
C...           (OUTPUT)
C...
      COMMON/Y/      X(2)
     3      /C/        HS
      DIMENSION      F(N)
C...
C...                     -
C...  DEFINE THE VECTOR -F (NOTE THE SIGN CHANGE AS REQUIRED BY THE
C...  DAVIDENKO DIFFERENTIAL EQUATION (3) IN SUBROUTINE INITAL.  THIS
C...  SIGN CHANGE IS RELATIVE TO THE JACOBIAN MATRIX PARTIAL DERIVA-
C...  TIVES PROGRAMMED IN SUBROUTINE JACOB)
C...
      IF(X(1).LT.0.)STOP
      F(1)=-1.-HS*(EXP(X(2)*SQRT(X(1)))+3.*X(1)**2)+X(1)
      ARG2=EXP(X(1))+X(2)**2
      F(2)=-0.5-HS*SIN(ARG2)/COS(ARG2)+X(2)
      RETURN
      END
      SUBROUTINE JACOB(N,A)
C...                                                 -
C...  SUBROUTINE JACOB EVALUATES THE JACOBIAN MATRIX J IN EQUATION (3)
C...
C...  ARGUMENT LIST
C...
C...     N     ROW AND COLUMN DIMENSION OF THE JACOBIAN MATRIX (INPUT)
C...
C...     A     TWO-DIMENSIONAL ARRAY CONTAINING THE JACOBIAN MATRIX
C...           (OUTPUT)
C...
      COMMON/Y/      X(2)
     3      /C/        HS
      DIMENSION    A(N,N)
C...                                -
C...  DEFINE THE JACOBIAN MATRIX OF F
C...
C...  FIRST ROW
      IF(X(1).LT.0.)STOP
      SR=SQRT(X(1))
      ARG1=EXP(X(2)*SR)
      A(1,1)=HS*(ARG1*0.5*X(2)*(1./SR)+6.*X(1))-1.
      A(1,2)=HS*ARG1*SR
C...
C...  SECOND ROW
      ARG2=EXP(X(1))+X(2)**2
      SECS=(1./COS(ARG2))**2
      A(2,1)=HS*SECS*EXP(X(1))
      A(2,2)=HS*SECS*(2.*X(2))-1.
      RETURN
      END
      SUBROUTINE NORM(N,A,E)
C...                                                            -
C...  SUBROUTINE NORM EVALUATES THE NORM OF THE JACOBIAN MATRIX J IN
C...  EQUATION (3)
C...
C...  ARGUMENT LIST
C...
C...     N     ROW AND COLUMN DIMENSION OF THE JACOBIAN MATRIX (INPUT)
C...
C...     A     TWO-DIMENSIONAL ARRAY CONTAINING THE JACOBIAN MATRIX
C...           (INPUT)
C...
C...     E     L2 NORM OF THE JACOBIAN MATRIX (OUTPUT)
C...
      DIMENSION    A(N,N)
C...
C...  COMPUTE THE NORM
      E=0.
      DO 1 I=1,N
      DO 1 J=1,N
      E=E+A(I,J)**2
1     CONTINUE
C...
C...  THE NORM IS SQUARE ROOTED TO FACILITATE THE SCALING (AND SELEC-
C...  TION) OF THE HEURISTICS IN SUBROUTINE DERV FOR UPDATING THE
C...  JACOBIAN MATRIX
      E=SQRT(E)
      RETURN
      END
      SUBROUTINE PRINT(NI,NO)
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/      X(2)
     2      /F/   DXDT(2)
     3      /C/        HS,    A(2,2),      B(2),   WORK(2),   IPVT(2),
     4                  N,        IT,        NT,        E1,        E2,
     5              DELTA
C...
C...  DIMENSION THE ARRAYS TO STORE THE RESIDUALS OF EQUATIONS (1) TO
C...  (2) FOR SUBSEQUENT PLOTTING
      DIMENSION    PT(21),   PR1(21),   PR2(21),  PE(2,21),PDELTA(21),
     1            PNT(21)
C...
C...  PRINT A HEADING FOR THE NUMERICAL SOLUTION
      IF(T.GT.0.05)GO TO 3
      WRITE(NO,1)
1     FORMAT(9X,1HT,11X,1HX,11X,1HY,7X,5HDX/DT,7X,5HDY/DT,
     1      10X,2HE1,10X,2HE2,7X,5HDELTA,10X,2HNT)
      IP=0
C...
C...  PRINT THE NUMERICAL SOLUTION
3     WRITE(NO,2)T,(X(I),I=1,N),(DXDT(I),I=1,N),E1,E2,DELTA,NT
2     FORMAT(F10.2,4F12.6,2E12.4,F12.6,I12)
C...
C...  STORE THE LOG OF THE RESIDUALS OF EQUATIONS (1) AND (2), AND
C...  THE PARAMETERS PERTAINING TO THE UPDATING OF THE JACOBIAN MATRIX
C...  FOR SUBSEQUENT PLOTTING
      IP=IP+1
      PT(IP)=T
      CALL FUNC(N,B)
      PR1(IP)=ALOG(ABS(B(1)))
      PR2(IP)=ALOG(ABS(B(2)))
      PE(1,IP)=E1
      PE(2,IP)=E2
      PDELTA(IP)=DELTA
      PNT(IP)=FLOAT(NT)
C...
C...  PLOT THE SOLUTION
      IF(IP.LT.21)RETURN
5     CALL TPLOTS(1,IP,PT,PR1)
      WRITE(NO,11)
11    FORMAT(1H ,/,
     1 49H LOG/R1/ VS T                                    )
      CALL TPLOTS(1,IP,PT,PR2)
      WRITE(NO,12)
12    FORMAT(1H ,/,
     1 49H LOG/R2/ VS T                                    )
      CALL TPLOTS(2,IP,PT,PE)
      WRITE(NO,13)
13    FORMAT(1H ,/,
     1 49H NORM E1, NORM E2 VS T                           )
      CALL TPLOTS(1,IP,PT,PDELTA)
      WRITE(NO,14)
14    FORMAT(1H ,/,
     1 49H DELTA = ABS(E2 - E1)/E1 VS T                    )
      CALL TPLOTS(1,IP,PT,PNT)
      WRITE(NO,15)
15    FORMAT(1H ,/,
     1 49H NT VS T                                         )
C...
C...  ******************************************************************
C...
C...  THE FOLLOWING CALLS TO A CONTINUOUS PLOTTER ARE MACHINE-DEPENDENT
C...  AND WILL HAVE TO BE CONVERTED FOR OTHER COMPUTERS, OR CONVERTED
C...  TO COMMENTS
C...  CALL QIKSAX(3,3)
C...  CALL QIKPLT(PT,   PR1,-IP,3H*T*,9H*LOG/R1/*,2H**,1)
C...  CALL QIKSAX(3,3)
C...  CALL QIKPLT(PT,   PR2,-IP,3H*T*,9H*LOG/R2/*,2H**,1)
C...  CALL QIKSAX(3,3)
C...  CALL QIKPLT(PT,    PE,-IP,3H*T*,9H* E1, E2*,2H**,2)
C...  CALL QIKSAX(3,3)
C...  CALL QIKPLT(PT,PDELTA,-IP,3H*T*,9H* DELTA *,2H**,1)
C...  CALL QIKSAX(3,3)
C...  CALL QIKPLT(PT,   PNT,-IP,3H*T*,9H*   NT  *,2H**,1)
C...
C...  ******************************************************************
      RETURN
      END
      SUBROUTINE DECOMP(NDIM,N,A,COND,IPVT,WORK)
C
      INTEGER NDIM,N
      REAL A(NDIM,N),COND,WORK(N)
      INTEGER IPVT(N)
C
C     DECOMPOSES A REAL MATRIX BY GAUSSIAN ELIMINATION
C     AND ESTIMATES THE CONDITION OF THE MATRIX.
C
C     USE SOLVE TO COMPUTE SOLUTIONS TO LINEAR SYSTEMS.
C
C     INPUT..
C
C        NDIM = DECLARED ROW DIMENSION OF THE ARRAY CONTAINING  A.
C
C        N = ORDER OF THE MATRIX.
C
C        A = MATRIX TO BE TRIANGULARIZED.
C
C     OUTPUT..
C
C        A  CONTAINS AN UPPER TRIANGULAR MATRIX  U  AND A PERMUTED
C          VERSION OF A LOWER TRIANGULAR MATRIX  I-L  SO THAT
C          (PERMUTATION MATRIX)*A = L*U .
C
C        COND = AN ESTIMATE OF THE CONDITION OF  A .
C           FOR THE LINEAR SYSTEM  A*X = B, CHANGES IN  A  AND  B
C           MAY CAUSE CHANGES  COND  TIMES AS LARGE IN  X .
C           IF  COND+1.0 .EQ. COND , A IS SINGULAR TO WORKING
C           PRECISION.  COND  IS SET TO  1.0E+32  IF EXACT
C           SINGULARITY IS DETECTED.
C
C        IPVT = THE PIVOT VECTOR.
C           IPVT(K) = THE INDEX OF THE K-TH PIVOT ROW
C           IPVT(N) = (-1)**(NUMBER OF INTERCHANGES)
C
C     WORK SPACE..  THE VECTOR  WORK  MUST BE DECLARED AND INCLUDED
C                   IN THE CALL.  ITS INPUT CONTENTS ARE IGNORED.
C                   ITS OUTPUT CONTENTS ARE USUALLY UNIMPORTANT.
C
C     THE DETERMINANT OF A CAN BE OBTAINED ON OUTPUT BY
C        DET(A) = IPVT(N) * A(1,1) * A(2,2) * ... * A(N,N).
C
      REAL EK, T, ANORM, YNORM, ZNORM
      INTEGER NM1, I, J, K, KP1, KB, KM1, M
C
      IPVT(N) = 1
      IF (N .EQ. 1) GO TO 80
      NM1 = N - 1
C
C     COMPUTE 1-NORM OF A
C
      ANORM = 0.0
      DO 10 J = 1, N
         T = 0.0
         DO 5 I = 1, N
            T = T + ABS(A(I,J))
    5    CONTINUE
         IF (T .GT. ANORM) ANORM = T
   10 CONTINUE
C
C     GAUSSIAN ELIMINATION WITH PARTIAL PIVOTING
C
      DO 35 K = 1,NM1
         KP1= K+1
C
C        FIND PIVOT
C
         M = K
         DO 15 I = KP1,N
            IF (ABS(A(I,K)) .GT. ABS(A(M,K))) M = I
   15    CONTINUE
         IPVT(K) = M
         IF (M .NE. K) IPVT(N) = -IPVT(N)
         T = A(M,K)
         A(M,K) = A(K,K)
         A(K,K) = T
C
C        SKIP STEP IF PIVOT IS ZERO
C
         IF (T .EQ. 0.0) GO TO 35
C
C        COMPUTE MULTIPLIERS
C
         DO 20 I = KP1,N
             A(I,K) = -A(I,K)/T
   20    CONTINUE
C
C        INTERCHANGE AND ELIMINATE BY COLUMNS
C
         DO 30 J = KP1,N
             T = A(M,J)
             A(M,J) = A(K,J)
             A(K,J) = T
             IF (T .EQ. 0.0) GO TO 30
             DO 25 I = KP1,N
                A(I,J) = A(I,J) + A(I,K)*T
   25        CONTINUE
   30    CONTINUE
   35 CONTINUE
C
C     COND = (1-NORM OF A)*(AN ESTIMATE OF 1-NORM OF A-INVERSE)
C     ESTIMATE OBTAINED BY ONE STEP OF INVERSE ITERATION FOR THE
C     SMALL SINGULAR VECTOR.  THIS INVOLVES SOLVING TWO SYSTEMS
C     OF EQUATIONS, (A-TRANSPOSE)*Y = E  AND  A*Z = Y  WHERE  E
C     IS A VECTOR OF +1 OR -1 CHOSEN TO CAUSE GROWTH IN Y.
C     ESTIMATE = (1-NORM OF Z)/(1-NORM OF Y)
C
C     SOLVE (A-TRANSPOSE)*Y = E
C
      DO 50 K = 1, N
         T = 0.0
         IF (K .EQ. 1) GO TO 45
         KM1 = K-1
         DO 40 I = 1, KM1
            T = T + A(I,K)*WORK(I)
   40    CONTINUE
   45    EK = 1.0
         IF (T .LT. 0.0) EK = -1.0
         IF (A(K,K) .EQ. 0.0) GO TO 90
         WORK(K) = -(EK + T)/A(K,K)
   50 CONTINUE
      DO 60 KB = 1, NM1
         K = N - KB
         T = 0.0
         KP1 = K+1
         DO 55 I = KP1, N
            T = T + A(I,K)*WORK(K)
   55    CONTINUE
         WORK(K) = T
         M = IPVT(K)
         IF (M .EQ. K) GO TO 60
         T = WORK(M)
         WORK(M) = WORK(K)
         WORK(K) = T
   60 CONTINUE
C
      YNORM = 0.0
      DO 65 I = 1, N
         YNORM = YNORM + ABS(WORK(I))
   65 CONTINUE
C
C     SOLVE A*Z = Y
C
      CALL SOLVE(NDIM, N, A, WORK, IPVT)
C
      ZNORM = 0.0
      DO 70 I = 1, N
         ZNORM = ZNORM + ABS(WORK(I))
   70 CONTINUE
C
C     ESTIMATE CONDITION
C
      COND = ANORM*ZNORM/YNORM
      IF (COND .LT. 1.0) COND = 1.0
      RETURN
C
C     1-BY-1
C
   80 COND = 1.0
      IF (A(1,1) .NE. 0.0) RETURN
C
C     EXACT SINGULARITY
C
   90 COND = 1.0E+32
      RETURN
      END
      SUBROUTINE SOLVE(NDIM, N, A, B, IPVT)
C
      INTEGER NDIM, N, IPVT(N)
      REAL A(NDIM,N),B(N)
C
C   SOLUTION OF LINEAR SYSTEM, A*X = B .
C   DO NOT USE IF DECOMP HAS DETECTED SINGULARITY.
C
C   INPUT..
C
C     NDIM = DECLARED ROW DIMENSION OF ARRAY CONTAINING A .
C
C     N = ORDER OF MATRIX.
C
C     A = TRIANGULARIZED MATRIX OBTAINED FROM DECOMP .
C
C     B = RIGHT HAND SIDE VECTOR.
C
C     IPVT = PIVOT VECTOR OBTAINED FROM DECOMP .
C
C   OUTPUT..
C
C     B = SOLUTION VECTOR, X .
C
      INTEGER KB, KM1, NM1, KP1, I, K, M
      REAL T
C
C     FORWARD ELIMINATION
C
      IF (N .EQ. 1) GO TO 50
      NM1 = N-1
      DO 20 K = 1, NM1
         KP1 = K+1
         M = IPVT(K)
         T = B(M)
         B(M) = B(K)
         B(K) = T
         DO 10 I = KP1, N
             B(I) = B(I) + A(I,K)*T
   10    CONTINUE
   20 CONTINUE
C
C     BACK SUBSTITUTION
C
      DO 40 KB = 1,NM1
         KM1 = N-KB
         K = KM1+1
         B(K) = B(K)/A(K,K)
         T = -B(K)
         DO 30 I = 1, KM1
             B(I) = B(I) + A(I,K)*T
   30    CONTINUE
   40 CONTINUE
   50 B(1) = B(1)/A(1,1)
      RETURN
      END
DAHLQUIST, G., ET AL, NUMERICAL METHODS, P253
0.        10.0      0.5
    2 1000    1    1  REL 0.001
DAHLQUIST, G., ET AL, NUMERICAL METHODS, P253
0.        20.0      1.0
    2 1000    1    1  REL 0.001
DAHLQUIST, G., ET AL, NUMERICAL METHODS, P253
0.        20.0      1.0
    2 1000    1    1  REL 0.001
END OF RUNS
*APP MATH09
      SUBROUTINE INITAL
C...
C...  A GOOD TEST PROBLEM IN PARTIAL DIFFERENTIAL EQUATIONS FOR THE
C...  NUMERICAL METHOD OF LINES
C...
C...  THE FOLLOWING PROBLEM IS DISCUSSED IN RICE, J. R., NUMERICAL
C...  METHODS, SOFTWARE AND ANALYSIS, MCGRAW-HILL BOOK COMPANY, NY,
C...  PP 351-352.
C...
C...  THE FOLLOWING TWO SIMULTANEOUS, NONLINEAR, ONE-DIMENSIONAL,
C...  INITIAL-VALUE PARTIAL DIFFERENTIAL EQUATIONS PROVIDE A GOOD
C...  INDICATION OF THE VERSATILITY AND FLEXIBILITY OF THE NUMERICAL
C...  METHOD OF LINES
C...
C...     U  = ((V - 1)*U )  + (16*X*T - 2*T - 16*(V - 1))*(U - 1)
C...      T             X X
C...                                                                 (1)
C...                  -4*X
C...          + 10*X*E
C...
C...                                                  -4*X
C...     V  = V   + U  + 4*U - 4 + X**2 - 2*T - 10*T*E               (2)
C...      T    XX    X
C...
C...  E IS THE BASE OF THE NATURAL LOGARITHMS.
C...
C...  THE BOUNDARY CONDITIONS ARE
C...
C...     U(T,0) = V(T,0) = 1                                      (3)(4)
C...
C...     3*U(T,1) + U (T,1) = 3, 5*V (T,1) = (E**4)*(U(T,1) - 1)  (5)(6)
C...                 X              X
C...
C...  AND THE INITIAL CONDITIONS ARE
C...
C...     U(0,X) = V(0,X) = 1                                      (7)(8)
C...
C...  THE ANALYTICAL SOLUTION TO EQUATIONS (1) TO (8) AS REPORTED IN THE
C...  REFERENCE CITED ON THE FIRST DATA CARD IS
C...
C...                          -4*X
C...     U(T,X) = 1 + 10*X*T*E    , V(T,X) = 1 + (X**2)*T        (9)(10)
C...
C...  THUS, EQUATIONS (9) AND (10) CAN BE USED AS AN ABSOLUTE STANDARD
C...  FOR THE NUMERICAL SOLUTION.
C...
      COMMON/T/T,NFIN,NORUN
     1      /Y/  U(21),  V(21)
     2      /F/ UT(21), VT(21)
     3     /SD/ UX(21),UXX(21), VX(21),VXX(21)
     4      /X/  X(21)
     5      /P/      N,     E4
C...  SET THE NUMBER OF SPATIAL INTERVALS AND THEIR LENGTH
      N=20
      DX=1./FLOAT(N)
C...
C...  COMPUTE THE VALUES OF X ALONG THE SPATIAL GRID
      N=N+1
      DO 1 I=1,N
      X(I)=DX*FLOAT(I-1)
1     CONTINUE
C...
C...  SET THE INITIAL CONDITIONS, EQUATIONS (7) AND (8)
      DO 2 I=1,N
      U(I)=1.
      V(I)=1.
2     CONTINUE
C...
C...  SET THE CONSTANT E**4 USED IN ONE OF THE BOUNDARY CONDITIONS
      E4=EXP(1.)**4
      RETURN
      END
      SUBROUTINE DERV
      COMMON/T/T,NFIN,NORUN
     1      /Y/  U(21),  V(21)
     2      /F/ UT(21), VT(21)
     3     /SD/ UX(21),UXX(21), VX(21),VXX(21)
     4      /X/  X(21)
     5      /P/      N,     E4
C...
C...  APPLY THE LEFT BOUNDARY CONDITIONS AS CONSTRAINTS, EQUATIONS (3)
C...  AND (4)
       U(1)=1.
      UT(1)=0.
       V(1)=1.
      VT(1)=0.
C...
C...  COMPUTE THE FIRST-ORDER SPATIAL DERIVATIVES
      XL=X(1)
      XU=X(N)
C...
C...     THREE-POINT CENTERED DIFFERENCES
      IF(NORUN.EQ.1)CALL DSS002(XL,XU,N,U,UX)
      IF(NORUN.EQ.1)CALL DSS002(XL,XU,N,V,VX)
C...
C...     FIVE-POINT CENTERED DIFFERENCES
      IF(NORUN.EQ.2)CALL DSS004(XL,XU,N,U,UX)
      IF(NORUN.EQ.2)CALL DSS004(XL,XU,N,V,VX)
C...
C...  APPLY THE RIGHT BOUNDARY CONDITIONS AS CONSTRAINTS, EQUATIONS (5)
C...  AND (6)
      UX(N)=3.-3.*U(N)
      VX(N)=E4*(U(N)-1.)/5.
C...
C...  COMPUTE THE SECOND-ORDER SPATIAL DERIVATIVES
C...
C...     THREE-POINT CENTERED DIFFERENCES
      IF(NORUN.EQ.1)CALL DSS002(XL,XU,N,VX,VXX)
C...
C...     FIVE-POINT CENTERED DIFFERENCES
      IF(NORUN.EQ.2)CALL DSS004(XL,XU,N,VX,VXX)
C...
C...  NOTE THAT ARRAY VX IS USED AS TEMPORARY STORAGE IN THE CALCULATION
C...  OF THE TERM ((V-1)*U )  WHICH IS FINALLY STORED IN ARRAY UXX
C...                      X X
      DO 1 I=1,N
      VX(I)=(V(I)-1.)*UX(I)
1     CONTINUE
      IF(NORUN.EQ.1)CALL DSS002(XL,XU,N,VX,UXX)
      IF(NORUN.EQ.2)CALL DSS004(XL,XU,N,VX,UXX)
C...
C...  ASSEMBLE THE PDES, EQUATIONS (1) AND (2)
      DO 3 I=2,N
      EX=EXP(-4.*X(I))
      UT(I)=UXX(I)+(16.*X(I)*T-2.*T-16.*(V(I)-1.))*(U(I)-1.)+10.*X(I)*EX
      VT(I)=VXX(I)+UX(I)+4.*U(I)-4.+X(I)**2-2.*T-10.*T*EX
3     CONTINUE
      RETURN
      END
      SUBROUTINE PRINT(NI,NO)
      COMMON/T/T,NFIN,NORUN
     1      /Y/  U(21),  V(21)
     2      /F/ UT(21), VT(21)
     3     /SD/ UX(21),UXX(21), VX(21),VXX(21)
     4      /X/  X(21)
     5      /P/      N,     E4
     6      /A/ UA(21), DU(21), VA(21), DV(21)
C...
C...  PRINT A HEADING FOR THE NUMERICAL AND ANALYTICAL SOLUTIONS
      IF(T.LT.0.01)WRITE(NO,1)
1     FORMAT(23H  U =  NUMERICAL U(X,T),/,
     1       23H UA = ANALYTICAL U(X,T),/,
     2       23H DIFF U = U - UA       ,//,
     3       23H  V =  NUMERICAL V(X,T),/,
     4       23H VA = ANALYTICAL V(X,T),/,
     5       23H DIFF V = V - VA       ,//,
     6       9X,1HT,9X,1HX,11X,1HU,10X,2HUA,6X,6HDIFF U,
     7                     11X,1HV,10X,2HVA,6X,6HDIFF V)
C...
C...  COMPUTE ANALYTICAL SOLUTIONS (9) AND (10), DIFFERENCES BETWEEN THE
C...  NUMERICAL AND ANALYTICAL SOLUTIONS (NOTE THAT THESE CALCULATIONS
C...  ARE DONE FOR EVERY FOURTH GRID POINT IN X TO REDUCE THE VOLUME OF
C...  THE FINAL PRINTOUT)
      DO 2 I=1,N,4
      UA(I)=1.+10.*X(I)*T*EXP(-4.*X(I))
      DU(I)=U(I)-UA(I)
      VA(I)=1.+(X(I)**2)*T
      DV(I)=V(I)-VA(I)
2     CONTINUE
C...
C...  PRINT THE NUMERICAL SOLUTION, ANALYTICAL SOLUTION, DIFFERENCE
C...  BETWEEN THE SOLUTIONS
      WRITE(NO,3)(T,X(I),U(I),UA(I),DU(I),V(I),VA(I),DV(I),I=1,N,4)
3     FORMAT(2F10.3,2F12.4,E12.3,2F12.4,E12.3)
      WRITE(NO,4)
4     FORMAT(1H ,/)
      RETURN
      END
MADSEN, ET AL, LAPIDUS, ET AL, NUM METH FOR DIFF SYS, PP 238-239, DSS002
0.        2.0       0.4
   42 1000    1    1  REL 0.001
MADSEN, ET AL, LAPIDUS, ET AL, NUM METH FOR DIFF SYS, PP 238-239, DSS004
0.        2.0       0.4
   42 1000    1    1  REL 0.001
END OF RUNS
*APP MATH10
      SUBROUTINE INITAL
C...
C...  A NEW FINITE DIFFERENCE APPROXMATION OF SECOND-ORDER DERIVATIVES
C...  WITH NEUMANN BOUNDARY CONDITIONS
C...
C...  IN THE FOLLOWING PROBLEM, A NEW FINITE DIFFERENCE APPROXIMATION
C...  (AT LEAST AS FAR AS THE AUTHORS, W. E. SCHIESSER AND G. A. STENGLE
C...  KNOW) FOR A SECOND-ORDER SPATIAL DERIVATIVE WHICH AUTOMATICALLY
C...  INCLUDES NEUMANN BOUNDARY CONDITIONS IS DERIVED AND TESTED IN
C...  SUBROUTINE DERV2.  THE OBJECTIVES IN DERIVING THIS APPROXIMATION
C...  WERE
C...
C...     (1)  THE APPROXIMATION WOULD COMPUTE A SECOND-ORDER SPATIAL
C...          DERIVATIVE DIRECTLY FROM THE DEPENDENT VARIABLE VECTOR
C...          WITHOUT HAVING TO COMPUTE AN INTERMEDIATE FIRST-ORDER
C...          DERIVATIVE BY STAGEWISE DIFFERENTIATION, I.E., U TO UX
C...          TO UXX WOULD BE REPLACED BY U TO UXX.
C...
C...     (2)  A NEUMANN BOUNDARY CONDITION (INVOLVING THE FIRST-ORDER
C...          DERIVATIVE UX) WOULD AUTOMATICALLY BE INCLUDED AT THE
C...          UPPER AND LOWER BOUNDARY VALUES OF X.
C...
C...     (3)  ONLY BOUNDARY AND INTERIOR VALUES OF THE DEPENDENT VARI-
C...          ABLE, U, WOULD BE USED, I.E., THE USE OF FICTITIOUS POINTS
C...          OUTSIDE THE USUAL X DOMAIN WOULD BE AVOIDED.
C...
C...  THE DERIVATION OF THE APPROXIMATION WITH THESE PROPERTIES THROUGH
C...  TAYLOR SERIES EXPANSIONS IS DETAILED IN SUBROUTINE DERV2.  THE
C...  APPROXIMATION IS THEN PROGRAMMED IN SUBROUTINE DERV2 FOR THE TWO
C...  DIMENSIONAL PARABOLIC PDE DISCUSSED BELOW.
C...
C...  A SOLUTION IS ALSO PROGRAMMED IN SUBROUTINE DERV1 BASED ON CON-
C...  VENTIONAL THREE-POINT CENTERED APPROXIMATIONS.
C...
C...  AQUIFER SIMULATION IN CARTESIAN COORDINATES
C...
C...  THE AQUIFER TO BE ANALYZED IS DEPICTED BELOW*
C...
C                   .
C                   .
C                   .           H (X,YL,T) = 0
C                   .            Y
C              Y=YL . . . . . . . . . . . . . . . . . .
C                   .   +                             .
C                   .   .                             .
C                   .   .                             .
C                   .   .                             .
C                   .   .                             .
C                   .   .                             .
C                   .   .                             .
C     H (0,Y,T) = 0 . 2000 M        H(X,Y,T)          . H (XL,Y,T) = 0
C      X            .   .                             .  X
C                 + .   .                             .
C                 . .   .                             .
C                 . .   .                             .
C                 . .   .                             .
C                 Y .   .                             .
C                   .+ . . . . . . 2000 M . . . . . .+.
C               Y=0 .   +                             .
C         . . . . . W . . . . . . . . . . . . . . . . . . . .
C                  X=0          H (X,0,T) = 0        X=XL
C                                Y
C                       X ---+
C
C...
C...  *THIS PROBLEM WAS PROVIDED BY DR. SHIV O. PRASHER, DEPARTMENT OF
C...  AGRICULTURAL ENGINEERING, MACDONALD COLLGE, MCGILL UNIVERSITY,
C...  21,111 LAKESHORE ROAD, STE. ANNE DE BELLEVUE, P.Q., H9X 1C0,
C...  CANADA
C...
C...  THE AQUIFER IS MODELED AS A RECTANGULAR DOMAIN IN THE X-Y
C...  COORDINATE SYSTEM, MEASURING XL (2000 M) BY YL (2000 M). THE
C...  HEIGHT OF WATER AT ANY POINT IN THE AQUIFER IS H(X,Y,T).  ZERO
C...  FLOW BOUNDARY CONDITIONS ARE ASSUMED AT X = 0, X = XL, Y = 0
C...  AND Y = YL.  A WELL FOR WITHDRAWAL OF WATER IS LOCATED AT X
C...  = 0, Y = 0 (DESIGNATED AS W).
C...
C...  THE FOLLOWING TWO-DIMENSIONAL PARTIAL DIFFERENTIAL EQUATION
C...  (PDE) RELATES THE WATER HEIGHT TO X, Y AND T (TIME)
C...
C...     S*H  = TR*(H   + H  ) + R                                 (1)
C...        T        XX    YY
C...
C...  WHERE
C...
C...     H      HYDRAULIC HEAD
C...
C...     X      HORIZONTAL COORDINATE
C...
C...     Y      VERTICAL COORDINATE
C...
C...     T      TIME
C...
C...     TR     TRANSMISSIVITY
C...
C...     R      RECHARGE RATE
C...
C...     S      STORAGE COEFFICIENT
C...
C...  THE INITIAL AND BOUNDARY CONDITIONS FOR EQUATION (1) ARE
C...
C...     H (0,Y,T) = H (XL,Y,T) = H (X,0,T) = H (X,YL,T) = 0
C...      X           X            Y           Y
C...                                                   (2)(3)(4)(5)(6)
C...     H(X,Y,0) = H0
C...
C...     H0     INITIAL HYDRAULIC HEAD
C...
C...  THE FOLLOWING CODING IS FOR EQUATIONS (1) TO (6).
C...
      COMMON/T/      TIME,     NSTOP,     NORUN
     1      /Y/  H(11,11)
     2      /F/ HT(11,11)
     3      /S/ HX(11,11), HY(11,11)
     4      /C/         Q,         T,         S,        XL,        YL,
     5                 DX,        DY,         A,         R,        H0
     6      /I/         N,        IP
C...
C...  SET THE MODEL PARAMETERS
C...
C...  NUMBER OF GRID POINTS IN THE X AND Y DIRECTIONS
      N=11
C...
C...  WITHDRAWAL RATE (M**3/DAY)
      Q=-2000.
C...
C...  TRANSMISSIVITY (M**2/DAY)
      T=300.
C...
C...  STORAGE COEFFICIENT (DIMENSIONLESS)
      S=0.002
C...
C...  LENGTH OF THE AQUIFER IN THE X DIRECTION (M)
      XL=2000.
C...
C...  LENGTH OF THE AQUIFER IN THE Y DIRECTION (M)
      YL=2000.
C...
C...  GRID SPACING IN THE X DIRECTION
      DX=XL/FLOAT(N-1)
C...
C...  GRID SPACING IN THE Y DIRECTION
      DY=YL/FLOAT(N-1)
C...
C...  AREA OF A GRID UNIT (M**2)
      A=DX*DY
C...
C...  RECHARGE RATE (M/DAY)
      R=Q/(200.0**2)
C...
C...  INITIAL HYDRAULIC HEAD (M)
      H0=10.
C...
C...  SET THE INITIAL CONDITIONS
      DO 1 I=1,N
      DO 1 J=1,N
      H(I,J)=H0
1     CONTINUE
C...
C...  COMPUTE THE INITIAL DERIVATIVES
      CALL DERV
      IP=0
      RETURN
      END
      SUBROUTINE DERV
      COMMON/T/      TIME,     NSTOP,     NORUN
     1      /Y/  H(11,11)
     2      /F/ HT(11,11)
     3      /S/ HX(11,11), HY(11,11)
     4      /C/         Q,         T,         S,        XL,        YL,
     5                 DX,        DY,         A,         R,        H0
     6      /I/         N,        IP
C...
C...  SOLUTION BY THREE-POINT CENTERED APPROXIMATIONS
      IF(NORUN.EQ.1)CALL DERV1
C...
C...  SOLUTION BY THREE AND FOUR-POINT APPROXIMATIONS
C...  WITH NO FICTITIOUS POINTS
      IF(NORUN.EQ.2)CALL DERV2
      RETURN
      END
      SUBROUTINE DERV1
      COMMON/T/      TIME,     NSTOP,     NORUN
     1      /Y/  H(11,11)
     2      /F/ HT(11,11)
     3      /S/ HX(11,11), HY(11,11)
     4      /C/         Q,         T,         S,        XL,        YL,
     5                 DX,        DY,         A,         R,        H0
     6      /I/         N,        IP
C...
C...  SET CONSTRAINTS ON THE SOLUTION
      DO 7 I=1,N
      DO 8 J=1,N
      IF(H(I,J).LT.0.)H(I,J)=0.
8     CONTINUE
7     CONTINUE
C...
C...  BOUNDARY POINTS FROM I = 2 TO N-1
      DO 1 I=2,N-1
C...
C...  Y = 0
      HT(I,1)=(T/S)*(   H(I+1,  1)-2.*H(I  ,  1)+   H(I-1,  1))/DX**2
     1       +(T/S)*(2.*H(I  ,  2)-2.*H(I  ,  1)              )/DY**2
C...
C...  Y = YL
      HT(I,N)=(T/S)*(   H(I+1,N  )-2.*H(I  ,N  )+   H(I-1,N  ))/DX**2
     1       +(T/S)*(2.*H(I  ,N-1)-2.*H(I  ,N  )              )/DY**2
1     CONTINUE
C...
C...  BOUNDARY POINTS FROM J = 2 TO N-1
      DO 2 J=2,N-1
C...
C...  X = 0
      HT(1,J)=(T/S)*(2.*H(  2,J  )-2.*H(  1,J  )              )/DX**2
     1       +(T/S)*(   H(  1,J+1)-2.*H(  1,J  )+   H(  1,J-1))/DY**2
C...
C...  X = XL
      HT(N,J)=(T/S)*(2.*H(N-1,J  )-2.*H(N  ,J  )              )/DX**2
     1       +(T/S)*(   H(N  ,J+1)-2.*H(N  ,J  )+   H(N  ,J-1))/DY**2
2     CONTINUE
C...
C...  CORNER POINTS
C...
C...  X = 0, Y = 0
      HT(1,1)=(T/S)*(2.*H(  2,  1)-2.*H(  1,  1)              )/DX**2
     1       +(T/S)*(2.*H(  1,  2)-2.*H(  1,  1)              )/DY**2
C...
C...  X = XL, Y = 0
      HT(N,1)=(T/S)*(2.*H(N-1,  1)-2.*H(N  ,  1)              )/DX**2
     1       +(T/S)*(2.*H(N  ,  2)-2.*H(N  ,  1)              )/DY**2
C...
C...  X = 0, Y = YL
      HT(1,N)=(T/S)*(2.*H(  2,N  )-2.*H(  1,N  )              )/DX**2
     1       +(T/S)*(2.*H(  1,N-1)-2.*H(  1,N  )              )/DY**2
C...
C...  X = XL, Y = YL
      HT(N,N)=(T/S)*(2.*H(N-1,N  )-2.*H(N  ,N  )              )/DX**2
     1       +(T/S)*(2.*H(N  ,N-1)-2.*H(N  ,N  )              )/DY**2
C...
C...  INTERIOR POINTS
      DO 4 I=2,N-1
      DO 4 J=2,N-1
      HT(I,J)=(T/S)*(   H(I+1,J  )-2.*H(I  ,J  )+   H(I-1,J  ))/DX**2
     1       +(T/S)*(   H(I  ,J+1)-2.*H(I  ,J  )+   H(I  ,J-1))/DY**2
4     CONTINUE
C...
C...  INCLUDE THE WELL
      HT(1,1)=HT(1,1)+R/S
      RETURN
      END
      SUBROUTINE DERV2
      COMMON/T/      TIME,     NSTOP,     NORUN
     1      /Y/  H(11,11)
     2      /F/ HT(11,11)
     3      /S/ HX(11,11), HY(11,11)
     4      /C/         Q,         T,         S,        XL,        YL,
     5                 DX,        DY,         A,         R,        H0
     6      /I/         N,        IP
C...
C...  THE FOLLOWING DERIVATION IS FOR A SET OF SECOND-ORDER, FOUR-POINT
C...  APPROXIMATIONS THAT CAN BE USED AT THE BOUNDARIES.  THESE APPROX-
C...  IMATIONS HAVE THE FEATURES
C...
C...     (1)  ONLY INTERIOR AND BOUNDARY POINTS ARE USED (I.E., NO
C...          FICTITIOUS POINT ARE USED)
C...
C...     (2)  THE NORMAL DERIVATIVE AT THE BOUNDARY IS INCLUDED AS PART
C...          OF THE APPROXIMATION.
C...
C...  THE DERIVATION IS BY PROFESSOR GILBERT A. STENGLE, DEPARTMENT OF
C...  MATHEMATICS, LEHIGH UNIVERSITY, BETHLEHEM, PA 18015, AND WAS DONE
C...  ON DECEMBER 7, 1985.
C...
C...  FOR AN APPROXIMATION AT THE LEFT BOUNDARY, INVOLVING THE POINTS
C...  I, I+1, I+2 AND I+3, CONSIDER THE FOLLOWING TAYLOR SERIES EXPAN-
C...  SIONS
C...
C...                  UX(I)( DX)   UXX(I)( DX)**2   UXXX(I)( DX)**3
C...  U(I+1) = U(I) + ---------- + -------------- + --------------- +...
C...                       1             2                 6
C...
C...
C...                  UX(I)(2DX)   UXX(I)(2DX)**2   UXXX(I)(2DX)**3
C...  U(I+2) = U(I) + ---------- + -------------- + --------------- +...
C...                       1             2                 6
C...
C...  IF WE NOW FORM THE FOLLOWING LINEAR COMBINATION, INVOLVING CON-
C...  STANTS A, B, C AND D TO BE DETERMINED, AND USE THE PRECEDING TWO
C...  TAYLOR SERIES,
C...
C...     A*U(I) + B*UX(I) + C*U(I+1) + D*U(I+2)
C...
C...  WE HAVE
C...
C...     A*U(I) + B*UX(I) + C*U(I+1) + D*U(I+2) =
C...
C...     (A + B + C + D)*U(I) +
C...
C...     (B + DX*C + 2*DX*D)*UX(I) +
C...
C...     (C*(DX**2)/2 + D*((2*DX)**2)/2)*UXX(I) +
C...
C...     (C*(DX**3)/6 + D*((2*DX)**3)/6)*UXXX(I) + O(H**4)
C...
C...  THE THIRD DERIVATIVE, UXXX(I), CAN BE DROPPED BY TAKING
C...
C...     C = -8*D
C...
C...  THE SECOND DERIVATIVE, UXX(I), CAN BE RETAINED BY TAKING
C...
C...     (DX**2)(C/2 + 2*D) = 1
C...
C...  WHICH, WHEN COMBINED WITH THE PRECEDING RESULT GIVES
C...
C...     D = -1/(2*(DX**2))
C...
C...     C = 4/(DX**2)
C...
C...  THE FIRST DERIVATIVE, UX(I), CAN BE DROPPED BY TAKING
C...
C...     B + DX*C + 2*DX*D = 0
C...
C...  OR
C...
C...     B = -DX*C - 2*DX*D = -4/DX - 2*DX*(-1/(2*(DX**2))) = -3/DX
C...
C...  FINALLY, U(I), CAN BE DROPPED BY TAKING
C...
C...     A = - C - D = 8*D - D = -7*D = -7/(2*(DX**2))
C...
C...  IF WE NOW SOLVE FOR THE DERIVATIVE OF INTEREST, UXX(I),
C...
C...     UXX(I) = -7/(2(DX**2))*U(I) - 3/DX*UX(I)
C...
C...              + 8/(DX**2)*U(I+1) - 1/(2*(DX**2))U(I+2) + O(DX**2)
C...
C...       = (1/(2*(DX**2)))*(-U(I+2) + 8*U(I+1) - 7*U(I) - 6*DX*UX(I))
C...
C...         + O(DX**2)
C...
C...  WHICH IS THE FOUR-POINT, SECOND-ORDER APPROXIMATION FOR THE SECOND
C...  DERIVATIVE, UXX(I), INCLUDING THE FIRST DERIVATIVE, UX(I).
C...
C...  THREE CHECKS OF THIS APPROXIMATION CAN EASILY BE MADE FOR U(I) =
C...  1, U(I) = X AND U(I) = X**2
C...
C...     UXX(I) = (1/(2*(DX**2)))*(-1 + 8*1 - 7*1 - 6*DX*0) = 0
C...
C...     UXX(I) = (1/(2*(DX**2)))*(-(X + 2*DX) + 8*(X + DX)
C...
C...              -7*X - 6*DX*1) = 0
C...
C...     UXX(I) = (1/(2*(DX**2)))*(-(X + 2*DX)**2 + 8*(X + DX)**2
C...
C...            - 7*(X**2) - 6*DX*(2*X))
C...
C...             = (-  X**2 -  4*X*DX - 4*DX**2
C...
C...               + 8*X**2 + 16*X*DX + 8*DX**2
C...
C...               - 7*X**2 - 12*X*DX)/(2*(DX**2)) = 2
C...
C...  THE PRECEDING APPROXIMATION FOR UXX(I) CAN BE APPLIED AT THE
C...  LEFT BOUNDARY VALUE OF X TAKING I = 1.  AN APPROXIMATION AT
C...  THE RIGHT BOUNDARY IS OBTAINED BY TAKING DX = -DX AND I = -I
C...  IN THE PRECEDING APPROXIMATION
C...
C...     UXX(I)
C...
C...       = (1/(2*(DX**2)))*(-U(I-2) + 8*U(I-1) - 7*U(I) + 6*DX*UX(I))
C...
C...         + O(DX**2)
C...
C...  THESE TWO APPROXIMATIONS ARE NOW PROGRAMMED IN THE FOLLOWING CODE
C...
C...  BOUNDARY CONDITIONS
      DO 6 I=1,N
      HY(I,1)=0.
      HY(I,N)=0.
6     CONTINUE
      DO 7 J=1,N
      HX(1,J)=0.
      HX(N,J)=0.
7     CONTINUE
C...
C...  BOUNDARY POINTS FROM I = 2 TO N-1
      DO 1 I=2,N-1
C...
C...  Y = 0
      HT(I,1)=(T/(S*2.*DX**2))*
     1       ((      1.)*H(I+1,  1)
     2       +(     -2.)*H(I  ,  1)
     3       +(      1.)*H(I-1,  1))
     4       +(T/(S*2.*DY**2))*
     5       ((     -7.)*H(I  ,  1)
     6       +(      8.)*H(I  ,  2)
     7       +(     -1.)*H(I  ,  3)
     8       +(     -6.)*HY(I ,  1)*DY)
C...
C...  Y = YL
      HT(I,N)=(T/(S*2.*DX**2))*
     1       ((      1.)*H(I+1,N  )
     2       +(     -2.)*H(I  ,N  )
     3       +(      1.)*H(I-1,N  ))
     4       +(T/(S*2.*DY**2))*
     5       ((     -7.)*H(I  ,N  )
     6       +(      8.)*H(I  ,N-1)
     7       +(     -1.)*H(I  ,N-2)
     8       +(      6.)*HY(I ,N  )*DY)
1     CONTINUE
C...
C...  BOUNDARY POINTS FROM J = 2 TO N-1
      DO 2 J=2,N-1
C...
C...  X = 0
      HT(1,J)=(T/(S*2.*DX**2))*
     1       ((     -7.)*H(  1,J  )
     2       +(      8.)*H(  2,J  )
     3       +(     -1.)*H(  3,J  )
     4       +(     -6.)*HX( 1,J  )*DX)
     5       +(T/(S*2.*DY**2))*
     6       ((      1.)*H(  1,J-1)
     7       +(     -2.)*H(  1,J  )
     8       +(      1.)*H(  1,J+1))
C...
C...  X = XL
      HT(N,J)=(T/(S*2.*DX**2))*
     1       ((     -7.)*H(N  ,J  )
     2       +(      8.)*H(N-1,J  )
     3       +(     -1.)*H(N-2,J  )
     4       +(      6.)*HX(N ,J  )*DX)
     5       +(T/(S*2.*DY**2))*
     6       ((      1.)*H(N  ,J-1)
     7       +(     -2.)*H(N  ,J  )
     8       +(      1.)*H(N  ,J+1))
2     CONTINUE
C...
C...  CORNER POINTS
C...
C...  X = 0, Y = 0
      HT(1,1)=(T/(S*2.*DX**2))*
     1       ((     -7.)*H(  1,  1)
     2       +(      8.)*H(  2,  1)
     3       +(     -1.)*H(  3,  1)
     4       +(     -6.)*HX( 1,  1)*DX)
     5       +(T/(S*2.*DY**2))*
     6       ((     -7.)*H(  1,  1)
     7       +(      8.)*H(  1,  2)
     8       +(     -1.)*H(  1,  3)
     9       +(     -6.)*HY( 1,  1)*DY)
C...
C...  X = XL, Y = 0
      HT(N,1)=(T/(S*2.*DX**2))*
     1       ((     -7.)*H(N  ,  1)
     2       +(      8.)*H(N-1,  1)
     3       +(     -1.)*H(N-2,  1)
     4       +(      6.)*HX(N ,  1)*DX)
     5       +(T/(S*2.*DY**2))*
     6       ((     -7.)*H(N  ,  1)
     7       +(      8.)*H(N  ,  2)
     8       +(     -1.)*H(N  ,  3)
     9       +(     -6.)*HY(N ,  1)*DY)
C...
C...  X = 0, Y = YL
      HT(1,N)=(T/(S*2.*DX**2))*
     1       ((     -7.)*H(  1,N  )
     2       +(      8.)*H(  2,N  )
     3       +(     -1.)*H(  3,N  )
     4       +(     -6.)*HX( 1,N  )*DX)
     4       +(T/(S*2.*DY**2))*
     5       ((     -7.)*H(  1,N  )
     6       +(      8.)*H(  1,N-1)
     7       +(     -1.)*H(  1,N-2)
     8       +(      6.)*HY( 1,N  )*DY)
C...
C...  X = XL, Y = YL
      HT(N,N)=(T/(S*2.*DX**2))*
     1       ((     -7.)*H(N  ,N  )
     2       +(      8.)*H(N-1,N  )
     3       +(     -1.)*H(N-2,N  )
     4       +(      6.)*HX(N ,N  )*DX)
     5       +(T/(S*2.*DY**2))*
     6       ((     -7.)*H(N  ,N  )
     7       +(      8.)*H(N  ,N-1)
     8       +(     -1.)*H(N  ,N-2)
     9       +(      6.)*HY(N ,N  )*DY)
C...
C...  INTERIOR POINTS
      DO 4 I=2,N-1
      DO 4 J=2,N-1
      HT(I,J)=(T/S)*(   H(I+1,J  )-2.*H(I  ,J  )+   H(I-1,J  ))/DX**2
     1       +(T/S)*(   H(I  ,J+1)-2.*H(I  ,J  )+   H(I  ,J-1))/DY**2
4     CONTINUE
C...
C...  INCLUDE THE WELL
      HT(1,1)=HT(1,1)+R/S
      RETURN
      END
      SUBROUTINE PRINT(NI,NO)
      COMMON/T/      TIME,     NSTOP,     NORUN
     1      /Y/  H(11,11)
     2      /F/ HT(11,11)
     3      /S/ HX(11,11), HY(11,11)
     4      /C/         Q,         T,         S,        XL,        YL,
     5                 DX,        DY,         A,         R,        H0
     6      /I/         N,        IP
C...
C...  PRINT THE SOLUTION
      NS=2
      WRITE(NO,1)TIME
1     FORMAT(1H ,//,5H T = ,E10.3,//,
     1       11H   H(X,Y,T))
      WRITE(NO,10)((  H(I,J),I=1,N,NS),J=1,N,NS)
      WRITE(NO,6)
6     FORMAT(11H  HT(X,Y,T))
      WRITE(NO,10)(( HT(I,J),I=1,N,NS),J=1,N,NS)
10    FORMAT(
     +           9X,10H     X = 0,10H   X = 400,10H   X = 800,
     +              10H  X = 1200,10H  X = 1600,10H  X = 2000,/,
     +               9H Y = 0   ,6E10.3,/,9H Y = 400 ,6E10.3,/,
     +               9H Y = 800 ,6E10.3,/,9H Y = 1200,6E10.3,/,
     +               9H Y = 1600,6E10.3,/,9H Y = 2000,6E10.3,//)
      RETURN
      END
AQUIFER SIMULATION, THREE-POINT CENTERED APPROXIMATIONS
0.        10.       1.0
  121 1000    1    1  ABS 0.01
AQUIFER SIMULATION, FOUR-POINT APPROXIMATIONS
0.        10.       1.0
  121 1000    1    1  ABS 0.01
END OF RUNS
*APP MATH11
      SUBROUTINE INITAL
C...
C...  ORDERING OF OPERATIONS IN THE NUMERICAL METHOD OF LINES
C...
C...  THE NUMERICAL METHOD OF LINES HAS BEEN APPLIED TO A SPECTRUM OF
C...  PROBLEMS IN ORDINARY/PARTIAL DIFFERENTIAL EQUATIONS (ODE/PDES).
C...  IN FACT, THIS VERSATILITY OFTEN LEADS TO ALTERNATIVE, AND APPAR-
C...  ENTLY LOGICAL, APPROACHES TO THE PROGRAMMING OF ODE/PDE PROBLEMS.
C...
C...  IN THE FOLLOWING PROBLEM, THE DIFFERENCES IN NUMERICAL SOLUTIONS
C...  PRODUCED BY ALTERNATIVE, BUT SEEMINGLY REASONABLE, PROGRAMMING
C...  ARE INVESTIGATED.  THE PROBLEM IS PARTICULARLY WELL SUITED FOR
C...  THIS STUDY BECAUSE OF A SOMEWHAT UNUSUAL BOUNDARY CONDITION THAT
C...  INCLUDES A SECOND-ORDER DERIVATIVE IN TIME.  SPECIFICALLY, TWO
C...  APPROACHES TO A NUMERICAL SOLUTION ARE PROGRAMMED IN SUBROUTINES
C...  DERV1 AND DERV2, AND THE OUTPUT IS PRINTED IN SUBROUTINE PRINT FOR
C...  COMPARISON.
C...
C...  CONSIDER THE FOLLOWING DYNAMICAL SYSTEM*
C...
C                  .             . G
C                  .             .
C                  .      A      .                           Y
C                  ...............                           .
C                  .             .                           +
C                  .             .               B          ----------
C     ..............     ...     ...............................P... +
C       +          .             .                           +  .    .
C       .          .             .                           .  .    .
C       .          ...............                              .    .
C       .          .      +      .                              .    .
C       Z          .      S      .                              .    W
C       .          .      S      .                              .    .
C       .          .      S      .                              .    .
C       .          .      S      .                              .    .
C       +          .      +      .+------------- X ------------+.    +
C     -----        .    -----    .                              .  -----
C     /////             /////    .+--------------- L ---------------+
C
C...  THE SYSTEM CONSISTS OF A BLOCK, A, A UNIFORM BEAM, B, AND A LIGHT
C...  SPRING, S.  A IS CONSTRAINED TO MOVE IN GUIDE G, ONE END OF B IS
C...  CLAMPED TO A, AND S CONNECTS A TO A FIXED SUPPORT.
C...
C...  IF W(X,T) DENOTES THE DISPLACEMENT OF A POINT P LOCATED A DISTANCE
C...  X FROM THE CLAMPED END OF B (W = 0 WHEN BOTH B AND S ARE UNDEFORM-
C...  ED), EI IS THE FLEXURAL RIGIDITY OF B, KA IS THE MODULUS OF S,
C...  L IS THE LENGTH OF B, RHO IS THE MASS PER UNIT OF LENGTH B, AND
C...  MA IS THE MASS OF A, THEN W IS GOVERNED BY THE PARTIAL DIFFEREN-
C...  TIAL EQUATION (PDE)
C...
C...                      EI*W     + RHO*W   = 0
C...                          XXXX        TT
C...
C...  TOGETHER WITH THE (TIME-DEPENDENT) BOUNDARY CONDITIONS
C...
C...                 W (0,T) = W  (L,T) = W   (L,T) = 0
C...                  X         XX         XXX
C...
C...            MA*W  (0,T) + EI*W   (0,T) + KA*W(0,T) = 0
C...                TT            XXX
C...
C...                   W(X,0) = G(X), W (X,0) = H(X)
C...                                   T
C...
C...  TAKING MA = 10 KG, L = 10 M, RHO = 1000 KG/M, EI = 100 N-M**2,
C...  KA = 394.784 N/M (WHEN KA HAS THIS VALUE, THE SYSTEM FORMED
C...  BY A AND S ALONE HAS A NATURAL VIBRATION PERIOD OF 1 SEC), AND
C...  ASSUMING THAT THE SYSTEM STARTS FROM REST WITH B UNDEFORMED AND
C...  S EXTENDED BY 0.1 M, MAKE TIME-PLOTS, FOR 0 LE T LE 10 SEC, OF
C...  THE DISPLACEMENT W(L,T) OF THE FREE END OF B.
C...
C...  *KANE, T. R., P. W. LIKINS AND D. A. LEVINSON, SPACECRAFT DY-
C...  NAMICS, MCGRAW-HILL BOOK COMPANY, NEW YORK, PP. 414-417
C...
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/    W1(21),    W2(21)
     2      /F/   W1T(21),   W2T(21)
     3      /S/   W1X(21),  W1XX(21), W1XXX(21),W1XXXX(21)
     4      /C/        EI,       RHO,        MA,        KA,        XL,
     5                  N,        IP
      REAL             MA,        KA
C...
C...  SET THE MODEL PARAMETERS
      EI=100.
      RHO=1000.
      MA=10.
      KA=394.784
      XL=10.
C...
C...  INITIAL CONDITIONS
      N=21
      DO 1 I=1,N
      W1(I)=0.1
      W2(I)=0.0
1     CONTINUE
C...
C...  THE DERIVATIVE WTT(0,T) IS INITIALIZED FOR THE FIRST CALL TO
C...  SUBROUTINE DERV1
      IF(NORUN.EQ.1)W2T(1)=0.
C...
C...  THE DERIVATIVE WXXX(0,T) IS INITIALIZED FOR THE FIRST CALL TO
C...  SUBROUTINE DERV2
      IF(NORUN.EQ.2)W1XXX(1)=0.
C...
C...  COMPUTE THE INITIAL DERVIATIVES
      CALL DERV
      IP=0
      RETURN
      END
      SUBROUTINE DERV
      COMMON/T/         T,     NSTOP,     NORUN
C...
C...  CASE 1 (NORUN = 1)
C...
C...     THE FOURTH BOUNDARY CONDITION IS USED TO SET WXXX(O,T)
         IF(NORUN.EQ.1)CALL DERV1
C...
C...  CASE 2 (NORUN = 2)
C...
C...     THE FOURTH BOUNDARY CONDITION IS USED TO SET WTT(O,T)
         IF(NORUN.EQ.2)CALL DERV2
      RETURN
      END
      SUBROUTINE DERV1
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/    W1(21),    W2(21)
     2      /F/   W1T(21),   W2T(21)
     3      /S/   W1X(21),  W1XX(21), W1XXX(21),W1XXXX(21)
     4      /C/        EI,       RHO,        MA,        KA,        XL,
     5                  N,        IP
      REAL             MA,        KA
C...
C...  COMPUTE THE DERIVATIVE WX
      CALL DSS004(0.,XL,N,W1,W1X)
C...
C...  BOUNDARY CONDITIONS FOR THE FIRST DERIVATIVE
      W1X(1)=0.
C...
C...  COMPUTE THE DERIVATIVE UXX
      CALL DSS004(0.,XL,N,W1X,W1XX)
C...
C...  BOUNDARY CONDITIONS FOR THE SECOND DERIVATIVE
      W1XX(N)=0.
C...
C...  COMPUTE THE DERIVATIVE WXXX
      CALL DSS004(0.,XL,N,W1XX,W1XXX)
C...
C...  BOUNDARY CONDITIONS FOR THE THIRD DERIVATIVE
      W1XXX(N)=0.
      W1XXX(1)=(1./EI)*(-KA*W1(1)-MA*W2T(1))
C...
C...  COMPUTE THE DERIVATIVE WXXXX
      CALL DSS004(0.,XL,N,W1XXX,W1XXXX)
C...
C...  PDE
      DO 1 I=1,N
      W1T(I)=W2(I)
      W2T(I)=-(EI/RHO)*W1XXXX(I)
1     CONTINUE
      RETURN
      END
      SUBROUTINE DERV2
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/    W1(21),    W2(21)
     2      /F/   W1T(21),   W2T(21)
     3      /S/   W1X(21),  W1XX(21), W1XXX(21),W1XXXX(21)
     4      /C/        EI,       RHO,        MA,        KA,        XL,
     5                  N,        IP
      REAL             MA,        KA
C...
C...  COMPUTE THE DERIVATIVE WX
      CALL DSS004(0.,XL,N,W1,W1X)
C...
C...  BOUNDARY CONDITIONS FOR THE FIRST DERIVATIVE
      W1X(1)=0.
C...
C...  COMPUTE THE DERIVATIVE UXX
      CALL DSS004(0.,XL,N,W1X,W1XX)
C...
C...  BOUNDARY CONDITIONS FOR THE SECOND DERIVATIVE
      W1XX(N)=0.
C...
C...  COMPUTE THE DERIVATIVE WXXX
      CALL DSS004(0.,XL,N,W1XX,W1XXX)
C...
C...  BOUNDARY CONDITIONS FOR THE THIRD DERIVATIVE
      W1XXX(N)=0.
C...
C...  COMPUTE THE DERIVATIVE WXXXX
      CALL DSS004(0.,XL,N,W1XXX,W1XXXX)
C...
C...  PDE
      DO 1 I=1,N
      W1T(I)=W2(I)
      IF(I.EQ.1)THEN
         W2T(1)=(1./MA)*(-EI*W1XXX(1)-KA*W1(1))
      ELSE
         W2T(I)=-(EI/RHO)*W1XXXX(I)
      END IF
1     CONTINUE
      RETURN
      END
      SUBROUTINE PRINT(NI,NO)
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/    W1(21),    W2(21)
     2      /F/   W1T(21),   W2T(21)
     3      /S/   W1X(21),  W1XX(21), W1XXX(21),W1XXXX(21)
     4      /C/        EI,       RHO,        MA,        KA,        XL,
     5                  N,        IP
      REAL             MA,        KA
C...
C...  DIMENSION THE ARRAYS FOR THE PLOTTED SOLUTION
      DIMENSION   TP(201),W1P(3,201)
C...
C...  INCREMENT THE COUNTER FOR THE PRINTED AND PLOTTED SOLUTION
      IP=IP+1
C...
C...  PRINT THE SOLUTION EVERY TWENTIETH CALL TO SUBROUTINE PRINT
      IF(((IP-1)/20*20).EQ.(IP-1))THEN
      WRITE(NO,1)T,(    W1(I),I=1,N,4),(   W1X(I),I=1,N,4),
     1             (  W1XX(I),I=1,N,4),( W1XXX(I),I=1,N,4),
     2             (W1XXXX(I),I=1,N,4),(   W1T(I),I=1,N,4),
     3             (   W2T(I),I=1,N,4)
1     FORMAT(1H ,//,' T = ',F6.2,/,
     1              '     W1',6E10.3,/,
     2              '    W1X',6E10.3,/,
     3              '   W1XX',6E10.3,/,
     4              '  W1XXX',6E10.3,/,
     5              ' W1XXXX',6E10.3,/,
     6              '    W1T',6E10.3,/,
     7              '    W2T',6E10.3)
      END IF
C...
C...  STORE THE SOLUTION FOR SUBSEQUENT PLOTTING
      TP(IP)=T
      N2=N/2+1
      W1P(1,IP)=W1(1)
      W1P(2,IP)=W1(N2)
      W1P(3,IP)=W1(N)
C...
C...  PLOT THE SOLUTION AT THE END OF THE RUN
      IF(IP.LT.201)RETURN
      CALL TPLOTS(3,IP,TP,W1P)
      WRITE(NO,2)
2     FORMAT(1H ,/,' 1 - W1(0,T), 2 - W1(L/2,T), 3 - W1(L,T)')
C...
C...  *****************************************************************
C...
C...  THE FOLLOWING CALLS TO A CONTINUOUS PLOTTER ARE MACHINE DEPENDENT
C...  AND IN GENERAL MUST BE CONVERTED FOR THE LOCAL OR COMPUTED OR
C...  TO COMMENTS
C...
C...  CALL QIKSAX(3,3)
C...  CALL QIKPLT(TP,W1P,IP,9H*T (SEC)*,24H*W1(X,T), X = 0, L/2, L*,
C... 1            2H**,3)
C...
C...  ******************************************************************
C...
      RETURN
      END
DYNAMICS OF A DISCRETE-DISTRIBUTED MASS-SPRING SYSTEM
0.        10.       0.05
   4210000    1    1  REL 0.001
DYNAMICS OF A DISCRETE-DISTRIBUTED MASS-SPRING SYSTEM
0.        10.       0.05
   4210000    1    1  REL 0.001
END OF RUNS
*APP MATH12
      SUBROUTINE INITAL
C...
C...  INVESTIGATION OF THE ORDER OF THE EULER AND MODIFIED EULER
C...  METHODS
C...
C...  THE FOLLOWING PROGRAMMING IS FOR AN EMPIRICAL STUDY OF THE
C...  APPARENT ORDER OF THE EULER AND MODIFIED EULER METHODS.  A
C...  LINEAR, CONSTANT COEFFICIENT ORDINARY DIFFERENTIAL EQUATION
C...  (ODE) (THE EINSTEIN EQUATION FOR THE SCALE FACTOR OF THE UNI-
C...  VERSE) IS INTEGRATED NUMERICALLY AND ANALYTICALLY TO DETERMINE
C...  THE ERROR IN THE NUMERICAL SOLUTION AS A FUNCTION OF INTEGRATION
C...  STEP SIZE.  THIS ERROR IS THEN PLOTTED VS THE STEP SIZE WITH
C...  LOG-LOG COORDINATES, AND THE SLOPE OF THE PLOT COMPUTED AS THE
C...  ORDER OF THE METHOD
C...
C...  THE FOLLOWING ORDINARY DIFFERENTIAL EQUATION (ODE) WAS PROPOSED
C...  BY EINSTEIN FOR THE SCALE FACTOR, A(T), OF THE EXPANSION OF THE
C...  UNIVERSE (1)
C...
C...      2    2
C...     D A/DT  = 8*PI*G*RHO*A/3                               (1)
C...
C...  WHERE
C...
C...     A(T)         SCALE FACTOR
C...
C...     T            TIME
C...
C...     G            NEWTON*S GRAVITATIONAL CONSTANT
C...
C...     RHO          VACUUM DENSITY
C...
C...  (1)  LAKE, GEORGE, WINDOWS ON A NEW COSMOLOGY, SCIENCE, V. 224,
C...  NO. 4650, PP 675-682, 18 MAY 85
C...
C...  EQUATION (1) IS INTEGRATED NUMERICALLY SUBJECT TO THE FOLLOWING
C...  INITIAL CONDITIONS FOR THE CURRENT EPOCH
C...
C...     A(0) = DA(0)/DT = 1                                 (2)(3)
C...
C...  AN ANALYTICAL SOLUTION TO EQUATIONS (1) TO (3) CAN EASILY BE
C...  DERIVED.  IF A SOLUTION OF THE FORM
C...
C...     A(T) = D*EXP(C*T)
C...
C...  IS ASSUMED, WHERE C = (8*PI*G*RHO/3)**(1/2), SUBSTUTION IN
C...  EQUATION (1) CONFIRMS THE SOLUTION.  THUS, THE GENERAL SOLUTION
C...  TO EQUATION (1) IS
C...
C...     A(T) = D1*EXP(C*T) + D2*EXP(-C*T)
C...
C...  WHERE D1 AND D2 ARE CONSTANTS TO BE DETERMINED FROM EQUATIONS (2)
C...  AND (3).  APPLYING THESE INITIAL CONDITIONS, WE HAVE
C...
C...     A(0) = D1 + D2 = 1
C...
C...     DA(0)/DT = C*D1 - C*D2 = 1
C...
C...  THUS, D2 = 1 - D1 AND
C...
C...     C*D1 - C*(1 - D1) = 1
C...
C...     2*C*D1 = 1 + C
C...
C...     D1 = (1 + C)/(2*C)
C...
C...  AND
C...
C...     D2 = 1 - (1 + C)/(2*C) = (C - 1)/(2*C)
C...
C...  THE SOLUTION IS THEREFORE
C...
C...     A(T) = (1 + C)/(2*C)*EXP(C*T) + (C - 1)/(2*C)*EXP(-C*T)   (4)
C...
C...  THE SOLUTION IS VERIFIED AS
C...
C...      2    2
C...     D A/DT  =  (C/2)*(1 + C)*EXP(C*T) - (C/2)*(1 - C)*EXP(-C*T)
C...
C...   -(C**2)*A = -(C/2)*(1 + C)*EXP(C*T) + (C/2)*(1 - C)*EXP(-C*T)
C...
C...     A(0) = (1 + C)/(2*C) - (1 - C)/(2*C) = 1
C...
C...     DA(0)/DT = (1/2)*(1 + C) + (1/2)*(1 - C) = 1
C...
C...  EQUATION (4) CAN THEN BE USED TO CHECK THE NUMERICAL SOLUTION.
C...
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/         A,        AT
     2      /F/      DADT,       ATT
     3      /C/         C,         H,        IP
C...
C...  SET THE MODEL PARAMETERS
      C=1.
C...
C...  INITIAL CONDITIONS
      A=1.0
      AT=1.0
C...
C...  COMPUTE THE INITIAL DERIVATIVES
      CALL DERV
      IP=0
      RETURN
      END
      SUBROUTINE DERV
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/         A,        AT
     2      /F/      DADT,       ATT
     3      /C/         C,         H,        IP
C...
C...  EQUATION (1) IS PROGRAMMED AS TWO FIRST-ORDER ODES
      DADT=AT
      ATT=SQRT(C)*A
      RETURN
      END
      SUBROUTINE PRINT(NI,NO)
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/         A,        AT
     2      /F/      DADT,       ATT
     3      /C/         C,         H,        IP
C...
C...  DIMENSION THE ARRAYS FOR PLOTTING
      DIMENSION HPE(6), HPM(6), EPE(6), EPM(6)
C...
C...  PRINT A HEADING FOR THE OUTPUT
      IP=IP+1
      IF(IP.EQ.1)THEN
         WRITE(NO,2)
2        FORMAT(1H ,//,9X,'T',11X,'A(T)',6X,'ANAL A(T)')
      END IF
C...
C...  COMPUTE THE ANALYTICAL SOLUTION
      AE=EXACT(T,C)
C...
C...  PRINT THE NUMERICAL AND ANALYTICAL SOLUTIONS
      WRITE(NO,1)T,A,AE
1     FORMAT(F10.3,2F15.4)
C...
C...  AT THE END OF THE RUN, COMPUTE A NUMERICAL SOLUTION OVER 0 LE T
C...  LE 1 BY THE EULER AND MODIFIED EULER METHODS USING A SERIES OF
C...  FIXED INTERVAL STEPS (N STEPS FOR EACH SOLUTION, STARTING WITH
C...  N = 10)
      IF(T.LT.0.995)RETURN
      N=10
C...
C...  STEP THROUGH SIX SOLUTIONS
      DO 10 NCASE=1,6
C...
C...  COMPUTE A SOLUTION BY THE EULER METHOD
      CALL  EULER(N)
C...
C...  STORE THE ERROR IN THE NUMERICAL SOLUTION AND THE INTEGRATION
C...  STEP SIZE FOR SUBSEQUENT PLOTTING TO DETERMINE THE ORDER OF THE
C...  EULER METHOD
      AE=EXACT(T,C)
      HPE(NCASE)=ALOG10(ABS(H))
      EPE(NCASE)=ALOG10(ABS(A-AE))
C...
C...  COMPUTE A SOLUTION BY THE MODIFIED EULER METHOD
      CALL EULERM(N)
C...
C...  STORE THE ERROR IN THE NUMERICAL SOLUTION AND THE INTEGRATION
C...  STEP SIZE FOR SUBSEQUENT PLOTTING TO DETERMINE THE ORDER OF THE
C...  MODIFIED EULER METHOD
      AE=EXACT(T,C)
      HPM(NCASE)=ALOG10(ABS(H))
      EPM(NCASE)=ALOG10(ABS(A-AE))
C...
C...  INCREASE THE NUMBER OF INTERVALS AND REPEAT THE CALCULATIONS
      N=2*N
10    CONTINUE
C...
C...  PLOT THE ERROR VS INTEGRATION STEP SIZE FOR THE EULER METHOD
      CALL TPLOTS(1,6,HPE,EPE)
      WRITE(NO,11)
11    FORMAT(1H ,//,
     1 ' LOG(ERROR) VS LOG(H) FOR THE EULER METHOD')
C...
C...  PLOT THE ERROR VS INTEGRATION STEP SIZE FOR THE MODIFIED EULER
C...  METHOD
      CALL TPLOTS(1,6,HPM,EPM)
      WRITE(NO,12)
12    FORMAT(1H ,//,
     1 ' LOG(ERROR) VS LOG(H) FOR THE MODIFIED EULER METHOD')
C...
C...  COMPUTE AND PRINT THE ESTIMATED ORDER OF THE EULER METHOD
      ORDER=(EPE(6)-EPE(1))/(HPE(6)-HPE(1))
      WRITE(NO,13)ORDER
13    FORMAT(1H1,' ORDER OF EULER METHOD = ',F5.2)
C...
C...  COMPUTE AND PRINT THE ESTIMATED ORDER OF THE MODIFIED EULER
C...  METHOD
      ORDER=(EPM(6)-EPM(1))/(HPM(6)-HPM(1))
      WRITE(NO,14)ORDER
14    FORMAT(1H ,//,' ORDER OF THE MODIFIED EULER METHOD = ',F5.2)
      RETURN
      END
      SUBROUTINE EULER(N)
C...
C...  SUBROUTINE EULER COMPUTES A NUMERICAL SOLUTION TO A SYSTEM OF
C...  ODES USING A FIXED STEP EULER ALGORITHM OVER N INTERVALS
C...
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/      Y(2)
     2      /F/      F(2)
     3      /C/         C,         H,        IP
C...
C...  SET THE INITIAL CONDITIONS
      CALL INITAL
C...
C...  STEP THROUGH N EULER STEPS OVER THE INTERVAL 0 LE T LE 1
      H=1./FLOAT(N)
C...
C...  STEP THROUGH N INTERVALS
      DO 1 I=1,N
C...
C...  COMPUTE THE DERIVATIVE VECTOR AT THE BASE POINT
      CALL DERV
C...
C...  STEP FORWARD BY THE EULER METHOD
      DO 2 J=1,2
      Y(J)=Y(J)+H*F(J)
2     CONTINUE
C...
C...  CONTINUE ON TO THE NEXT STEP IN THE INTEGRATION
1     CONTINUE
C...
C...  THE INTEGRATION OVER N INTERVALS IS COMPLETE
      RETURN
      END
      SUBROUTINE EULERM(N)
C...
C...  SUBROUTINE EULERM COMPUTES A NUMERICAL SOLUTION TO A SYSTEM OF
C...  ODES USING A FIXED STEP MODIFIED EULER ALGORITHM OVER N INTER-
C...  VALS
C...
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/      Y(2)
     2      /F/      F(2)
     3      /C/         C,         H,        IP
C...
C...  DIMENSION ARRAYS FOR ADDITIONAL STORAGE USED DURING THE INTE-
C...  GRATION
      DIMENSION     Y0(2),     F0(2)
C...
C...  SET THE INITIAL CONDITIONS
      CALL INITAL
C...
C...  STEP THROUGH N EULER STEPS OVER THE INTERVAL 0 LE T LE 1
      H=1./FLOAT(N)
C...
C...  STEP THROUGH N INTERVALS
      DO 1 I=1,N
C...
C...  COMPUTE THE DERIVATIVE VECTOR AT THE BASE POINT
      CALL DERV
C...
C...  COMPUTE THE PREDICTED SOLUTION VECTOR
      DO 2 J=1,2
      Y0(J)=Y(J)
      F0(J)=F(J)
      Y(J)=Y0(J)+H*F0(J)
2     CONTINUE
C...
C...  COMPUTE THE DERIVATIVE VECTOR FOR THE PREDICTED SOLUTION VECTOR
      CALL DERV
C...
C...  COMPUTE THE CORRECTED SOLUTION VECTOR
      DO 3 J=1,2
      Y(J)=Y0(J)+(H/2.)*(F0(J)+F(J))
3     CONTINUE
C...
C...  CONTINUE ON TO THE NEXT STEP IN THE INTEGRATION
1     CONTINUE
C...
C...  THE INTEGRATION OVER N INTERVALS IS COMPLETE
      RETURN
      END
      FUNCTION EXACT(T,C)
C...
C...  FUNCTION EXACT COMPUTES THE ANALYTICAL SOLUTION TO EQUATIONS
C...  (1) TO (3)
C...
      EXACT=(1.0+C)/(2.0*C)*EXP(C*T)-(1.0-C)/(2.0*C)*EXP(-C*T)
      RETURN
      END
ORDER OF THE EULER AND MODIFIED EULER METHODS
0.        1.0       0.1
    2 1000    1    1  REL 0.0001
END OF RUNS
*APP MATH13
      SUBROUTINE INITAL
C...
C...  ONE-DIMENSIONAL PARABOLIC PARTIAL DIFFERENTIAL EQUATION WITH A
C...  TIME-DEPENDENT NONHOMOGENEOUS TERM
C...
C...  THE FOLLOWING PROBLEM HAS BEEN PROPOSED BY DR. K. L. LUKE, JET
C...  PROPULSION LABORATORY, MS 512-103, CALIFORNIA INSTITUTE OF TECH-
C...  NOLOGY, 4800 OAK GROVE DRIVE, PASADENA, CA  91109
C...
C...     Y  = D*Y  - Y/TAU + G(X)                              (1)
C...      T      XX
C...
C...            GO*EXP(-A*X), T LE TS
C...     G(X) =                                                (2)
C...            0, T GT TS
C...
C...     Y(X,0) = 0                                            (3)
C...
C...     Y (0,T) = (S/D)*Y(0,T)                                (4)
C...      X
C...
C...     Y (W,T) = -(S/D)*Y(W,T)                               (5)
C...      X
C...
C...  COMMON AREA
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/     Y(21)
     2      /F/    YT(21)
     3      /S/    YX(21),   YXX(21)
     4      /C/         D,       TAU,        G0,         A,        TS,
     5                  S,         W,        DX,         N,        IP
C...
C...  MODEL PARAMETERS
      D=1.
      TAU=1.
      G0=1.
      A=1.
      TS=1.
      S=1.
      W=1.
C...
C...  NUMBER OF GRID POINTS, SPATIAL INTERVAL
      N=21
      DX=W/FLOAT(N-1)
C...
C...  INITIAL CONDITION
      DO 1 I=1,N
      Y(I)=0.
1     CONTINUE
C...
C...  INITIAL DERIVATIVES
      CALL DERV
      IP=0
      RETURN
      END
      SUBROUTINE DERV
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/     Y(21)
     2      /F/    YT(21)
     3      /S/    YX(21),   YXX(21)
     4      /C/         D,       TAU,        G0,         A,        TS,
     5                  S,         W,        DX,         N,        IP
C...
C...  DERIVATIVE Y
C...              X
      CALL DSS004(0.,W,N,Y,YX)
C...
C...  BOUNDARY CONDITIONS
      YX(1)= (S/D)*Y(1)
      YX(N)=-(S/D)*Y(N)
C...
C...  DERIVATIVE Y
C...              XX
      CALL DSS004(0.,W,N,YX,YXX)
C...
C...  PARTIAL DIFFERENTIAL EQUATION
      DO 1 I=1,N
      IF(T.LE.TS)THEN
         X=DX*FLOAT(I-1)
         G=G0*EXP(-A*X)
      ELSE IF(T.GT.TS)THEN
         G=0.
      END IF
      YT(I)=D*YXX(I)-Y(I)/TAU+G
1     CONTINUE
      RETURN
      END
      SUBROUTINE PRINT(NI,NO)
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/     Y(21)
     2      /F/    YT(21)
     3      /S/    YX(21),   YXX(21)
     4      /C/         D,       TAU,        G0,         A,        TS,
     5                  S,         W,        DX,         N,        IP
C...
C...  DIMENSION THE ARRAYS FOR THE PLOTTED SOLUTION
      DIMENSION TP(51), YP(5,51)
C...
C...  PRINT A HEADING FOR THE NUMERICAL SOLUTION
      IF(IP.EQ.0)WRITE(NO,1)
1     FORMAT(9X,'T',4X,'   X=0',4X,'X=0.25',4X,' X=0.5',
     1                          4X,'X=0.75',4X,' X=1.0')
C...
C...  PRINT THE NUMERICAL SOLUTION EVERY FIFTH CALL TO SUBROUTINE PRINT
      IP=IP+1
      IF(((IP-1)/5*5).EQ.(IP-1))THEN
      WRITE(NO,2)T,(Y(I),I=1,N,5)
2     FORMAT(F10.2,5F10.4)
      END IF
C...
C...  STORE THE SOLUTION FOR SUBSEQUENT PLOTTING
      TP(IP)=T
      YP(1,IP)=Y(1)
      YP(2,IP)=Y(N/4+1)
      YP(3,IP)=Y(N/2+1)
      YP(4,IP)=Y(3*N/4+1)
      YP(5,IP)=Y(N)
C...
C...  PLOT THE SOLUTION
      IF(IP.LT.51)RETURN
      CALL TPLOTS(5,IP,TP,YP)
      WRITE(NO,10)
10    FORMAT(1H ,
     1 ' 1 - Y(0,T)   2 - Y(0.25,T)   3 - Y(0.5,T)  ',
     2 ' 4 - Y(0.75,T)   5 - Y(1,T)')
      RETURN
      END
PARABOLIC PDE WITH TIME-DEPENDENT, NONHOMOGENEOUS TERM
0.        1.0       0.02
   21 1000    1    1  ABS 0.001
END OF RUNS
*APP MATH14
      PROGRAM EULER
C...
C...  EULER INTEGRATION APPLIED TO INTEGRALS
C...
C...  THE FOLLOWING PROGRAM ILLUSTRATES THE APPLICATION OF THE EULER
C...  METHOD TO INTEGRALS.  THE EULER METHOD GENERALLY CAN BE APPLIED
C...  TO A SYSTEM OF FIRST-ORDER ORDINARY DIFFERENTIAL EQUATIONS (ODES)
C...  OF THE FORM
C...
C...     DY/DT = F(Y,T), Y(T0) = Y0
C...
C...  FOR THE SPECIAL CASE
C...
C...     DY/DT = F(T), Y(T0) = 0
C...
C...  THE SOLUTION Y(T) IS
C...
C...          T
C...     Y = INT F(T) DT
C...          T0
C...
C...  WHERE INT DENOTES AN INTEGRAL.  THUS THE EULER METHOD FOR ODES
C...  CAN ALSO BE APPLIED TO INTEGRALS.
C...
C...  THE FOLLOWING PROGRAMMING IS FOR AN EXAMPLE APPLICATION OF THIS
C...  IDEA.  THE APPLICATION IS A PHYSICAL PROBLEM FOR WHICH THE MATHE-
C...  MATICAL MODEL IS DESCRIBED IN SUBROUTINE INITAL.
C...
C...  THE MODEL INITIAL CONDITIONS ARE SET IN SUBROUTINE INITAL, AND
C...  THE MODEL DERIVATIVES ARE PROGRAMMED IN SUBROUTINE DERV.  THE
C...  NUMERICAL SOLUTION IS PRINTED IN SUBROUTINE PRINT.
C...
C...  THE FOLLOWING COMMON AREA LINKS THIS MAIN PROGRAM TO SUBROUTINES
C...  INITAL, DERV AND PRINT.
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/     Y(15)
     2      /F/     F(15)
C...
C...  THE FOLLOWING COMMON AREA PROVIDES THE INPUT/OUTPUT UNIT NUMBERS
C...  FOR USE IN OTHER SUBROUTINES
      COMMON/IO/       NI,        NO
C...
C...  DEFINE THE INPUT/OUTPUT UNIT NUMBERS
      NI=5
      NO=6
C...
C...  OPEN INPUT AND OUTPUT FILES
      OPEN(NI,FILE='INPUT')
      OPEN(NO,FILE='OUTPUT')
C...
C...  SET THE NUMBER OF RUNS
      NORUNS=2
C...
C...  STEP THROUGH THE NORUNS RUNS
      DO 4 NORUN=1,NORUNS
C...
C...  INITIALIZE THE RUN TERMINATION VARIABLE
      NSTOP=0
C...
C...  SET THE INITIAL, FINAL, PRINT INTERVAL VALUES OF TIME
      T0=0.
      TF=3.1415927/2.
      TP=3.1415927/2.
C...
C...  SET THE NUMBER OF DIFFERENTIAL EQUATIONS
      NEQN=3
C...
C...  INITIALIZE TIME
      T=T0
C...
C...  SET THE INITIAL CONDITIONS
      CALL INITAL
C...
C...  PRINT THE INITIAL CONDITIONS
      CALL PRINT(NI,NO)
C...
C...  SET THE INTEGRATION INTERVAL
      IF(NORUN.EQ.1)DT=TP/100.0
      IF(NORUN.EQ.2)DT=TP/1000.0
C...
C...  BEGIN THE EULER INTEGRATION
3     TOUT=T+TP
C...
C...  CALCULATE THE DERIVATIVES AT THE BASE POINT
1     CALL DERV
C...
C...  CHECK FOR A RUN TERMINATION
      IF(NSTOP.NE.0)GO TO 4
C...
C...  TAKE AN EULER STEP
      DO 2 J=1,NEQN
      Y(J)=Y(J)+F(J)*DT
2     CONTINUE
      T=T+DT
C...
C...  ALL NEQN DEPENDENT VARIABLES HAVE BEEN ADVANCED, SO TAKE THE
C...  NEXT STEP IN TIME
      IF(T.LT.(TOUT-0.5*DT))GO TO 1
C...
C...  ONE PRINT INTERVAL IS COMPLETE, SO PRINT THE SOLUTION
      CALL PRINT(NI,NO)
C...
C...  CHECK FOR A RUN TERMINATION
      IF(NSTOP.NE.0)GO TO 4
C...
C...  CHECK FOR THE END OF THE RUN
      IF(T.LT.(TF-0.5*TP))GO TO 3
C...
C...  THE CURRENT RUN IS COMPLETE, SO GO ON TO THE NEXT RUN
4     CONTINUE
C...
C...  ALL OF THE RUNS ARE COMPLETE, SO TERMINATE EXECUTION
      STOP
      END
      SUBROUTINE INITAL
C...
C...  EULER INTEGRATION APPLIED TO INTEGRALS
C...
C...  THE FOLLOWING EQUATIONS FOR THE CALCULATION OF HYDROSTATIC FORCES
C...  ON A CURVED SURFACE INVOLVE INTEGRALS TO ACCOUNT FOR THE SURFACE
C...  CURVATURE (1).  THE EQUATION FOR THE DIFFERENTIAL FORCE, DF, IS
C...
C...     DF = RHO*G*(H + R*SIN(THETA))*W*R*DTHETA
C...
C...  THE HORIZONTAL COMPONENT OF THE DIFFERENTIAL FORCE, DFH, IS THEN
C...
C...     DFH = DF*COS(THETA)
C...
C...  AND THE TOTAL HORIZONTAL FORCE, FH, IS
C...
C...          PI/2
C...     FH = INT RHO*G*(H+ R*SIN(THETA))*W*R*COS(THETA)*DTHETA
C...           0
C...
C...  WHERE INT DENOTES AN INTEGRAL.
C...
C...  (1)  KREIDER, JAN F., PRINCIPLES OF FLUID MECHANICS, ALLYN AND
C...       BACON, INC., NEW YORK, PROB 3.31, P151
C...
C...  SUBSTITUTION OF THE NUMERICAL VALUES FROM KREIDER GIVES
C...
C...                              PI/2
C...  FH = 62.4*(32.2/32.2)*2*4*4 INT (1 + SIN(THETA))*COS(THETA)*DTHETA
C...                               0
C...
C...  THE INTEGRAL, DESIGNATED Z1 IN THE FOLLOWING PROGRAMMING, CAN BE
C...  EVALUATED ANALYTICALLY AS
C...
C...     Z1 = SIN(THETA) + SIN(THETA)**2/2
C...
C...  WHICH, AFTER THE SUBSTITUTION OF THE LIMITS, EQUALS
C...
C...     Z1 = 1.5
C...
C...  THUS
C...
C...     FH = 2995 LB (FORCE)
C...
C...  SIMILARLY, THE DIFFERENTIAL VERTICAL FORCE IS
C...
C...     DFV = DF*SIN(THETA)
C...
C...  AND THE TOTAL VERTICAL FORCE, FV, IS
C...
C...          PI/2
C...     FV = INT RHO*G*(H+ R*SIN(THETA))*W*R*SIN(THETA)*DTHETA
C...           0
C...
C...  SUBSTITUTION OF THE NUMERICAL VALUES FROM KREIDER GIVES
C...
C...                              PI/2
C...  FV = 62.4*(32.2/32.2)*2*4*4 INT (1 + SIN(THETA))*SIN(THETA)*DTHETA
C...                               0
C...
C...  THE INTEGRAL, DESIGNATED Z2 IN THE FOLLOWING PROGRAMMING, CAN BE
C...  EVALUATED ANALYTICALLY AS
C...
C...     Z2 = - COS(THETA) + (1/2)*(THETA - SIN(2*THETA)/2)
C...
C...  WHICH, AFTER THE SUBSTITUTION OF THE LIMITS, EQUALS
C...
C...     Z2 = PI/4 + 1 = 1.7854
C...
C...  THUS
C...
C...     FH = 3565 LB (FORCE)
C...
C...  ALSO, THE VERTICAL AND HORIZONTAL POINTS OF PRESSURE, YP AND XP,
C...  CAN BE CALCULATED FROM THE EQUATIONS
C...
C...     YP*FH =
C...
C...     PI/2
C...     INT RHO*G*(H + R*SIN(THETA))*W*R*COS(THETA)*R*SIN(THETA)*DTHETA
C...      0
C...
C...     XP*FV =
C...
C...     PI/2
C...     INT RHO*G*(H + R*SIN(THETA))*W*R*COS(THETA)*R*SIN(THETA)*DTHETA
C...      0
C...
C...  THE INTEGRAL IN BOTH CASES, Z3, IS
C...
C...          PI/2
C...     Z3 = INT (1 + SIN(THETA))*COS(THETA)*SIN(THETA)*DTHETA
C...           0
C...
C...  THE ANALYTICAL EVALUATION OF Z3 IS LEFT AS AN EXCERISE FOR THE
C...  READER.  THE NUMERICAL EVALUATION IS NO MORE DIFFICULT THAN FOR
C...  Z1 AND Z2 (SEE THE PROGRAMMING IN SUBROUTINE DERV).  THE FINAL
C...  RESULTS ARE
C...
C...     YP = 6.22 FT (WITH RESPECT TO THE TOP OF THE LIQUID SURFACE)
C...
C...     XP = 1.867 FT
C...
C...  COMMON AREA
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/        Z1,        Z2,        Z3
     2      /F/     DZ1DT,     DZ2DT,     DZ3DT
     3      /C/         W,         H,         R,        G,        IP
C...
C...  SET THE MODEL PARAMETERS
C...
C...  ACCELERATION OF GRAVITY
      G=32.2
C...
C...  DIMENSIONS OF THE SYSTEM
      W=2.
      H=4.
      R=4.
C...
C...  INITIAL CONDITIONS
      Z1=0.
      Z2=0.
      Z3=0.
C...
C...  INITIAL DERIVATIVES
      CALL DERV
      IP=0
      RETURN
      END
      SUBROUTINE DERV
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/        Z1,        Z2,        Z3
     2      /F/     DZ1DT,     DZ2DT,     DZ3DT
     3      /C/         W,         H,         R,        G,        IP
C...
C...  MODEL DIFFERENTIAL EQUATIONS
      DZ1DT=(1.+SIN(T))*COS(T)
      DZ2DT=(1.+SIN(T))*SIN(T)
      DZ3DT=(1.+SIN(T))*SIN(T)*COS(T)
      RETURN
      END
      SUBROUTINE PRINT(NI,NO)
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/        Z1,        Z2,        Z3
     2      /F/     DZ1DT,     DZ2DT,     DZ3DT
     3      /C/         W,         H,         R,        G,        IP
C...
C...  PRINT A HEADING FOR THE SOLUTION.  (AT THIS POINT, FH, FV, YP AND
C...  XP CAN EASILY BE CALCULATED FROM Z1, Z2 AND Z3 USING THE CONSTANTS
C...  W, H AND R, BUT THIS IS NOT DONE.  RATHER, JUST THE VALUES OF Z1,
C...  Z2 AND Z3 ARE PRINTED)
      WRITE(NO,1)NORUN,T,Z1,Z2,Z3
1     FORMAT(' RUN = ',I2,'   THETA = ',F6.3,'   Z1 = ',F7.4,
     1                       '   Z2 = ',F7.4,'   Z3 = ',F7.4)
      IP=IP+1
      RETURN
      END
*APP MATH15
      SUBROUTINE INITAL
C...
C...  INTEGRATION OF BESSEL*S EQUATION OF ORDER ZERO AND ONE
C...
C...  BESSEL*S EQUATION OF ORDER ZERO WITH INITIAL CONDITIONS IS
C...
C...               (X**2)*D2Y/DT2 + X*DY/DX + (X**2)*Y = 0           (1)
C...
C...                               Y(0) = 1                          (2)
C...
C...                             DY(0)/DX = 0                        (3)
C...
C...  THE SOLUTION IS THE WELL-KNOWN BESSEL FUNCTION OF THE FIRST KIND,
C...  GENERALLY DENOTED AS J0(X)
C...
C...  BESSEL*S EQUATION OF ORDER ONE WITH INITIAL CONDITIONS IS
C...
C...             (X**2)*D2Y/DX2 + X*DY/DX + (X**2 - 1)*Y = 0         (4)
C...
C...                               Y(0) = 0                          (5)
C...
C...                            DY(0)/DX = 1/2                       (6)
C...
C...  THE SOLUTION IS GENERALLY DENOTED AS J1(X))
C...
C...  EQUATIONS (1) AND (4) ARE NUMERICALLY INTEGRATED VIA A SYSTEM OF
C...  TWO EQUIVALENT FIRST-ORDER EQUATIONS.  THE INITIAL VALUE OF THE
C...  INDEPENDENT VARIABLE (I.E. X = 0) IS REPLACED WITH THE APPROXI-
C...  MATE VALUE OF X = 1.0E-6 TO AVOID DIFFICULTIES IN THE INITIAL COM-
C...  PUTATION OF THE DERIVATIVES IN SUBROUTINE DERV.
C...
C...  TABULATED VALUES OF J0(X) AND J1(X) ARE LISTED BELOW FOR COMPARI-
C...  SON WITH THE NUMERICAL SOLUTIONS
C...
C...               X                 J0(X)               J1(X)
C...              1.0               0.76519             0.44005
C...              2.0               0.22389             0.57672
C...              3.0              -0.26005             0.33905
C...              4.0              -0.39714            -0.06604
C...              5.0              -0.17759            -0.32757
C...              6.0               0.15046            -0.27668
C...              7.0               0.30007            -0.00468
C...              8.0               0.17165             0.23463
C...              9.0              -0.09033             0.24531
C...             10.0              -0.24593             0.04347
C...
C...  REF - ABRAMOWITZ, M., AND I. A. STEGUN, HANDBOOK OF MATHEMATICAL
C...  FUNCTIONS, NATIONAL BUREAU OF STANDARDS APPLIED MATHEMATICS
C...  SERIES, NO. 55, SEVENTH PRINTING, PP. 390-392, MAY, 1968.  A COM-
C...  PARISON OF J1(X) WHICH IS TABULATED ABOVE AND DJ0(X)/DX WHICH IS
C...  COMPUTED NUMERICALLY INDICATES DJ0(X)/DX = -J1(X)
C...
C...     THE PROBLEMS DEFINED BY EQUATIONS (1) TO (6) PROVIDE AN INTER-
C...  ESTING AND SOMEWHAT UNEXPECTED RESULT.  FOR EQUATION (1), NMAX =
C...  100 (I.E. THE RATIO OF THE PRINT INTERVAL TO THE MINIMUM ALLOWABLE
C...  INTEGRATION INTERVAL SET ON THE THIRD DATA LINE) GIVES A NUMERI-
C...  CAL SOLUTION WITH NO REPORTED INTEGRATION ERRORS AND WHICH AGREES
C...  WITH THE TABULATED VALUES OF J0(X) TO FOUR FIGURES OR BETTER.
C...  HOWEVER, FOR EQUATION (4), EVEN WITH NMAX = 99999, THE MAXIMUM
C...  VALUE WHICH DSS/2 CAN READ UNDER AN I5 FORMAT, THE NUMERICAL
C...  SOLUTION IS OBVIOUSLY IN ERROR WHEN COMPARED WITH THE TABULATED
C...  VALUES OF J1(X).  FURTHERMORE, AN INTEGRATION ERROR FOR THE
C...  SECOND DEPENDENT VARIABLE Y2 (= DY/DX) IS REPORTED.
C...
C...     THESE EXAMPLES CLEARLY INDICATE THAT THE PERFORMANCE AND
C...  EFFICIENCY OF A NUMERICAL INTEGRATION ALGORITHM IS STRONGLY AND
C...  GENERALLY UNPREDICTABLY RELATED TO THE CHARACTERISTICS OF THE
C...  PARTICULAR PROBLEM.  IN THE CASE OF EQUATION (4), THE ADDITIONAL
C...  TERM -((N/X)**2)*Y1 WITH N = 1 (V. SUBROUTINE DERV) LEADS TO A
C...  SIGNIFICANT COMPUTATIONAL ERROR AT X = 0 WHICH CAUSES THE SUB-
C...  SEQUENT SOLUTION TO VIOLATE THE ERROR CRITERION.  FOR EQUATION
C...  (1), N = 0 AND THIS TERM DROPS OUT OF THE PROBLEM.
C...
      COMMON/T/X,NFIN,NRUN/Y/Y1,Y2/F/DY1DX,DY2DX
      GO TO(1,2),NRUN
C...
C...  INITIAL CONDITIONS FOR BESSEL*S EQUATION OF ORDER ZERO
C...  Y(0) = 1, DY(0)/DT = 0
1     Y1=1.
      Y2=0.
      RETURN
C...
C...  INITIAL CONDITIONS FOR BESSEL*S EQUATION OF ORDER ONE T
C...  Y(0) = 0, DY(0)/DT = 1/2
2     Y1=0.
      Y2=0.5
      RETURN
      END
      SUBROUTINE DERV
      COMMON/T/X,NFIN,NRUN/Y/Y1,Y2/F/DY1DX,DY2DX
      REAL N
C...
C...  BESSEL*S EQUATION OF ORDER N
      N=FLOAT(NRUN)-1.
      DY1DX=Y2
      DY2DX=-((1./X)*Y2+(1.-(N/X)**2)*Y1)
      RETURN
      END
      SUBROUTINE PRINT(NI,NO)
      COMMON/T/X,NFIN,NRUN/Y/Y1,Y2/F/DY1DX,DY2DX
      DIMENSION XPLOT(101),YPLOT(2,101)
      DATA IP/0/
C...
C...  PRINT A HEADING AT THE TOP OF THE PAGE
      IF(IP.NE.0)GO TO 3
      GO TO(1,2),NRUN
1     WRITE(NO,4)
4     FORMAT(15H              X,15H          J0(X),15H      DJ0(X)/DX)
      GO TO 3
2     WRITE(NO,5)
5     FORMAT(15H              X,15H          J1(X),15H      DJ1(X)/DX)
C...
C...  PRINT THE SOLUTION EVERY TENTH CALL TO SUBROUTINE PRINT
3     IP=IP+1
      IF(((IP-1)/10*10).EQ.(IP-1))WRITE(NO,6)X,Y1,Y2
6     FORMAT(F15.3,2E15.4)
C...
C...  STORE THE SOLUTION FOR SUBSEQUENT PLOTTING
      XPLOT(IP)=X
      IF(NRUN.EQ.1)YPLOT(1,IP)=Y1
      IF(NRUN.EQ.1)YPLOT(2,IP)=Y2
C...
C...  AT THE END OF THE SECOND RUN, PLOT THE BESSEL FUNCTION VS X
      IF(IP.LT.101)RETURN
      IP=0
      IF(NRUN.LT.2)RETURN
      CALL TPLOTS(2,101,XPLOT,YPLOT)
C...
C...  PRINT A LABEL FOR THE PLOT
      WRITE(NO,8)
8     FORMAT(10H 1 - J0(X),10H 2 - J1(X))
      RETURN
      END
WYLIE, C.R., ADV ENG MATH, PP. 351-357, MCGRAW-HILL, 1966
    1.0E-6 10.0     0.1
    2  100    3    1  ABS 0.001
WYLIE, C.R., ADV ENG MATH, PP. 351-357, MCGRAW-HILL, 1966
    1.0E-6 10.0     0.1
    299999    3    1  ABS 0.001
END OF RUNS
*APP MATH16
      SUBROUTINE INITAL
C...
C...  BESSEL*S EQUATION OF ORDER ZERO (SECOND APPROACH)
C...
C...  BESSEL*S EQUATION OF ORDER ZERO
C...
C...     T*D2U/DT2 + DU/DT + T*U = 0                                 (1)
C...
C...  IS INTEGRATED SUBJECT TO THE INITIAL CONDITIONS
C...
C...     U(0) = 1, DU(0)/DT = 0                                   (2)(3)
C...
C...  THE USUAL PROCEDURE OF STATING A SECOND-ORDER EQUATION AS TWO
C...  FIRST-ORDER EQUATIONS VIA THE STATE VARIABLES
C...
C...     U1 = U, U2 = DU/DT                                       (4)(5)
C...
C...  GIVES
C...
C...     DU1/DT = U2, DU2/DT = -U2/T - U1                         (6)(7)
C...
C...  WITH THE INITIAL CONDITIONS
C...
C...     U1(0) = 1, U2(0) = 0                                     (8)(9)
C...
C...  A COMPUTATIONAL PROBLEM OCCURS AT T = 0 DURING THE INTEGRATION
C...  OF EQUATION (7) SINCE THE FIRST TERM ON THE RIGHT HAND SIDE (RHS)
C...  IS INDETERMINATE, I.E., -U2/T = 0/0 AS A CONSEQUENCE OF INITIAL
C...  CONDITION (9).  APPLICATION OF L*HOSPITAL*S RULE TO THIS TERM
C...  GIVES
C...
C...      LIM (U2/T) = DU2/DT
C...     T---+0
C...
C...  (OBTAINED MERELY BY DIFFERENTIATING THE NUMERATOR AND DENOMINATOR
C...  OF U2/T WITH RESPECT TO T).  THUS EQUATION (7) FOR T = 0 BECOMES
C...
C...     DU2/DT = -U1/2                                             (10)
C...
C...  IN THE PROGRAMMING IN SUBROUTINE DERV, A TEST FOR T = 0 DETERMINES
C...  IF EQUATION (7) OR EQUATION (10) IS USED.
C...
C...  THE FOLLOWING TABULATED VALUES OF THE ZERO-ORDER BESSEL FUNCTION
C...  OF THE FIRST KIND, J0(T), CAN BE COMPARED WITH THE PROGRAM OUTPUT.
C...  ALSO, FROM THE IDENTITY DJ0(T)/DT = -J1(T), THE FOLLOWING TABU-
C...  LATED VALUES OF J1(T) CAN BE COMPARED WITH THE NUMERICAL DERIVA-
C...  TIVE OF THE SOLUTION OF EQUATION (1) PRODUCED BY THE PROGRAM
C...  (REFERENCE - HANDBOOK OF MATHEMATICAL FUNCTIONS, M. ABRAMOWITZ AND
C...  I. A. STEGUN (EDS.), NATIONAL BUREAU OF STANDARDS APPLIED MATHE-
C...  MATICS SERIES NO. 55, PAGE 390, U.S. GOVERNMENT PRINTING OFFICE,
C...  WASHINGTON, D.C., JUNE, 1964)
C...
C...           T       J0(T)       J1(T)
C...          0.0     1.00000     0.00000
C...          0.1     0.99750     0.04993
C...          0.2     0.99002     0.09950
C...          0.3     0.97762     0.14831
C...          0.4     0.96039     0.19602
C...          0.5     0.93846     0.24226
C...          0.6     0.91200     0.28670
C...          0.7     0.88120     0.32899
C...          0.8     0.84628     0.36884
C...          0.9     0.80752     0.40594
C...          1.0     0.76519     0.44005
C...
      COMMON/T/T/Y/U1,U2/F/F1,F2
C...
C...  INITIAL CONDITIONS (8) AND (9)
      U1=1.
      U2=0.
      RETURN
      END
      SUBROUTINE DERV
      COMMON/T/T/Y/U1,U2/F/F1,F2
C...
C...  EQUATION (6)
      F1=U2
C...
C...  EQUATION (7)
      IF(T.GE.1.0E-15)F2=-U2/T-U1
C...
C...  EQUATION (10)
      IF(T.LT.1.0E-15)F2=-U1/2.
      RETURN
      END
      SUBROUTINE PRINT(NI,NO)
      COMMON/T/T/Y/U1,U2/F/F1,F2
C...
C...  PRINT A HEADING
      IF(T.LT.0.01)WRITE(NO,2)
2     FORMAT(9X,1HT,10X,5HJ0(T),9X,6H-J1(T))
C...
C...  PRINT THE NUMERICAL SOLUTION
      WRITE(NO,1)T,U1,U2
1     FORMAT(F10.2,2F15.5)
      RETURN
      END
T*D2U/DT2 + DU/DT + T*U = 0, U(0) = 1, DU(0)/DT = 0
0.        1.0       0.1
    2  100    1    1  ABS 0.0001
END OF RUNS
*APP MATH17
      SUBROUTINE INITAL
C...
C...  COMPARISON OF THE ANALYTICAL AND NUMERICAL SOLUTIONS AND EIGEN-
C...  VALUES OF A SECOND-ORDER, NONOSCILLATORY ORDINARY DIFFERENTIAL
C...  EQUATION
C...
C...  CONSIDER THE SECOND-ORDER ORDINARY DIFFERENTIAL EQUATION (ODE)
C...
C...      2    2
C...     D X/DT  + 5*DX/DT + 4*X = 2                                 (1)
C...
C...     X(0) = 0, DX(0)/DT = 1                                   (2)(3)
C...
C...  AN ANALYTICAL SOLUTION TO EQUATIONS (1) TO (3) CAN BE OBTAINED BY
C...  CLASSICAL METHODS, E.G., THE LAPLACE TRANSFORM.  THE ANALYTICAL
C...  SOLUTION IS COMPARED WITH THE NUMERICAL SOLUTION IN THE FOLLOWING
C...  PROGRAM.
C...
C...  IF THE LAPLACE TRANSFORM OF X(T) IS DEFINED AS XL(S), EQUATIONS
C...  (1) TO (3) TRANSFORM TO
C...
C...     (S**2)*XL(S) - S*X(0) - DX(0)/DT + 5*S*XL(S) - 5*X(0) + 4*XL(S)
C...
C...                                = 2/S
C...
C...  WHICH REDUCES TO
C...
C...     ((S**2) + 5*S + 4)*XL = 1 + 2/S
C...
C...  OR
C...
C...     XL = (S + 2)/(S*(S + 4)*(S + 1)) = A/S + B/(S + 4) + C/(S + 1)
C...
C...  WHERE A, B AND C ARE CONSTANTS TO BE DETERMINED IN THE PARTIAL
C...  FRACTIONS EXPANSION OF XL.  INVERSION TO THE T DOMAIN GIVES
C...
C...     X(T) = A + B*EXP(-4*T) + C*EXP(-T)
C...
C...  WHERE
C...
C...     A = (S + 2)/((S + 4)*(S + 1))    = 1/2
C...                                  S=0
C...
C...     B = (S +2)/(S*(S+1))     = -1/6
C...                         S=-4
C...
C...     C = (S + 2)/((S*(S + 4))     = -1/3
C...                             S=-1
C...
C...  VERIFICATION OF THIS SOLUTION IS LEFT TO THE READER.
C...
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/        X1,        X2
     2      /F/     DX1DT,     DX2DT
     3      /C/        IP
C...
C...  INITIAL CONDITIONS
      X1=0.
      X2=1.
C...
C...  INITIAL DERIVATIVES
      CALL DERV
      IP=0
      RETURN
      END
      SUBROUTINE DERV
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/        X1,        X2
     2      /F/     DX1DT,     DX2DT
     3      /C/        IP
      DX1DT=X2
      DX2DT=2.0-5.0*X2-4.0*X1
      RETURN
      END
      SUBROUTINE PRINT(NI,NO)
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/        X1,        X2
     2      /F/     DX1DT,     DX2DT
     3      /C/        IP
C...
C...  DIMENSION THE ARRAYS FOR PLOTTING
      DIMENSION    TP(51),   X1P(51)
C...
C...  DIMENSION THE ARRAYS FOR SUBROUTINES JMAP, EIGEN
      DIMENSION        AJ(2,2),          WF(2),
     1                   SV(2),       SVOLD(2),
     2                   FV(2),       FVOLD(2)
      COMPLEX        EIGENV(2)
C...
C...  EQUIVALENCE THE STATE VARIABLE VECTOR, S(2), TO THE DEPENDENT
C...  VARIABLES IN COMMON/Y/, AND THE DERIVATIVE VECTOR, FV(2), TO THE
C...  DERIVATIVES IN COMMON/F/
      EQUIVALENCE (X1,SV(1)), (DX1DT,FV(1))
C...
C...  PRINT A HEADING FOR THE NUMERICAL AND ANALYTICAL SOLUTIONS
      IF(IP.EQ.0)WRITE(NO,1)
1     FORMAT(9X,'T',10X,'X1',10X,'XA')
C...
C...  PRINT THE NUMERICAL AND ANALYTICAL SOLUTIONS EVERY FIFTH CALL
C...  TO SUBROUTINE PRINT
      IP=IP+1
      IF(((IP-1)/5*5).EQ.(IP-1))THEN
         A=1./2.
         B=-1./6.
         C=-1./3.
         XA=A+B*EXP(-4.*T)+C*EXP(-T)
         WRITE(NO,2)T,X1,XA
2        FORMAT(F10.1,2F12.5)
      END IF
C...
C...  MAP THE JACOBIAN MATRIX AT THE BEGINNING AND END OF THE SOLUTION
      IF((IP.EQ.1).OR.(IP.EQ.51))THEN
         NODE=2
         CALL JMAP(NODE,AJ,SV,SVOLD,FV,FVOLD)
C...
C...     COMPUTE THE TEMPORAL EIGENVALUES OF THE TWO ODES DEFINED IN
C...     COMMON /Y/ AND /F/
         CALL EIGEN(NODE,AJ,EIGENV,WF)
      END IF
C...
C...  STORE THE SOLUTION FOR PLOTTING
      X1P(IP)=X1
       TP(IP)=T
C...
C...  PLOT THE SOLUTION
      IF(IP.LT.51)RETURN
      CALL TPLOTS(1,IP,TP,X1P)
      WRITE(NO,3)
3     FORMAT(1H ,//,' X(T) VS T')
      RETURN
      END
NUMERICAL AND ANALYTICAL SOLUTIONS OF A NONOSCILLATORY ODE
0.        10.       0.2
    2 1000    1    1  REL 0.001
END OF RUNS
*APP MATH18
      SUBROUTINE INITAL
C...
C...  COMPARISON OF THE ANALYTICAL AND NUMERICAL SOLUTIONS AND EIGEN-
C...  VALUES OF A SECOND-ORDER, OSCILLATORY ORDINARY DIFFERENTIAL
C...  EQUATION
C...
C...  CONSIDER THE SECOND-ORDER ORDINARY DIFFERENTIAL EQUATION (ODE)
C...
C...      2    2
C...     D X/DT  + 2*DX/DT + 2*X = 1                            (1)
C...
C...     X(0) = 2, DX(0)/DT = 0                              (2)(3)
C...
C...  AN ANALYTICAL SOLUTION TO EQUATIONS (1) TO (3) CAN BE OBTAINED BY
C...  CLASSICAL METHODS, E.G., THE LAPLACE TRANSFORM.  THE ANALYTICAL
C...  SOLUTION IS COMPARED WITH THE NUMERICAL SOLUTION IN THE FOLLOWING
C...  PROGRAM.
C...
C...  IF THE LAPLACE TRANSFORM OF X(T) IS DEFINED AS XL(S), EQUATIONS
C...  (1) TO (3) TRANSFORM TO
C...
C...     (S**2)*XL - S*X(0) - DX(0)/DT + 2*S*XL - 2*X(0) + 2*XL = 1/S
C...
C...  WHICH REDUCES TO
C...
C...     ((S**2) + 2*S + 2)*XL = 2*S + 4 + 1/S
C...
C...  OR
C...
C...     XL = (2*(S**2) + 4*S + 1)/(S*(S**2 + 2*S + 2))
C...
C..         = A/S + (B*S + C)/(S**2 + 2*S + 2)
C...
C...  WHERE A, B AND C ARE CONSTANTS TO BE DETERMINED IN THE PARTIAL
C...  FRACTIONS EXPANSION OF XL.
C...
C...  THE ROOTS OF S**2 + 2*S + 2 = 0 ARE S1 = -1 + I, S2 = -1 - I.
C...  HOWEVER, THE FORM OF THE PARTIAL FRACTIONS EXPANSION (THE TERM
C...  INVOLVING CONSTANTS B AND C) WAS SELECTED TO AVOID HAVING TO
C...  WORK WITH THESE COMPLEX ROOTS.  THUS,
C...
C...     XL = A/S + (B*(S + 1))/((S + 1)**2 + 1**2)
C...
C...              + (C - B)/((S + 1)**2 + 1**2)
C...
C...  WHICH CAN BE INVERTED DIRECTLY TO
C...
C...     X(T) = A + B*EXP(-T)*COS(T) + (C - B)*EXP(-T)*SIN(T)
C...
C...  THIS RESULT FOLLOWS DIRECTLY FROM THE TRANSFORM PAIRS
C...
C...     L(F(T)*EXP(A*T)) = FL(S - A)
C...
C...     L(SIN(W*T)) = W/(S**2 + W**2)
C...
C...     L(COS(W*T)) = S/(S**2 + W**2)
C...
C...  THE CONSTANT A CAN BE DETERMINED IN THE USUAL WAY
C...
C...     A = (2*(S**2) + 4*S + 1)/(S**2 + 2*S + 2)    = 1/2
C...                                              S=0
C...
C...  THE CONSTANTS B AND C CAN BE EVALUATED FROM THE EQUATION
C...
C...     (2*(S**2) + 4*S + 1)/(S*(S**2 + 2*S + 2)) =
C...
C...     A/S + (B*S + C)/(S**2 + 2*S + 2)
C...
C...  WHICH MUST BE TRUE FOR ANY VALUE OF S WITH A = 1/2.  WE THERE-
C...  FORE SELECT S = 1 AND S = -1.  THUS,
C...
C...     S = 1, 7/(1*5) = 1/2 + (B + C)/5
C...
C...  OR
C...
C...     B + C = 9/2
C...
C...     S = -1, -1/(-1*1) = 1/2 + (-B + C)/1
C...
C...  OR
C...
C...     -B + C = 3/2
C...
C...  SOLVING THESE TWO EQUATIONS FOR B AND C, WE OBTAIN
C...
C...     B = 3/2, C = 3, C - B = 3/2
C...
C...  THEREFORE, THE SOLUTION IS
C...
C...     X(T) = 1/2 + (3/2)*EXP(-T) + (3/2)*EXP(-T)*SIN(T)
C...
C...          = 1/2 + SQRT((3/2)**2 + (3/2)**2)*COS(T - ARCTAN(1))
C...
C...  VERIFICATION OF THIS SOLUTION IS LEFT TO THE READER.
C...
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/        X1,        X2
     2      /F/     DX1DT,     DX2DT
     3      /C/        IP
C...
C...  INITIAL CONDITIONS
      X1=2.
      X2=0.
C...
C...  INITIAL DERIVATIVES
      CALL DERV
      IP=0
      RETURN
      END
      SUBROUTINE DERV
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/        X1,        X2
     2      /F/     DX1DT,     DX2DT
     3      /C/        IP
      DX1DT=X2
      DX2DT=1.0-2.0*X2-2.0*X1
      RETURN
      END
      SUBROUTINE PRINT(NI,NO)
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/        X1,        X2
     2      /F/     DX1DT,     DX2DT
     3      /C/        IP
C...
C...  DIMENSION THE ARRAYS FOR PLOTTING
      DIMENSION    TP(51),   X1P(51)
C...
C...  DIMENSION THE ARRAYS FOR SUBROUTINES JMAP, EIGEN
      DIMENSION        AJ(2,2),          WF(2),
     1                   SV(2),       SVOLD(2),
     2                   FV(2),       FVOLD(2)
      COMPLEX        EIGENV(2)
C...
C...  EQUIVALENCE THE STATE VARIABLE VECTOR, S(2), TO THE DEPENDENT
C...  VARIABLES IN COMMON/Y/, AND THE DERIVATIVE VECTOR, FV(2), TO THE
C...  DERIVATIVES IN COMMON/F/
      EQUIVALENCE (X1,SV(1)), (DX1DT,FV(1))
C...
C...  PRINT A HEADING FOR THE NUMERICAL AND ANALYTICAL SOLUTIONS
      IF(IP.EQ.0)WRITE(NO,1)
1     FORMAT(9X,'T',10X,'X1',10X,'XA')
C...
C...  PRINT THE NUMERICAL AND ANALYTICAL SOLUTIONS EVERY FIFTH CALL
C...  TO SUBROUTINE PRINT
      IP=IP+1
      IF(((IP-1)/5*5).EQ.(IP-1))THEN
         XA=(1./2)+(3./2.)*EXP(-T)*COS(T)+(3./2.)*EXP(-T)*SIN(T)
         WRITE(NO,2)T,X1,XA
2        FORMAT(F10.1,2F12.5)
      END IF
C...
C...  MAP THE JACOBIAN MATRIX AT THE BEGINNING AND END OF THE SOLUTION
      IF((IP.EQ.1).OR.(IP.EQ.51))THEN
         NODE=2
         CALL JMAP(NODE,AJ,SV,SVOLD,FV,FVOLD)
C...
C...     COMPUTE THE TEMPORAL EIGENVALUES OF THE TWO ODES DEFINED IN
C...     COMMON /Y/ AND /F/
         CALL EIGEN(NODE,AJ,EIGENV,WF)
      END IF
C...
C...  STORE THE SOLUTION FOR PLOTTING
      X1P(IP)=X1
       TP(IP)=T
C...
C...  PLOT THE SOLUTION
      IF(IP.LT.51)RETURN
      CALL TPLOTS(1,IP,TP,X1P)
      WRITE(NO,3)
3     FORMAT(1H ,//,' X(T) VS T')
      RETURN
      END
NUMERICAL AND ANALYTICAL SOLUTIONS OF A OSCILLATORY ODE
0.        10.       0.2
    2 1000    1    1  REL 0.001
END OF RUNS
*APP MATH19
      SUBROUTINE INITAL
C...
C...  NUMERICAL INTEGRATION OF THE NORMAL PROBABILITY DISTRIBUTION
C...  FUNCTION
C...
C...  THE INTEGRAL TO BE EVALUATED IS
C...
C...                               4
C...               I = 2/SQRT(PI) INT EXP(-T**2)DT                   (1)
C...                               0
C...
C...  THE INTEGRAND IS THE NORMAL PROBABILITY DISTRIBUTION FUNCTION.
C...  THE UPPER LIMIT OF THE INTEGRAL (I.E. 4) HAS BEEN SELECTED LARGE
C...  ENOUGH THAT THE INTEGRAND IS SMALL (I.E. EXP(-16)).  THEREFORE,
C...  THE INTEGRAL I WHICH IS NORMALIZED HAS A VALUE OF UNITY TO SIX
C...  FIGURES.  THE VALUE OF I REPORTED BY SCHEID, FRANCIS, THEORY AND
C...  PROBLEMS OF NUMERICAL ANALYSIS, SCHAUM*S OUTLINE SERIES, MCGRAW-
C...  HILL BOOK COMPANY, NEW YORK, P. 137, PROB. 15.31 ARE
C...
C...                    N              I
C...                    4            0.986
C...                    6          1.000258
C...                    8          1.000004
C...                   10          1.000000
C...
C...  WHERE N IS THE NUMBER OF POINTS IN A GAUSSIAN QUADRATURE.
C...
C...  THREE RUNS ARE PROGRAMMED FOR ALGORITHMS 3, 4 AND 7 TO GIVE AN IN-
C...  DICATION OF THE ACCURACY OF THE ANSWER (I.E. THE VALUE OF I CAN BE
C...  COMPARED FOR THE THREE RUNS).
C...
      COMMON/T/T/Y/I/F/DIDT/CONST/A
      REAL I
C...
C...  INITIAL CONDITION AND MULTIPLYING CONSTANT
      I=0.
      A=2./SQRT(4.*ATAN(1.))
      RETURN
      END
      SUBROUTINE DERV
      COMMON/T/T/Y/I/F/DIDT
      REAL I
C...
C...  EVALUATE THE INTEGRAND
      DIDT=EXP(-T**2)
      RETURN
      END
      SUBROUTINE PRINT(NI,NO)
      COMMON/T/T/Y/I/F/DIDT/CONST/A
      REAL I
      I=A*I
      WRITE(NO,1)T,I
1     FORMAT(5H T = ,F3.1,3X,4HI = ,F8.6)
      RETURN
      END
INTEGRATION OF EXP(-T**2), RUNGE KUTTA MERSON ALGORITHM
0.        4.0       4.0
    1 4000    3    1  ABS 0.000001
INTEGRATION OF EXP(-T**2), RUNGE KUTTA TANAKA-4 ALGORITHM
0.        4.0       4.0
    1 4000    4    1  ABS 0.000001
INTEGRATION OF EXP(-T**2), RUNGE KUTTA ENGLAND ALGORITHM
0.        4.0       4.0
    1 4000    7    1  ABS 0.000001
END OF RUNS
*APP MATH20
      SUBROUTINE INITAL
C...
C...  LAPLACE TRANSFORM SOLUTION OF SIMULTANEOUS ODES
C...
C...  SOLVE THE FOLLOWING 2X2 SYSTEM OF ORDINARY DIFFERENTIAL EQUATIONS
C...  USING LAPLACE TRANSFORM.  COMPUTE A NUMERICAL SOLUTION FOR COM-
C...  PARISON WITH THE ANALYTICAL SOLUTION.
C...
C...     DY1/DT =  2*Y1 - 3*Y2, Y1(0) = 8
C...
C...     DY2/DT = -2*Y1 +   Y2, Y2(0) = 3
C...
C...  LAPLACE TRANSFORMATION OF THE TWO ODES, INCLUDING THE INITIAL
C...  CONDITIONS, GIVES
C...
C...     S*Y1 - 8 =  2*Y1 - 3*Y2
C...
C...     S*Y2 - 3 = -2*Y1 +   Y2
C...
C...  OR, AFTER REARRANGEMENT,
C...
C...     (S - 2)*Y1 +      3 *Y2 = 8
C...
C...          2 *Y1 + (S - 1)*Y2 = 3
C...
C...  MULTIPLICATION OF THE FIRST EQUATION BY 2, AND THE SECOND EQUATION
C...  BY (S - 2), FOLLOWED BY SUBTRACTION GIVES
C...
C...     ((S - 1)*(S - 2) - 6)*Y2 = 3*(S - 2) - 16
C...
C...     (S**2 - 3*S - 4)*Y2 = 3*S - 22
C...
C...     Y2 = (3*S - 22)/(S**2 - 3*S - 4)
C...
C...        = (3*S - 22)/((S - R1)*(S - R2)) = A/(S - R1) + B/(S - R2)
C...
C...  WHERE A AND B ARE CONSTANTS IN A PARTIAL FRACTIONS EXPANSION OF
C...  Y2.  R1 AND R2 ARE THE EIGENVALUES OF THE ORIGINAL ODE SYSTEM,
C...  I.E.,
C...
C...     R1, R2 = + 3 + (OR -)*((-3)**2 - 4*(1)*-4)**0.5
C...              --------------------------------------
C...                                 2
C...
C...            = -1, 4
C...
C...  A AND B CAN NOW BE EVALUATED,
C...
C...     A = (3*S - 22)/(S - R2)     = (-3 - 22)/(-1 - 4) =  5
C...                            S=R1
C...
C...     B = (3*S - 22)/(S - R1)     = (12 - 22)/( 4 + 1) = -2
C...                            S=R2
C...
C...  THE INVERSE TRANSFORM FOR Y2 IS THEREFORE
C...
C...     Y2 = 5*EXP(-T) - 2*EXP(4*T)
C...
C...  Y1 CAN BE OBTAINED FROM SUBSTITUTION OF Y2 IN THE SECOND ODE,
C...
C...     -5*EXP(-T) - 8*EXP(4*T) = -2*Y1 + (5*EXP(-T) - 2*EXP(4*T))
C...
C...     Y1 = 5*EXP(-T) + 3*EXP(4*T)
C...
C...  THIS SOLUTION CAN BE VERIFIED BY SUBSTITUTION IN THE TWO ODES
C...
C...     Y1(0) = 5 + 3 = 8, Y2(0) = 5 - 2 = 3
C...
C...  FOR THE FIRST ODE,
C...
C...     -5*EXP(-T) + 12*EXP(4*T) = 2*(5*EXP(-T) + 3*EXP(4*T))
C...
C...                              - 3*(5*EXP(-T) - 2*EXP(4*T))
C...
C...     (-5 - 10 + 15)*EXP(-T) + (12 - 6 - 6)*EXP(4*T) = 0
C...
C...  FOR THE SECOND ODE,
C...
C...     -5*EXP(-T) - 8*EXP(4*T) = -2*(5*EXP(-T) + 3*EXP(4*T))
C...
C...                              +   (5*EXP(-T) - 2*EXP(4*T))
C...
C...     (-5 + 10 - 5)*EXP(-T) + ( -8 + 6 + 2)*EXP(4*T) = 0
C...
C...  A NUMERICAL SOLUTION IS COMPUTED IN THE FOLLOWING CODING FOR COM-
C...  PARISON WITH THE PRECEDING ANALYTICAL SOLUTION.
C...
C...  DSS/2 COMMON
      COMMON/T/      T,  NSTOP,  NORUN
     1      /Y/     Y1,     Y2
     2      /F/  DY1DT,  DY2DT
C...
C...  INITIAL CONDITIONS
      Y1=8.
      Y2=3.
C...
C...  INITIAL CONDITIONS
      CALL DERV
      RETURN
      END
      SUBROUTINE DERV
      COMMON/T/      T,  NSTOP,  NORUN
     1      /Y/     Y1,     Y2
     2      /F/  DY1DT,  DY2DT
C...
C...  TWO ODES
      DY1DT= 2.0*Y1-3.0*Y2
      DY2DT=-2.0*Y1+1.0*Y2
      RETURN
      END
      SUBROUTINE PRINT(NI,NO)
      COMMON/T/      T,  NSTOP,  NORUN
     1      /Y/     Y1,     Y2
     2      /F/  DY1DT,  DY2DT
C...
C...  PRINT A HEADING FOR THE SOLUTION
      IF(T.EQ.0.)WRITE(NO,1)
1     FORMAT(9X,'T',4X,'Y1 (NUM)',3X,'Y1 (ANAL)',
     1              4X,'Y2 (NUM)',3X,'Y2 (ANAL)',
     2              4X,'ERROR Y1',4X,'ERROR Y2')
C...
C...  COMPUTE THE ANALYTICAL SOLUTIONS
      Y1A=5.0*EXP(-T)+3.0*EXP(4.0*T)
      Y2A=5.0*EXP(-T)-2.0*EXP(4.0*T)
C...
C...  COMPUTE THE PERCENT DIFFERENCE BETWEEN THE NUMERICAL AND ANALYTI-
C...  CAL SOLUTIONS
      E1=(Y1-Y1A)/Y1A*100.
      E2=(Y2-Y2A)/Y2A*100.
C...
C...  PRINT THE ANALYTICAL AND NUMERICAL SOLUTIONS
      WRITE(NO,2)T,Y1,Y1A,Y2,Y2A,E1,E2
2     FORMAT(F10.1,6F12.4)
      RETURN
      END
LAPLACE TRANSFORM SOLUTION OF SIMULTANEOUS ODES
0.        1.0       0.1
    2 1000    1    1  REL 0.001
END OF RUNS
*APP MATH21
      SUBROUTINE INITAL
C...
C...  TESTING ENERGY CONSERVATION OF ONE-DIMENSIONAL FINITE DIFFERENCE
C...  OPERATORS
C...
C...  THE NUMERICAL INTEGRATION OF ORDINARY AND PARTIAL DIFFERENTIAL
C...  EQUATIONS (ODE/PDES) SHOULD PRODUCE SOLUTIONS WHICH OBEY CERTAIN
C...  WELL ESTABLISHED PHYSICAL PRINCIPLES IF THE ODE/PDES MODEL PHYSI-
C...  CAL SYSTEMS.  ONE SUCH PHYSICAL PRINCIPLE IS THE CONSERVATION OF
C...  ENERGY.
C...
C...  IN THE FOLLOWING PROGRAMMING, WE INVESTIGATE HOW WELL SELECTED
C...  FINITE DIFFERENCE APPROXIMATIONS CONSERVE ENERGY.  THE PROBLEM
C...  IS JUST FOURIER*S SECOND LAW WITH INSULATED BOUNDARY CONDITIONS.
C...  THUS, THE SYSTEM SHOULD NOT LOSE ENERGY AT THE BOUNDARIES, AND
C...  COMPUTED TEMPERATURES SHOULD REFLECT THIS CONSERVATION OF ENERGY.
C...
C...  THE PDE PROBLEM IS
C...
C...     U  = U                                               (1)
C...      T    XX
C...
C...     U (0,T) = U (1,T) = 0, U(X,T) = F(X)                 (2)(3)(4)
C...      X         X
C...
C...  THE FINITE DIFFERENCE APPROXIMATIONS WILL BE TESTED FOR TWO F(X)
C...
C...     (1)  CASE 1
C...
C...          F(X) = X
C...
C...     (2)  CASE 2
C...
C...          F(X) = 1, 0 LE X LT 0.5
C...
C...          F(X) = 0, 0.5 LE X LE 1
C...
C...  IN BOTH CASES, THE LONG-TIME SOLUTION IS U(X,T) = 0.5.
C...
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/     U(21)
     2      /F/    UT(21)
     3      /S/    UX(21),   UXX(21),     X(21)
     4      /C/         N,        IP
C...
C...  SET THE NUMBER OF SPATIAL GRID POINTS
      N=21
C...
C...  SET THE INITIAL CONDITIONS
      IF((NORUN- 1)*(NORUN- 3)*(NORUN- 5)*(NORUN- 7)*(NORUN- 9)*
     +   (NORUN-11)*(NORUN-13)*(NORUN-15)
     +   .EQ.0)
     +   CALL IN1(N,X,U)
      IF((NORUN- 2)*(NORUN- 4)*(NORUN- 6)*(NORUN- 8)*(NORUN-10)*
     +   (NORUN-12)*(NORUN-14)*(NORUN-16)
     +   .EQ.0)
     +   CALL IN2(N,X,U)
C...
C...  INITIAL DERIVATIVES
      CALL DERV
      IP=0
      RETURN
      END
      SUBROUTINE IN1(N,X,U)
C...
C...  SUBROUTINE IN1 IMPLEMENTS THE INTIAL CONDITION
C...
C...    U(X,0) = X
C...
      DIMENSION  X(N), U(N)
      DO 1 I=1,N
      X(I)=FLOAT(I-1)/FLOAT(N-1)
      U(I)=X(I)
1     CONTINUE
      RETURN
      END
      SUBROUTINE IN2(N,X,U)
C...
C...  SUBROUTINE IN2 IMPLEMENTS THE INITIAL CONDITION
C...
C...              1.0, 0 LE X LT 0.5
C...     U(X,0) =
C...              0.0, 0.5 LT X LE 1
C...
      DIMENSION  X(N), U(N)
      N2=N/2+1
      DO 1 I=1,N
      IF(I.LT.N2)U(I)=1.0
      IF(I.GT.N2)U(I)=0.0
      IF(I.EQ.N2)U(I)=0.5
1     CONTINUE
      RETURN
      END
      SUBROUTINE DERV
      COMMON/T/         T,     NSTOP,     NORUN
C...
C...  SOLUTION BY EXPLICIT PROGRAMMING OF SECOND-ORDER DIFFERENCE
C...  APPROXIMATIONS
         IF(NORUN.EQ.1)CALL DERV1
         IF(NORUN.EQ.2)CALL DERV1
C...
C...  SOLUTION BY STAGEWISE DIFFERENTIATION, SECOND-ORDER APPROXIMATIONS
         IF(NORUN.EQ.3)CALL DERV2
         IF(NORUN.EQ.4)CALL DERV2
C...
C...  SOLUTION BY STAGEWISE DIFFERENTIATION, FOURTH-ORDER APPROXIMATIONS
         IF(NORUN.EQ.5)CALL DERV2
         IF(NORUN.EQ.6)CALL DERV2
C...
C...  SOLUTION BY STAGEWISE DIFFERENTIATION, SIXTH-ORDER APPROXIMATIONS
         IF(NORUN.EQ.7)CALL DERV2
         IF(NORUN.EQ.8)CALL DERV2
C...
C...  SOLUTION BY STAGEWISE DIFFERENTIATION, EIGHTH-ORDER APPROXIMATIONS
         IF(NORUN.EQ. 9)CALL DERV2
         IF(NORUN.EQ.10)CALL DERV2
C...
C...  SOLUTION BY STAGEWISE DIFFERENTIATION, TENTH-ORDER APPROXIMATIONS
         IF(NORUN.EQ.11)CALL DERV2
         IF(NORUN.EQ.12)CALL DERV2
C...
C...  SOLUTION BY DIRECT DIFFERENTIATION, SECOND-ORDER APPROXIMATIONS
         IF(NORUN.EQ.13)CALL DERV3
         IF(NORUN.EQ.14)CALL DERV3
C...
C...  SOLUTION BY DIRECT DIFFERENTIATION, FOURTH-ORDER APPROXIMATIONS
         IF(NORUN.EQ.15)CALL DERV3
         IF(NORUN.EQ.16)CALL DERV3
      RETURN
      END
      SUBROUTINE DERV1
C...
C...  SUBROUTINE DERV1 IMPLEMENTS THREE-POINT, SECOND-ORDER CENTERED
C...  DIFFERENCE APPROXIMATIONS OF EQUATIONS (1) TO (3)
C...
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/     U(21)
     2      /F/    UT(21)
     3      /S/    UX(21),   UXX(21),     X(21)
     4      /C/         N,        IP
C...
C...  SPATIAL INTERVAL
      DX=1./FLOAT(N-1)
C...
C...  UXX(0,T) INCLUDING BOUNDARY CONDITION (2)
      UXX(1)=(2.*U(2)-2.*U(1))/DX**2
C...
C...  UXX(DX,T) TO UXX(1-DX,T)
      DO 1 I=2,N-1
      UXX(I)=(U(I+1)-2.*U(I)+U(I-1))/DX**2
1     CONTINUE
C...
C...  UXX(1,T) INCLUDING BOUNDARY CONDITION (3)
      UXX(N)=(2.*U(N-1)-2.*U(N))/DX**2
C...
C...  EQUATION (1)
      DO 2 I=1,N
      UT(I)=UXX(I)
2     CONTINUE
      RETURN
      END
      SUBROUTINE DERV2
C...
C...  SUBROUTINE DERV2 IMPLEMENTS A SERIES OF CENTERED AND NONCENTERED
C...  APPROXIMATIONS OF EQUATIONS (1) TO (3) AS INDICATED BELOW
C...
C...     (1)  SUBROUTINE DSS002
C...
C...          THREE-POINT, SECOND-ORDER CENTERED AND NONCENTERED
C...          APPROXIMATIONS
C...
C...     (2)  SUBROUTINE DSS004
C...
C...          FIVE-POINT, FOURTH-ORDER CENTERED AND NONCENTERED
C...          APPROXIMATIONS
C...
C...     (3)  SUBROUTINE DSS006
C...
C...          SEVEN-POINT, SIXTH-ORDER CENTERED AND NONCENTERED
C...          APPROXIMATIONS
C...
C...     (4)  SUBROUTINE DSS008
C...
C...          NINE-POINT, EIGHTH-ORDER CENTERED AND NONCENTERED
C...          APPROXIMATIONS
C...
C...     (5)  SUBROUTINE DSS010
C...
C...          ELEVEN-POINT, TENTH-ORDER CENTERED AND NONCENTERED
C...          APPROXIMATIONS
C...
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/     U(21)
     2      /F/    UT(21)
     3      /S/    UX(21),   UXX(21),     X(21)
     4      /C/         N,        IP
C...
C...  COMPUTE UX
      IF((NORUN.EQ. 3).OR.(NORUN.EQ. 4))CALL DSS002(0.,1.,N,U,UX)
      IF((NORUN.EQ. 5).OR.(NORUN.EQ. 6))CALL DSS004(0.,1.,N,U,UX)
      IF((NORUN.EQ. 7).OR.(NORUN.EQ. 8))CALL DSS006(0.,1.,N,U,UX)
      IF((NORUN.EQ. 9).OR.(NORUN.EQ.10))CALL DSS008(0.,1.,N,U,UX)
      IF((NORUN.EQ.11).OR.(NORUN.EQ.12))CALL DSS010(0.,1.,N,U,UX)
C...
C...  BOUNDARY CONDITIONS (2) AND (3)
      UX(1)=0.
      UX(N)=0.
C...
C...  COMPUTE UXX
      IF((NORUN.EQ. 3).OR.(NORUN.EQ. 4))CALL DSS002(0.,1.,N,UX,UXX)
      IF((NORUN.EQ. 5).OR.(NORUN.EQ. 6))CALL DSS004(0.,1.,N,UX,UXX)
      IF((NORUN.EQ. 7).OR.(NORUN.EQ. 8))CALL DSS006(0.,1.,N,UX,UXX)
      IF((NORUN.EQ. 9).OR.(NORUN.EQ.10))CALL DSS008(0.,1.,N,UX,UXX)
      IF((NORUN.EQ.11).OR.(NORUN.EQ.12))CALL DSS010(0.,1.,N,UX,UXX)
C...
C...  EQUATION (1)
      DO 2 I=1,N
      UT(I)=UXX(I)
2     CONTINUE
      RETURN
      END
      SUBROUTINE DERV3
C...
C...  SUBROUTINE DERV3 CALLS ROUTINES FOR THE DIRECT CALCULATION OF THE
C...  SECOND-ORDER DERIVATIVE IN EQUATION (1), UXX, FROM U, INCLUDING
C...  BOUNDARY CONDITIONS (2) AND (3), AS INDICATED BELOW
C...
C...     (1)  SUBROUTINE DSS042
C...
C...          SECOND-ORDER APPROXIMATIONS
C...
C...     (2)  SUBROUTINE DSS044
C...
C...          FOURTH-ORDER APPROXIMATIONS
C...
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/     U(21)
     2      /F/    UT(21)
     3      /S/    UX(21),   UXX(21),     X(21)
     4      /C/         N,        IP
C...
C...  BOUNDARY CONDITIONS (2) AND (3)
      UX(1)=0.
      UX(N)=0.
C...
C...  DIRECT CALCULATION OF UXX FROM U
      IF((NORUN.EQ.13).OR.(NORUN.EQ.14))
     +   CALL DSS042(0.,1.,N,U,UX,UXX,2,2)
      IF((NORUN.EQ.15).OR.(NORUN.EQ.16))
     +   CALL DSS044(0.,1.,N,U,UX,UXX,2,2)
C...
C...  EQUATION (1)
      DO 2 I=1,N
      UT(I)=UXX(I)
2     CONTINUE
      RETURN
      END
      SUBROUTINE PRINT(NI,NO)
      COMMON/T/         T,     NSTOP,     NORUN
C...
C...  PRINT AND PLOT THE NUMERICAL SOLUTION
C...     SOLUTIONS FOR WHICH UX IS NOT AVAILABLE
         IF((NORUN- 1)*(NORUN- 2)*(NORUN-13)*(NORUN-14)*
     +      (NORUN-15)*(NORUN-16).EQ.0)CALL PRINT1(NI,NO)
C...
C...     SOLUTIONS FOR WHICH UX IS AVAILABLE
         IF((NORUN- 3)*(NORUN -4)*(NORUN- 5)*(NORUN- 6)*
     +      (NORUN- 7)*(NORUN- 8)*(NORUN- 9)*(NORUN-10)*
     +      (NORUN-11)*(NORUN-12).EQ.0)CALL PRINT2(NI,NO)
      RETURN
      END
      SUBROUTINE PRINT1(NI,NO)
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/     U(21)
     2      /F/    UT(21)
     3      /S/    UX(21),   UXX(21),     X(21)
     4      /C/         N,        IP
C...
C...  DIMENSION THE ARRAYS FOR PLOTTING
      DIMENSION UP(6,21), UTP(6,21)
C...
C...  PRINT THE SOLUTION AT THE BEGINNING AND END OF THE RUN
      IP=IP+1
      IF((IP.EQ.1).OR.(IP.EQ.6))THEN
      WRITE(NO,1)T,(X(I),U(I),UXX(I),UT(I),I=1,N)
1     FORMAT(1H ,//,
     1 9X,'T',11X,'X',11X,'U',9X,'UXX',10X,'UT',/,
     1 F10.2,/,(10X,F12.3,3F12.5))
      END IF
C...
C...  STORE THE SOLUTION FOR PLOTTING
      DO 2 I=1,N
      UP(IP,I)=U(I)
      UTP(IP,I)=UT(I)
2     CONTINUE
C...
C...  PLOT THE SOLUTION AT THE END OF THE RUN
      IF(IP.LT.6)RETURN
C...
C...  U(X,T) VS X WITH T AS A PARAMETER
      CALL TPLOTS(IP,N,X,UP)
      WRITE(NO,10)
10    FORMAT(1H ,//,' U(X,T) VS X WITH T AS A PARAMETER')
C...
C...  UT(X,T) VS X WITH T AS A PARAMETER
      CALL TPLOTS(IP,N,X,UTP)
      WRITE(NO,11)
11    FORMAT(1H ,//,' UT(X,T) VS X WITH T AS A PARAMETER')
C...
C...  COMPUTE A FIGURE OF MERIT FOR THE APPROXIMATION
      SUM=0.
      DO 20 I=1,N
      SUM=SUM+ABS(U(I)-0.5)**2
20    CONTINUE
      SUM=SQRT(SUM)/FLOAT(N)
C...
C...  COMPUTE THE FIGURE OF MERIT
      WRITE(NO,21)SUM
21    FORMAT(1H ,//,
     1 ' AVERAGE DEVIATION FROM 0.5 = ',E10.3)
      RETURN
      END
      SUBROUTINE PRINT2(NI,NO)
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/     U(21)
     2      /F/    UT(21)
     3      /S/    UX(21),   UXX(21),     X(21)
     4      /C/         N,        IP
C...
C...  DIMENSION THE ARRAYS FOR PLOTTING
      DIMENSION UP(6,21), UXP(6,21), UTP(6,21)
C...
C...  PRINT THE SOLUTION AT THE BEGINNING AND END OF THE RUN
      IP=IP+1
      IF((IP.EQ.1).OR.(IP.EQ.6))THEN
      WRITE(NO,1)T,(X(I),U(I),UX(I),UT(I),I=1,N)
1     FORMAT(1H ,//,
     1 9X,'T',11X,'X',11X,'U',10X,'UX',10X,'UT',/,
     1 F10.2,/,(10X,F12.3,3F12.5))
      END IF
C...
C...  STORE THE SOLUTION FOR PLOTTING
      DO 2 I=1,N
      UP(IP,I)=U(I)
      UXP(IP,I)=UX(I)
      UTP(IP,I)=UT(I)
2     CONTINUE
C...
C...  PLOT THE SOLUTION AT THE END OF THE RUN
      IF(IP.LT.6)RETURN
C...
C...  U(X,T) VS X WITH T AS A PARAMETER
      CALL TPLOTS(IP,N,X,UP)
      WRITE(NO,10)
10    FORMAT(1H ,//,' U(X,T) VS X WITH T AS A PARAMETER')
C...
C...  UX(X,T) VS X WITH T AS A PARAMETER
      CALL TPLOTS(IP,N,X,UXP)
      WRITE(NO,11)
11    FORMAT(1H ,//,' UX(X,T) VS X WITH T AS A PARAMETER')
C...
C...  UT(X,T) VS X WITH T AS A PARAMETER
      CALL TPLOTS(IP,N,X,UTP)
      WRITE(NO,12)
12    FORMAT(1H ,//,' UT(X,T) VS X WITH T AS A PARAMETER')
C...
C...  COMPUTE A FIGURE OF MERIT FOR THE APPROXIMATION
      SUM=0.
      DO 20 I=1,N
      SUM=SUM+ABS(U(I)-0.5)**2
20    CONTINUE
      SUM=SQRT(SUM)/FLOAT(N)
C...
C...  COMPUTE THE FIGURE OF MERIT
      WRITE(NO,21)SUM
21    FORMAT(1H ,//,
     1 ' AVERAGE DEVIATION FROM 0.5 = ',E10.3)
      RETURN
      END
THREE-POINT, SECOND-ORDER CENTERED DIFFERENCES
0.        1.0       0.2
   21 1000    1    1  ABS 0.00001
THREE-POINT, SECOND-ORDER CENTERED DIFFERENCES
0.        1.0       0.2
   21 1000    1    1  ABS 0.00001
STAGEWISE DIFFERENTIATION, SECOND-ORDER DIFFERENCES
0.        1.0       0.2
   21 1000    1    1  ABS 0.00001
STAGEWISE DIFFERENTIATION, SECOND-ORDER DIFFERENCES
0.        1.0       0.2
   21 1000    1    1  ABS 0.00001
STAGEWISE DIFFERENTIATION, FOURTH-ORDER DIFFERENCES
0.        1.0       0.2
   21 1000    1    1  ABS 0.00001
STAGEWISE DIFFERENTIATION, FOURTH-ORDER DIFFERENCES
0.        1.0       0.2
   21 1000    1    1  ABS 0.00001
STAGEWISE DIFFERENTIATION, SIXTH-ORDER DIFFERENCES
0.        1.0       0.2
   21 1000    1    1  ABS 0.00001
STAGEWISE DIFFERENTIATION, SIXTH-ORDER DIFFERENCES
0.        1.0       0.2
   21 1000    1    1  ABS 0.00001
STAGEWISE DIFFERENTIATION, EIGHTH-ORDER DIFFERENCES
0.        1.0       0.2
   21 1000    1    1  ABS 0.00001
STAGEWISE DIFFERENTIATION, EIGHTH-ORDER DIFFERENCES
0.        1.0       0.2
   21 1000    1    1  ABS 0.00001
STAGEWISE DIFFERENTIATION, TENTH-ORDER DIFFERENCES
0.        1.0       0.2
   21 1000    1    1  ABS 0.00001
STAGEWISE DIFFERENTIATION, TENTH-ORDER DIFFERENCES
0.        1.0       0.2
   21 1000    1    1  ABS 0.00001
SECOND-ORDER DIFFERENCES, U TO UXX DIRECTLY
0.        1.0       0.2
   21 1000    1    1  ABS 0.00001
SECOND-ORDER DIFFERENCES, U TO UXX DIRECTLY
0.        1.0       0.2
   21 1000    1    1  ABS 0.00001
FOURTH-ORDER DIFFERENCES, U TO UXX DIRECTLY
0.        1.0       0.2
   21 1000    1    1  ABS 0.00001
FOURTH-ORDER DIFFERENECS, U TO UXX DIRECTLY
0.        1.0       0.2
   21 1000    1    1  ABS 0.00001
END OF RUNS
*APP MATH22
      SUBROUTINE INITAL
C...
C...  A COMPARISON OF STAGEWISE DIFFERENTIATION AND DIRECT DIFFERENTIA-
C...  TION IN THE NUMERICAL METHOD OF LINES - LINEAR CASE
C...
C...     SINGLE PRECISION
C...
C...  IN THE FOLLOWING CODING, THREE APPROACHES TO COMPUTING THE
C...  SPATIAL DERIVATIVES IN A ONE-DIMENSIONAL CONVECTIVE-DIFFUSION
C...  PARTIAL DIFFERENTIAL EQUATION (PDE) ARE PROGRAMMED
C...
C...     (1)  THE SPATIAL DERIVATIVES ARE PROGRAMMED EXPLICITLY AS
C...          CONVENTIONAL SECOND-ORDER, THREE-POINT APPROXIMATIONS.
C...
C...     (2)  THE SPATIAL DERIVATIVES ARE COMPUTED BY STAGEWISE DIFFER-
C...          TIATION, E.G., A SECOND-ORDER DERIVATIVE IS COMPUTED AS
C...          THE DERIVATIVE OF A FIRST-ORDER DERIVATIVE.
C...
C...     (3)  THE SPATIAL DERIVATIVES ARE COMPUTED DIRECTLY, E.G., A
C...          SECOND-ORDER DERIVATIVE IS COMPUTED DIRECTLY FROM THE
C...          DEPENDENT VARIABLE FROM FORMULAS WHICH ACCOMMODATE BOTH
C...          DIRICHLET AND NEUMANN BOUNDARY CONDITIONS.
C...
C...  THESE THREE APROACHES ARE ILLUSTRATED IN TERMS OF THE FOLLOWING
C...  CONVECTIVE-DIFFUSION MODEL FOR POLLUTANT DISPERSION IN A RIVER.
C...
C...  THE FOLLOWING MODEL HAS BEEN PROPOSED FOR POLLUTION TRANSPORT
C...  IN A RIVER (1):
C...
C...  U  = A*U   - B*U  - C*U + F(X,T)                          (1)
C...   T      XX      X
C...
C...  WHERE
C...
C...  U       BIOCHEMICAL OXYGEN DEMAND (BOD) (M/L**3)
C...
C...  X       DISTANCE ALONG THE RIVER (L)
C...
C...  T       TIME (T)
C...
C...  A       DISPERSION COEFFICIENT (L**2/T)
C...
C...  B       VELOCITY OF FLOW (L/T)
C...
C...  C       BOD DECAY COEFFICIENT (1/T)
C...
C...  F(X,T)  POLLUTION SOURCES (M/L**3-T)
C...
C...  (1)  SHIBATA, Y., AND W. J. KARPLUS, DISTRIBUTED SOURCE IDENTIFI-
C...       CATION IN RIVER POLLUTION SYSTEMS BY PATTERN RECOGNITION,
C...       TRANS. SOCIETY FOR COMPUTER SIMULATION, VOL. 3, NO. 1, PP.
C...       1-29, JAN., 1986
C...
C...  EQAUTION (1) COULD, FOR EXAMPLE, BE USED TO SIMULATE THE POLLUTION
C...  OF THE RHINE RIVER ON NOVEMBER 10, 1986 RESULTING FROM A LARGE
C...  DISCHARGE OF PESTICIDE FROM A CHEMICAL PLANT IN SWITZERLAND.  THE
C...  SOURCE FUNCTION, F(X,T), WOULD BE THE SPATIAL-TIME DESCRIPTION OF
C...  THE DISCHARGE.
C...
C...  THE FOLLOWING REFERENCES PERTAIN TO THE SPILL:
C...
C...  (2)  LEWIS, PAUL, 'HUGE CHEMICAL SPILL IN THE RHINE CREATES HAVOC
C...       IN FOUR COUNTRIES', THE NEW YORK TIMES, NOVEMBER 11, 1986
C...
C...  (3)  ROTH, TERRENCE, 'SWISS ACCIDENT THAT POLLUTED THE RHINE MAY
C...       HAVE HEAVIEST IMPACT ON GERMANY', THE WALL STREET JOURNAL,
C...       NOVEMBER 11, 1986
C...
C...  (4)  NETTER, THOMAS W., 'ANGER ALONG THE RHINE GROWS AFTER CHEMI-
C...       CAL SPILL', THE NEW YORK TIMES, NOVEMBER 12, 1986
C...
C...  (5)  STUDER, MARGARET A., 'SWISS NEVER THOUGHT SANDOZ DISASTER
C...       COULD HAPPEN IN THEIR ORDERLY WORLD', THE WALL STREET JOUR-
C...       NAL, NOVEMBER 13, 1986
C...
C...  (6)  'EUROPEAN OFFICIALS AGREE ON MEASURES TO PROTECT THE RHINE',
C...       THE WALL STREET JOURNAL, NOVEMBER 13, 1986
C...
C...  (7)  TAGLIABUE, JOHN, 'RHINE POISONING STRETCHING 185 MILES', THE
C...       NEW YORK TIMES, NOVEMBER 13, 1986
C...
C...  (8)  LEWIS, PAUL, 'SWISS WILL PAY COMPENSATION FOR SPILL', THE
C...       NEW YORK TIMES, NOVEMBER 13, 1986
C...
C...  (9)  MARCOM, JOHN, JR., 'EUROPE'S ENVIRONMENTAL POLICY FOUNDERS',
C...       THE WALL STREET JOURNAL, NOVEMBER 14, 1986
C...
C... (10)  'SWISS ANNOUNCE PROCEDURE FOR A CLEANUP OF THE RHINE', THE
C...       STREET JOURNAL, NOVEMBER 14, 1986
C...
C... (11)  NETTER, THOMAS W., 'MERCURY A KEY CONCERN IN RHINE SPILL',
C...       THE NEW YORK TIMES, NOVEMBER 15, 1986
C...
C...  THE INITIAL CONDITION FOR EQUATION (1) IS
C...
C...  U(X,0) = 0, X0 LE X LE XF                                 (2)
C...
C...  AND THE BOUNDARY CONDITIONS ARE
C...
C...  U(X0,T) = U(XF,T) = 0, T GT 0                          (3)(4)
C...
C...  WHERE
C...
C...  X0      X AT THE BEGINNING OF THE RIVER
C...
C...  XF      X AT THE END OF THE RIVER
C...
C...  COMPUTE A SOLUTION TO EQUATIONS (1) TO (4) BY THE NUMERICAL
C...  METHOD OF LINES ON A 51-POINT GRID (49 INTERIOR POINTS).  USE
C...  THE FOLLOWING NUMERICAL VALUES OF THE PARAMETERS
C...
C...  A      25 KM**2/HR
C...
C...  B      5 KM/HR
C...
C...  C      0 1/HR
C...
C...  X0     0 KM
C...
C...  XF     500 KM
C...
C...  F(X,T)       0, X NE 250, T GE 0
C...
C...             100, X = 250, 0 LE T LE 10 HR
C...
C...               0, X = 250, T GT 10 HR
C...
C...  COMPUTE U(X,T) (U(X,T) AT THE 51 GRID POINTS) AND PLOT U(X,T)
C...  VS X FOR SIX VALUES OF T.
C...
C...  THE FOLLOWING CODING IS FOR SIX RUNS OF THE MODEL AS EXPLAINED
C...  IN SUBROUTINE DERV.
C...
C...  DSS/2 COMMON
      COMMON/T/      T,  NSTOP,  NORUN
     1      /Y/  U(51)
     2      /F/ UT(51)
     3      /C/      A,      B,      C,     X0,     XF,     DX,    DXS,
     4           X(51),      N,     IP
C...
C...  MODEL PARAMETERS
      A=25.E0
      B=5.E0
      C=0.E0
      X0=0.E0
      XF=500.E0
      N=51
C...
C...  SPATIAL GRID
      DX=(XF-X0)/FLOAT(N-1)
      DXS=DX*DX
      DO 1 I=1,N
      X(I)=X0+DX*FLOAT(I-1)
1     CONTINUE
      DX=2.0E0*DX
C...
C...  MODEL INITIAL CONDITION (2)
      DO 2 I=1,N
      U(I)=0.E0
2     CONTINUE
C...
C...  INITIAL DERIVATIVES
      CALL DERV
      IP=0
      RETURN
      END
      SUBROUTINE DERV
C...
C...  SUBROUTINE DERV CALL SUBROUTINES DERV1, DERV2,..., FOR ALTERNATE
C...  APPROXIMATIONS OF THE SPATIAL DERIVATIVES IN EQUATION (1) AND
C...  BOUNDARY CONDITION (1)
C...
      COMMON/T/      T,  NSTOP,  NORUN
C...
C...  *****************************************************************
C...
C...  DERV1 IMPLEMENTS EXPLICIT SECOND-ORDER, THREE-POINT APPROXIMATIONS
C...  OF THE SPATIAL DERVATIVES IN EQUATION (1), AND THE DIRCHLET BOUND-
C...  ARY CONDITION U(XF,T) = 0 (I.E., EQUATION (4))
      IF(NORUN.EQ.1)CALL DERV1
C...
C...  *****************************************************************
C...
C...  DERV2 IMPLEMENTS EXPLICIT SECOND-ORDER, THREE-POINT APPROXIMATIONS
C...  OF THE SPATIAL DERIVATIVES IN EQUATION (1), AND THE NEUMANN BOUND-
C...  ARY CONDITION U (XF,T) = 0
C...                 X
      IF(NORUN.EQ.2)CALL DERV2
C...
C...  *****************************************************************
C...
C...  DERV3 IMPLEMENTS STAGEWISE DIFFERENTIATION FOR THE CALCULATION OF
C...  THE SPATIAL DERIVATIVES IN EQUATION (1) BY SECOND-ORDER, THREE-
C...  POINT APPROXIMATIONS, AND THE NEUMANN BOUNDARY CONDITION U (XF,T)
C...  = 0                                                       X
      IF(NORUN.EQ.3)CALL DERV3
C...
C...  *****************************************************************
C...
C...  DERV4 IMPLEMENTS STAGEWISE DIFFERENTIATION FOR THE CALCULATION OF
C...  THE SPATIAL DERIVATIVES IN EQUATION (1) BY FOURTH-ORDER, FIVE-
C...  POINT APPROXIMATIONS, AND THE NEUMANN BOUNDARY CONDITION U (XF,T)
C...  = 0                                                       X
      IF(NORUN.EQ.4)CALL DERV4
C...
C...  *****************************************************************
C...
C...  DERV5 IMPLEMENTS DIRECT DIFFERENTIATION FOR THE CALCULATION OF
C...  THE SPATIAL DERIVATIVES IN EQUATION (1) BY SECOND-ORDER APPROXI-
C...  MATIONS, AND THE NEUMANN BOUNDARY CONDITION U (XF,T) = 0
C...                                               X
      IF(NORUN.EQ.5)CALL DERV5
C...
C...  *****************************************************************
C...
C...  DERV6 IMPLEMENTS DIRECT DIFFERENTIATION FOR THE CALCULATION OF
C...  THE SPATIAL DERIVATIVES IN EQUATION (1) BY FOURTH-ORDER APPROXI-
C...  MATIONS, AND THE NEUMANN BOUNDARY CONDITION U (XF,T) = 0
C...                                               X
      IF(NORUN.EQ.6)CALL DERV6
C...
C...  *****************************************************************
C...
      RETURN
      END
      SUBROUTINE DERV1
C...
C...  SUBROUTINE DERV1 IMPLEMENTS THE NUMERICAL METHOD OF LINES
C...  SOLUTION OF EQUATIONS (1) TO (4) BY EXPLIICIT PROGRAMMING OF
C...  THE SPATIAL DERIVATIVES.  THE ADVANTAGES AND DISADVANTAGES OF
C...  THIS APPROACH ARE
C...
C...     (1)  ADVANTAGES
C...
C...          (1.1)  THE DETAILS OF THE APPROXIMATIONS ARE CLEARLY
C...                 DEFINED
C...
C...          (1.2)  THE METHOD IS DISCUSSED EXTENSIVELY IN THE
C...                 CLASSICAL NUMERICAL ANALYSIS LITERATURE (HOPE-
C...                 FULLY THIS IS A TEMPORARY ADVANTAGE)
C...
C...     (2)  DIASDVANTAGES
C...
C...          (2.1)  A DETAILED KNOWLEDGE OF THE APPROPRIATE APPROXI-
C...                 MATIONS FOR SPATIAL DERIVATIVES IS REQUIRED
C...
C...          (2.2)  THE APPROXIMATIONS MUST BE PROGRAMMED CAREFULLY,
C...                 FOR EACH NEW APPLICATION.  THIS REQUIREMENT IS
C...                 PARTICULARLY DEMANDING FOR COMPLEX PDES
C...
C...          (2.4)  FICTITIOUS POINTS OUTSIDE THE SPATIAL DOMAIN OF
C...                 THE PROBLEM MAY BE REQUIRED
C...
C...          (2.4)  NEW APPROXIMATIONS MAY BE REQUIRED (THAT HAVE NOT
C...                 YET BEEN DEVELOPED), PARTICULARLY FOR NONLINEAR
C...                 PROBLEMS
C...
      COMMON/T/      T,  NSTOP,  NORUN
     1      /Y/  U(51)
     2      /F/ UT(51)
     3      /C/      A,      B,      C,     X0,     XF,     DX,    DXS,
     4           X(51),      N,     IP
      COMMON/S/ UX(51),UXX(51)
C...
C...  BOUNDARY CONDITION (3)
      U(1)=0.E0
      UT(1)=0.E0
C...
C...  BOUNDARY CONDITION (4)
      U(N)=0.E0
      UT(N)=0.E0
C...
C...  EQUATION (1)
      DO 1 I=2,N-1
      UT(I)=A*(U(I+1)-2.0E0*U(I)+U(I-1))/DXS
     1     -B*(U(I+1)-U(I-1))/DX
     2     -C*U(I)+F(X(I),T)
1     CONTINUE
      RETURN
      END
      SUBROUTINE DERV2
C...
C...  SUBROUTINE DERV2 IMPLEMENTS THE NUMERICAL METHOD OF LINES
C...  SOLUTION OF EQUATIONS (1) TO (3) WITH BOUNDARY CONDITION (4)
C...  REPLACED BY THE NEUMANN BOUNDARY CONDITION U (XF,T) = 0.
C...                                              X
C...  THE APPROXIMATIONS OF THE SPATIAL DERIVATIVES ARE PROGRAMMED
C...  EXPLICITLY.  THE ADVANTAGES AND DISADVANTAGES OF THIS APPROACH
C...  ARE
C...
C...     (1)  ADVANTAGES
C...
C...          (1.1)  THE DETAILS OF THE APPROXIMATIONS ARE CLEARLY
C...                 DEFINED
C...
C...          (1.2)  THE METHOD IS DISCUSSED EXTENSIVELY IN THE
C...                 CLASSICAL NUMERICAL ANALYSIS LITERATURE (HOPE-
C...                 FULLY THIS IS A TEMPORARY ADVANTAGE)
C...
C...     (2)  DIASDVANTAGES
C...
C...          (2.1)  A DETAILED KNOWLEDGE OF THE APPROPRIATE APPROXI-
C...                 MATIONS FOR SPATIAL DERIVATIVES IS REQUIRED
C...
C...          (2.2)  THE APPROXIMATIONS MUST BE PROGRAMMED CAREFULLY,
C...                 FOR EACH NEW APPLICATION.  THIS REQUIREMENT IS
C...                 PARTICULARLY DEMANDING FOR COMPLEX PDES
C...
C...          (2.4)  FICTITIOUS POINTS OUTSIDE THE SPATIAL DOMAIN OF
C...                 THE PROBLEM MAY BE REQUIRED
C...
C...          (2.4)  NEW APPROXIMATIONS MAY BE REQUIRED (THAT HAVE NOT
C...                 YET BEEN DEVELOPED), PARTICULARLY FOR NONLINEAR
C...                 PROBLEMS
C...
      COMMON/T/      T,  NSTOP,  NORUN
     1      /Y/  U(51)
     2      /F/ UT(51)
     3      /C/      A,      B,      C,     X0,     XF,     DX,    DXS,
     4           X(51),      N,     IP
C...
C...  BOUNDARY CONDITION (3)
      U(1)=0.E0
      UT(1)=0.E0
C...
C...  NEUMANN BOUNDARY CONDITION
      U(N)=(1.0E0/3.0E0)*(4.0E0*U(N-1)-U(N-2))
      UT(N)=0.E0
C...
C...  EQUATION (1)
      DO 1 I=2,N-1
      UT(I)=A*(U(I+1)-2.0E0*U(I)+U(I-1))/DXS
     1     -B*(U(I+1)-U(I-1))/DX
     2     -C*U(I)+F(X(I),T)
1     CONTINUE
      RETURN
      END
      SUBROUTINE DERV3
C...
C...  SUBROUTINE DERV3 IMPLEMENTS THE NUMERICAL METHOD OF LINES
C...  SOLUTION OF EQUATIONS (1) TO (3) WITH BOUNDARY CONDITION (4)
C...  REPLACED BY THE NEUMANN BOUNDARY CONDITION U (XF,T) = 0.  THE
C...                                              X
C...  SPATIAL DERIVATIVES ARE COMPUTED BY STAGEWISE DIFFERENIATION, E.G.,
C...  THE SECOND SPATIAL DERIVATIVE, UXX, IS COMPUTED AS THE DERIVATIVE
C...  OF THE FIRST SPATIAL DERIVATIVE, UX.  THE STAGEWISE DIFFERENTIA-
C...  TION IS DONE BY THREE-POINT, SECOND-ORDER FORMULAS.
C...
C...  THE ADVANTAGES AND DISADVANTAGES OF THIS APPROACH ARE
C...
C...     (1)  ADVANTAGES
C...
C...          (1.1)  THE DIFFERENTIATION FORMULAS ARE ALREADY PRO-
C...                 GRAMMED, AND THEREFORE A DETAILED KNOWLEDGE OF
C...                 THE APPROXIMATIONS AND POSSIBLE ERRORS IN THEIR
C...                 PROGRAMMING ARE AVOIDED
C...
C...          (1.2)  STAGEWISE DIFFERENTIATION OFFERS ESSENTIALLY
C...                 UNLIMITED FLEXIBILITY, PARTICULARLY WITH REGARD
C...                 TO NONLINEAR SPATIAL DERIVATIVE TERMS IN THE PDES
C...
C...          (1.3)  FICTITIOUS POINTS ARE AVOIDED
C...
C...     (2)  DISADVANTAGES
C...
C...          (2.1)  THE JACOBIAN MATRIX BANDWIDTH OF THE ODE SYSTEM
C...                 RESULTING FROM STAGEWISE DIFFERENTIATION INCREASES
C...                 AT EACH STAGE OF DIFFERENTIATION.  THIS CAN BE
C...                 DEMONSTRATED BY THE FOLLOWING APPLICATION OF THE
C...                 NUMERICAL METHOD OF LINES TO FOURIER'S SECOND LAW
C...
C...                 U  = U
C...                  T    XX
C...
C...                 IF THREE-POINT CENTERED ARRPROXIMATIONS FOR UX ARE
C...                 APPLIED SUCCESSIVELY TO THIS PDE
C...
C...                 DU(I)/DT = (UX(I+1) - UX(I-1))/(2*DX) + O(DX**2)
C...
C...                          = ((U(I+2) - U(I))/(2*DX)
C...
C...                           - (U(I) - U(I-2))/(2*DX))/(2*DX)
C...
C...                          + O(DX**1)
C...
C...                          = (U(I+2) - 2*U(I) + U(I-2))/(2*DX)**2
C...
C...                          + O(DX)
C...
C...                 THIS RESULT INDICATES THAT THE BANDWIDTH OF THE
C...                 ODES IS FIVE (NOTE THE SUBSCRIPTS (I-2) TO (I+2))
C...                 RATHER THAN THREE (THE BANDWIDTH OF THE FIRST-
C...                 DERIVATIVE APPROXIMATIONS).
C...
C...          (2.2)  EACH STAGE OF DIFFERENTIATION REDUCES THE ORDER OF
C...                 THE APPROXIMATION BY ONE, E.G., NOTE THAT THE PRE-
C...                 CEDING APPROXIMATION IS O(DX) RATHER THAN O(DX**2)
C...                 (AS IN THE FIRST-DERIVATIVE APPROXIMATIONS).  THIS
C...                 REDUCTION IN ACCURACY IS NOT SURPRISING IN VIEW OF
C...                 THE PRECEDING RESULT, I.E., THE FIRST-ORDER APPROXI-
C...                 MATION FOR UXX, (U(I+2) - 2*U(I) + U(I-2))/(4*DX)**2
C...                 IS USED IN PLACE OF THE WELL-KNOWN SECOND-ORDER
C...                 APPROXIMATION (U(I+1) - 2*U(I) + U(I-1))/DX**2.
C...
      COMMON/T/      T,  NSTOP,  NORUN
     1      /Y/  U(51)
     2      /F/ UT(51)
     3      /C/      A,      B,      C,     X0,     XF,     DX,    DXS,
     4           X(51),      N,     IP
      DIMENSION UX(51),UXX(51)
C...
C...  BOUNDARY CONDITION (3)
      U(1)=0.E0
      UT(1)=0.E0
C...
C...  COMPUTE UX
      CALL DSS002(X0,XF,N,U,UX)
C...
C...  NEUMANN BOUNDARY CONDITION
      UX(N)=0.E0
C...
C...  COMPUTE UXX
      CALL DSS002(X0,XF,N,UX,UXX)
C...
C...  EQUATION (1)
      DO 1 I=2,N
      UT(I)=A*UXX(I)-B*UX(I)-C*U(I)+F(X(I),T)
1     CONTINUE
      RETURN
      END
      SUBROUTINE DERV4
C...
C...  SUBROUTINE DERV4 IMPLEMENTS THE NUMERICAL METHOD OF LINES
C...  SOLUTION OF EQUATIONS (1) TO (3) WITH BOUNDARY CONDITION (4)
C...  REPLACED BY THE NEUMANN BOUNDARY CONDITION U (XF,T) = 0.  THE
C...                                              X
C...  SPATIAL DERIVATIVES ARE COMPUTED BY STAGEWISE DIFFERENIATION, E.G.,
C...  THE SECOND SPATIAL DERIVATIVE, UXX, IS COMPUTED AS THE DERIVATIVE
C...  OF THE FIRST SPATIAL DERIVATIVE, UX.  THE STAGEWISE DIFFERENTIA-
C...  TION IS DONE BY FIVE-POINT, FOURTH-ORDER FORMULAS.
C...
C...  THE ADVANTAGES AND DISADVANTAGES OF THIS APPROACH ARE
C...
C...     (1)  ADVANTAGES
C...
C...          (1.1)  THE DIFFERENTIATION FORMULAS ARE ALREADY PRO-
C...                 GRAMMED, AND THEREFORE A DETAILED KNOWLEDGE OF
C...                 THE APPROXIMATIONS AND POSSIBLE ERRORS IN THEIR
C...                 PROGRAMMING ARE AVOIDED
C...
C...          (1.2)  STAGEWISE DIFFERENTIATION OFFERS ESSENTIALLY
C...                 UNLIMITED FLEXIBILITY, PARTICULARLY WITH REGARD
C...                 TO NONLINEAR SPATIAL DERIVATIVE TERMS IN THE PDES
C...
C...          (1.3)  FICTITIOUS POINTS ARE AVOIDED
C...
C...     (2)  DISADVANTAGES
C...
C...          (2.1)  THE JACOBIAN MATRIX BANDWIDTH OF THE ODE SYSTEM
C...                 RESULTING FROM STAGEWISE DIFFERENTIATION INCREASES
C...                 AT EACH STAGE OF DIFFERENTIATION.  THIS CAN BE
C...                 DEMONSTRATED BY THE FOLLOWING APPLICATION OF THE
C...                 NUMERICAL METHOD OF LINES TO FOURIER'S SECOND LAW
C...
C...                 U  = U
C...                  T    XX
C...
C...                 IF THREE-POINT CENTERED ARRPROXIMATIONS FOR UX ARE
C...                 APPLIED SUCCESSIVELY TO THIS PDE
C...
C...                 DU(I)/DT = (UX(I+1) - UX(I-1))/(2*DX) + O(DX**2)
C...
C...                          = ((U(I+2) - U(I))/(2*DX)
C...
C...                           - (U(I) - U(I-2))/(2*DX))/(2*DX)
C...
C...                          + O(DX**1)
C...
C...                          = (U(I+2) - 2*U(I) + U(I-2))/(2*DX)**2
C...
C...                          + O(DX)
C...
C...                 THIS RESULT INDICATES THAT THE BANDWIDTH OF THE
C...                 ODES IS FIVE (NOTE THE SUBSCRIPTS (I-2) TO (I+2))
C...                 RATHER THAN THREE (THE BANDWIDTH OF THE FIRST-
C...                 DERIVATIVE APPROXIMATIONS).
C...
C...          (2.2)  EACH STAGE OF DIFFERENTIATION REDUCES THE ORDER OF
C...                 THE APPROXIMATION BY ONE, E.G., NOTE THAT THE PRE-
C...                 CEDING APPROXIMATION IS O(DX) RATHER THAN O(DX**2)
C...                 (AS IN THE FIRST-DERIVATIVE APPROXIMATIONS).  THIS
C...                 REDUCTION IN ACCURACY IS NOT SURPRISING IN VIEW OF
C...                 THE PRECEDING RESULT, I.E., THE FIRST-ORDER APPROXI-
C...                 MATION FOR UXX, (U(I+2) - 2*U(I) + U(I-2))/(4*DX)**2
C...                 IS USED IN PLACE OF THE WELL-KNOWN SECOND-ORDER
C...                 APPROXIMATION (U(I+1) - 2*U(I) + U(I-1))/DX**2.
C...
      COMMON/T/      T,  NSTOP,  NORUN
     1      /Y/  U(51)
     2      /F/ UT(51)
     3      /C/      A,      B,      C,     X0,     XF,     DX,    DXS,
     4           X(51),      N,     IP
      DIMENSION UX(51),UXX(51)
C...
C...  BOUNDARY CONDITION (3)
      U(1)=0.E0
      UT(1)=0.E0
C...
C...  COMPUTE UX
      CALL DSS004(X0,XF,N,U,UX)
C...
C...  NEUMANN BOUNDARY CONDITION
      UX(N)=0.E0
C...
C...  COMPUTE UXX
      CALL DSS004(X0,XF,N,UX,UXX)
C...
C...  EQUATION (1)
      DO 1 I=2,N
      UT(I)=A*UXX(I)-B*UX(I)-C*U(I)+F(X(I),T)
1     CONTINUE
      RETURN
      END
      SUBROUTINE DERV5
C...
C...  SUBROUTINE DERV5 IMPLEMENTS THE NUMERICAL METHOD OF LINES
C...  SOLUTION OF EQUATIONS (1) TO (3) WITH BOUNDARY CONDITION (4)
C...  REPLACED BY THE NEUMANN BOUNDARY CONDITION U (XF,T) = 0.  THE
C...                                              X
C...  SPATIAL DERIVATIVES  ARE COMPUTED BY DIRECT DIFFERENTIATION, E.G.,
C...  THE SECOND DERVIVATIVE, UXX, IS COMPUTED DIRECTLY FROM THE DEPEND-
C...  ENT VARIABLE, U.  THE DIFFERENTIATION IS DONE BY SECOND-ORDER
C...  FORMULAS.
C...
C...  THE ADVANTAGES AND DISADVANTAGES OF THIS APPROACH ARE
C...
C...     (1)  ADVANTAGES
C...
C...          (1.1)  THE DIFFERENTIATION FORMULAS ARE ALREADY PRO-
C...                 GRAMMED, AND THEREFORE A DETAILED KNOWLEDGE OF
C...                 THE APPROXIMATIONS AND POSSIBLE ERRORS IN THEIR
C...                 PROGRAMMING ARE AVOIDED
C...
C...          (1.2)  DIRECT DIFFERENTIATION AVOIDS THE REDUCTION IN
C...                 ACCURACY AND THE INCREASE IN THE ODE BANDWIDTH
C...                 PRODUCED BY STAGEWISE DIFFERENTIATION
C...
C...          (1.3)  FICTITIOUS POINTS ARE AVOIDED
C...
C...     (2)  DISADVANTAGES
C...
C...          (2.1)  THE FORMULAS ARE LOW ORDER, BUT CAN EASILY BE
C...                 EXTENDED TO HIGHER ORDER (THIS HAS IN FACT ALREADY
C...                 BEEN DONE, AND FOURTH-ORDER FORMULAS ARE AVAILABLE
C...                 IN SUBROUTINE DSS044 CALLED IN SUBROUTINE DERV6)
C...
C...          (2.2)  THE PROGRAMMING OF THE DIFFERENTIATION FORMULAS
C...                 IS FOR ONE SPATIAL DIMENSION, BUT EXTENSIONS TO
C...                 TWO AND THREE SPATIAL DIMENSIONS IS STRAIGHTFOR-
C...                 WARD
C...
      COMMON/T/      T,  NSTOP,  NORUN
     1      /Y/  U(51)
     2      /F/ UT(51)
     3      /C/      A,      B,      C,     X0,     XF,     DX,    DXS,
     4           X(51),      N,     IP
      DIMENSION UX(51),UXX(51)
C...
C...  BOUNDARY CONDITION (3)
      U(1)=0.E0
      UT(1)=0.E0
C...
C...  COMPUTE UX
      CALL DSS002(X0,XF,N,U,UX)
C...
C...  NEUMANN BOUNDARY CONDITION
      UX(N)=0.E0
C...
C...  COMPUTE UXX (DIRECTLY FROM U)
      CALL DSS042(X0,XF,N,U,UX,UXX,1,2)
C...
C...  EQUATION (1)
      DO 1 I=2,N
      UT(I)=A*UXX(I)-B*UX(I)-C*U(I)+F(X(I),T)
1     CONTINUE
      RETURN
      END
      SUBROUTINE DERV6
C...
C...  SUBROUTINE DERV6 IMPLEMENTS THE NUMERICAL METHOD OF LINES
C...  SOLUTION OF EQUATIONS (1) TO (3) WITH BOUNDARY CONDITION (4)
C...  REPLACED BY THE NEUMANN BOUNDARY CONDITION U (XF,T) = 0.  THE
C...                                              X
C...  SPATIAL DERIVATIVES  ARE COMPUTED BY DIRECT DIFFERENTIATION, E.G.,
C...  THE SECOND DERVIVATIVE, UXX, IS COMPUTED DIRECTLY FROM THE DEPEND-
C...  ENT VARIABLE, U.  THE DIFFERENTIATION IS DONE BY FOURTH-ORDER
C...  FORMULAS.
C...
C...  THE ADVANTAGES AND DISADVANTAGES OF THIS APPROACH ARE
C...
C...     (1)  ADVANTAGES
C...
C...          (1.1)  THE DIFFERENTIATION FORMULAS ARE ALREADY PRO-
C...                 GRAMMED, AND THEREFORE A DETAILED KNOWLEDGE OF
C...                 THE APPROXIMATIONS AND POSSIBLE ERRORS IN THEIR
C...                 PROGRAMMING ARE AVOIDED
C...
C...          (1.2)  DIRECT DIFFERENTIATION AVOIDS THE REDUCTION IN
C...                 ACCURACY AND THE INCREASE IN THE ODE BANDWIDTH
C...                 PRODUCED BY STAGEWISE DIFFERENTIATION
C...
C...          (1.3)  FICTITIOUS POINTS ARE AVOIDED
C...
C...          (1.4)  THE HIGHER-ORDER (FOURTH-ORDER) FORMULAS GIVE GOOD
C...                 ACCURACY
C...
C...     (2)  DISADVANTAGES
C...
C...          (2.1)  THE PROGRAMMING OF THE DIFFERENTIATION FORMULAS
C...                 IS FOR ONE SPATIAL DIMENSION, BUT EXTENSIONS TO
C...                 TWO AND THREE SPATIAL DIMENSIONS IS STRAIGHTFOR-
C...                 WARD
C...
      COMMON/T/      T,  NSTOP,  NORUN
     1      /Y/  U(51)
     2      /F/ UT(51)
     3      /C/      A,      B,      C,     X0,     XF,     DX,    DXS,
     4           X(51),      N,     IP
      DIMENSION UX(51),UXX(51)
C...
C...  BOUNDARY CONDITION (3)
      U(1)=0.E0
      UT(1)=0.E0
C...
C...  COMPUTE UX
      CALL DSS004(X0,XF,N,U,UX)
C...
C...  NEUMANN BOUNDARY CONDITION
      UX(N)=0.E0
C...
C...  COMPUTE UXX (DIRECTLY FROM U)
      CALL DSS044(X0,XF,N,U,UX,UXX,1,2)
C...
C...  EQUATION (1)
      DO 1 I=2,N
      UT(I)=A*UXX(I)-B*UX(I)-C*U(I)+F(X(I),T)
1     CONTINUE
      RETURN
      END
      FUNCTION F(X,T)
C...
C...  FUNCTION F(X,T) DEFINES THE POLLUTION SOURCE FUNCTION
C...
C...  POLLUTION ENTERS THE RIVER AT X = 250
      IF((X.GT.249.5E0).AND.(X.LT.250.5E0))THEN
C...
C...  THE POLLUTION ENTERS THE RIVER FOR 10 TIME UNITS
         IF(T.LE.10.E0)THEN
            F=100.E0
         ELSE
C...
C...  AFTER TEN TIME UNITS, THE POLLUTION IS ENDED
            F=0.E0
         END IF
      ELSE
C...
C...  THE RIVER IS NOT POLLUTED AT OTHER LOCATIONS (THAN X = 250)
         F=0.E0
      END IF
      RETURN
      END
      SUBROUTINE PRINT(NI,NO)
      COMMON/T/      T,  NSTOP,  NORUN
     1      /Y/  U(51)
     2      /F/ UT(51)
     3      /C/      A,      B,      C,     X0,     XF,     DX,    DXS,
     4           X(51),      N,     IP
C...
C...  ADDITIONAL ARRAY FOR PLOTTING
      COMMON/CAL/ UP(6,51)
C...
C...  PRINT A HEADING FOR THE SOLUTION
      IP=IP+1
      IF(IP.EQ.1)WRITE(NO,1)
1     FORMAT(9X,'T',6X,'U(0,T)',4X,'U(100,T)',4X,'U(200,T)',
     1            4X,'U(300,T)',4X,'U(400,T)',4X,'U(500,T)')
C...
C...  PRINT THE NUMERICAL SOLUTION
      WRITE(NO,2)T,U(1),U(11),U(21),U(31),U(41),U(51)
2     FORMAT(F10.2,6F12.4)
C...
C...  STORE THE SOLUTION FOR PLOTTING
      DO 3 I=1,N
      UP(IP,I)=U(I)
3     CONTINUE
C...
C...  PLOT THE SOLUTION
      IF(IP.LT.6)RETURN
      CALL TPLOTS(IP,N,X,UP)
      WRITE(NO,4)
4     FORMAT(1H ,/,' BIOCHEMICAL OXYGEN DEMAND (BOD) VS X',/,
     1             ' WITH T AS A PARAMETER, T = 0, 20,..., 100')
C...
C...  *****************************************************************
C...
C...  THE FOLLOWING CALL TO A CONTINUOUS PLOTTER IS MACHINE DEPENDENT
C...  AND MUST BE CHANGED FOR OTHER COMPUTERS OR CONVERTED TO COMMENTS.
C...  IF SUBROUTINE CALCOM IS NOT CALLED, SUBORDINATE ROUTINES QIKSAX,
C...  QIKSET, QIKPLT, LABEL AND SYMBOL ALSO WILL NOT BE CALLED
C...  CALL CALCOM
C...
C...  *****************************************************************
C...
      RETURN
      END
      SUBROUTINE CALCOM
C...
C...  SUBROUTINE CALCOM DRAWS THE PLOT OF THE NUMERICAL SOLUTION ON A
C...  CONTINUOUS PLOTTER
C...
      COMMON/T/      T,  NSTOP,  NORUN
     1      /Y/  U(51)
     2      /F/ UT(51)
     3      /C/      A,      B,      C,     X0,     XF,     DX,    DXS,
     4           X(51),      N,     IP
C...
C...  ADDITIONAL ARRAY FOR PLOTTING
      COMMON/CAL/ UP(6,51)
C...
C...  PLOT U(X,T) VS X FOR T = 0, 20,..., 100
      CALL QIKSAX(3,3)
C...
C...  FOR RUNS 1, 2 AND 5, THE AXES ARE GIVEN A COMMON SCALE FOR
C...  COMPARISON OF THE PLOTS.  FOR RUNS 3 AND 4, THE SOLUTIONS ARE
C...  SO OSCILLATORY THAT SCALING IS DONE AUTOMATICALLY
      IF((NORUN.EQ.1).OR.(NORUN.EQ.2).OR.(NORUN.EQ.5))THEN
      CALL QIKSET(5.,0.,100.,8.,-10.,20.)
      END IF
C...
C...  THE SOLUTION FOR SIX TIMES, T = 0, 20,..., 100 IS PLOTTED WITH
C...  THE FOLLOWING CALL TO QIKPLT
      CALL QIKPLT(X,UP,-N,8H*X (KM)*,14H*U(X,T) (BOD)*,
     1 33H*BIOCHEMICAL OXYGEN DEMAND (BOD)*,-6)
C...
C...  DRAW A LEGEND FOR THE PLOTS
      CALL LABEL
      RETURN
      END
      SUBROUTINE LABEL
C...
C...  SUBROUTINE LABEL PRINTS LEGENDS ON THE PLOTS OF THE NUMERICAL
C...  SOLUTION DRAWN BY THE CONTINUOUS PLOTTER
C...
C...  DIMENSION THE ARRAY AND DEFINE THE NUMERICAL CODES FOR THE
C...  PLOTTED SYMBOLS
      DIMENSION ISYM(6)
      DATA ISYM/1,2,3,4,5,6/
C...
C...  PRINT THE FIRST LINE IN THE LEGEND
      X1=-5.25
      X2=-5.11
      Y1=10.0
      Y2=9.95
      CALL SYMBOL(X1,Y1,0.125,ISYM(1),0.,-1)
      CALL SYMBOL(X2,Y2,0.125,13H - T = 0 (HR),0.,13)
C...
C...  PRINT THE SECOND LINE IN THE LEGEND
      Y1=Y1-0.35
      Y2=Y2-0.35
      CALL SYMBOL(X1,Y1,0.125,ISYM(2),0.,-1)
      CALL SYMBOL(X2,Y2,0.125,9H - T = 20,0.,9)
C...
C...  PRINT THE THIRD LINE IN THE LEGEND
      Y1=Y1-0.35
      Y2=Y2-0.35
      CALL SYMBOL(X1,Y1,0.125,ISYM(3),0.,-1)
      CALL SYMBOL(X2,Y2,0.125,9H - T = 40,0.,9)
C...
C...  PRINT THE FOURTH LINE IN THE LEGEND
      Y1=Y1-0.35
      Y2=Y2-0.35
      CALL SYMBOL(X1,Y1,0.125,ISYM(4),0.,-1)
      CALL SYMBOL(X2,Y2,0.125,9H - T = 60,0.,9)
C...
C...  PRINT THE FIFTH LINE IN THE LEGEND
      Y1=Y1-0.35
      Y2=Y2-0.35
      CALL SYMBOL(X1,Y1,0.125,ISYM(5),0.,-1)
      CALL SYMBOL(X2,Y2,0.125,9H - T = 80,0.,9)
C...
C...  PRINT THE SIXTH LINE IN THE LEGEND
      Y1=Y1-0.35
      Y2=Y2-0.35
      CALL SYMBOL(X1,Y1,0.125,ISYM(6),0.,-1)
      CALL SYMBOL(X2,Y2,0.125,10H - T = 100,0.,10)
      RETURN
      END
DIRCHLET BOUNDARY CONDITION, EXPLICIT PROGRAMMING
0.        100.0     20.0
   51 1000    1    1  ABS 0.001
NEUMANN BOUNDARY CONDITION, EXPLICIT PROGRAMMING
0.        100.0     20.0
   51 1000    1    1  ABS 0.001
STAGEWISE DIFFERENTIATION, SECOND-ORDER FORMULAS
0.        100.0     20.0
   51 1000    1    1  ABS 0.001
STAGEWISE DIFFERENTIATION, FOURTH-ORDER FORMULAS
0.        100.0     20.0
   51 1000    1    1  ABS 0.001
DIRECT DIFFERENTIATION, SECOND-ORDER FORMULAS
0.        100.0     20.0
   51 1000    1    1  ABS 0.001
DIRECT DIFFERENTIATION, FOURTH-ORDER FORMULAS
0.        100.0     20.0
   51 1000    1    1  ABS 0.001
END OF RUNS
*APP MATH23
      SUBROUTINE INITAL
C...
C...  DIRECT AND STAGEWISE DIFFERENTIATION IN THE NUMERICAL METHOD OF
C...  LINES - NONLINEAR CASE
C...
C...     SINGLE PRECISION
C...
C...  CONSIDER THE FOLLOWING NONLINEAR PARABOLIC PDE
C...
C...     U  = (F(U)U )  - U                                      (1)
C...      T         X X
C...
C...  WITH THE INITIAL CONDITION
C...
C...     U(X,0) = (1 - X)                                        (2)
C...
C...  AND THE BOUNDARY CONDITIONS
C...
C...     U(0,T) = 1, U(1,T) = 0                               (3)(4)
C...
C...  THE FOLLOWING CODING IS FOR A METHOD OF LINES SOLUTION OF EQUA-
C...  TIONS (1) TO (4) WITH THE DERIVATIVES IN X COMPUTED BY DIRECT
C...  DIFFERENTIATION AND STAGEWISE DIFFERENTIATION.  IN EACH CASE,
C...  F(U) = U.
C...
C...  DSS/2 COMMON AREA
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/     U(51)
     2      /F/    UT(51)
     3      /S/    UX(51),   UXX(51)
     4      /C/        XL,        XU,     X(51),         N,       IP
C...
C...  SET THE MODEL PARAMETERS
      XL=0.E0
      XU=1.E0
      N=51
C...
C...  INITIAL CONDITION
      DO 1 I=1,N
      X(I)=XL+(XU-XL)*FLOAT(I-1)/FLOAT(N-1)
      U(I)=1.E0-X(I)
1     CONTINUE
C...
C...  INITIAL DERIVATIVES
      CALL DERV
      IP=0
      RETURN
      END
      SUBROUTINE DERV
C...
C...  SUBROUTINE DERV CALLS A SERIES OF DERIVATIVE SUBROUTINES, DERV1,
C...  DERV2, ETC., WHICH IMPLEMENT VARIOUS METHOD OF LINES APPROXIMATIONS
C...  OF EQUATION (1).
C...
      COMMON/T/         T,     NSTOP,     NORUN
C...
C...  *****************************************************************
C...
C...  SOLUTION BY STAGEWISE DIFFERENTIATION APPLIED TO (U*U )
C...                                                       X X
      IF(NORUN.EQ.1)CALL DERV1
C...
C...  *****************************************************************
C...
C...  SOLUTION BY STAGEWISE DIFFERENTIATION APPLIED TO U*U   + U **2
C...                                                      XX    X
      IF(NORUN.EQ.2)CALL DERV2
C...
C...  *****************************************************************
C...
C...  SOLUTION BY DIRECT DIFFERENTIATION APPLIED TO U*U   + U **2
C...                                                   XX    X
      IF(NORUN.EQ.3)CALL DERV3
C...
C...  *****************************************************************
C...
      RETURN
      END
      SUBROUTINE DERV1
C...
C...  SOLUTION BY STAGEWISE DIFFERENTIATION APPLIED TO (U*U )
C...                                                       X X
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/     U(51)
     2      /F/    UT(51)
     3      /S/    UX(51),   UXX(51)
     4      /C/        XL,        XU,     X(51),         N,       IP
C...
C...  BOUNDARY CONDITIONS (3) AND (4)
      U(1)=1.E0
      U(N)=0.E0
C...
C...  U
C...   X
      CALL DSS004(XL,XU,N,U,UX)
C...
C...  U*U  (ARRAY UX IS USED TO TEMPORARILY STORE U*U )
C...     X                                           X
      DO 1 I=1,N
      UX(I)=U(I)*UX(I)
1     CONTINUE
C...
C...  (U*U )
C...      X X
      CALL DSS004(XL,XU,N,UX,UXX)
C...
C...  EQUATION (1)
      DO 2 I=2,N-1
      UT(I)=UXX(I)
2     CONTINUE
      UT(1)=0.E0
      UT(N)=0.E0
      RETURN
      END
      SUBROUTINE DERV2
C...
C...  SOLUTION BY STAGEWISE DIFFERENTIATION APPLIED TO U*U   + U **2
C...                                                      XX    X
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/     U(51)
     2      /F/    UT(51)
     3      /S/    UX(51),   UXX(51)
     4      /C/        XL,        XU,     X(51),         N,       IP
C...
C...  BOUNDARY CONDITIONS (3) AND (4)
      U(1)=1.E0
      U(N)=0.E0
C...
C...  U
C...   X
      CALL DSS004(XL,XU,N,U,UX)
C...
C...  U
C...   XX
      CALL DSS004(XL,XU,N,UX,UXX)
C...
C...  EQUATION (1)
      DO 2 I=2,N-1
      UT(I)=U(I)*UXX(I)+UX(I)**2-U(I)
2     CONTINUE
      UT(1)=0.E0
      UT(N)=0.E0
      RETURN
      END
      SUBROUTINE DERV3
C...
C...  SOLUTION BY DIRECT DIFFERENTIATION APPLIED TO U*U   + U **2
C...                                                   XX    X
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/     U(51)
     2      /F/    UT(51)
     3      /S/    UX(51),   UXX(51)
     4      /C/        XL,        XU,     X(51),         N,       IP
C...
C...  BOUNDARY CONDITIONS (3) AND (4)
      U(1)=1.E0
      U(N)=0.E0
C...
C...  U
C...   X
      CALL DSS004(XL,XU,N,U,UX)
C...
C...  U
C...   XX
      CALL DSS042(XL,XU,N,U,UX,UXX,1,1)
C...
C...  EQUATION (1)
      DO 2 I=2,N-1
      UT(I)=U(I)*UXX(I)+UX(I)**2-U(I)
2     CONTINUE
      UT(1)=0.E0
      UT(N)=0.E0
      RETURN
      END
      SUBROUTINE PRINT(NI,NO)
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/     U(51)
     2      /F/    UT(51)
     3      /S/    UX(51),   UXX(51)
     4      /C/        XL,        XU,     X(51),         N,       IP
C...
C...  DIMENSION THE ARRAYS FOR PLOTTING
      COMMON/P/ UP(6,51)
C...
C...  PRINT A HEADING FOR THE SOLUTION
      IP=IP+1
      IF(IP.EQ.1)WRITE(NO,1)
1     FORMAT(1H ,//,20X,'X = 0.0',5X,'X = 0.2',5X,'X = 0.4',
     1               5X,'X = 0.6',5X,'X = 0.8',5X,'X = 1.0')
C...
C...  PRINT THE SOLUTION
      WRITE(NO,2)T,(U(I),I=1,N,10)
2     FORMAT(' T = ',F10.2,(6F12.4))
C...
C...  STORE THE SOLUTION FOR PLOTTING
      DO 3 I=1,N
      UP(IP,I)=U(I)
3     CONTINUE
C...
C...  PLOT THE SOLUTION
      IF(IP.LT.6)RETURN
      CALL TPLOTS(IP,N,X,UP)
      WRITE(NO,4)
4     FORMAT(1H ,//,' U(X,T) VS X, T = 0, 0.2, 0.4,..., 1.0')
C...
C...  ****************************************************************
C...
C...  THE FOLLOWING CALL TO A CONTINUOUS PLOTTER IS MACHINE DEPENDENT
C...  AND MUST BE CHANGED FOR OTHER COMPUTERS OR CONVERTED TO COMMENTS.
C...  IF SUBROUTINE CALCOM IS NOT CALLED, SUBORDINATE ROUTINES QIKSAX,
C...  QIKSET AND QIKPLT ALSO WILL NOT BE CALLED
C...
C...  CALL CALCOM
C...
C...  ****************************************************************
C...
      RETURN
      END
      SUBROUTINE CALCOM
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/     U(51)
     2      /F/    UT(51)
     3      /S/    UX(51),   UXX(51)
     4      /C/        XL,        XU,     X(51),         N,       IP
C...
C...  DIMENSION THE ARRAYS FOR PLOTTING
      COMMON/P/ UP(6,51)
C...
C...  PLOT U(X,T) VS X, T = 0, 0.2, 0.4,..., 1.0
      CALL QIKSAX(3,3)
      CALL QIKSET(5.,0.,0.2,7.,-0.2,0.2)
      CALL QIKPLT(X,UP,N,3H*X*,8H*U(X,T)*,
     1 22H*NONLINEAR FICK'S LAW*,IP)
      RETURN
      END
STAGEWISE DIFFERENTIATION APPLIED TO D(U*DU/DX)/DX
0.        1.0       0.2
   51 1000    1    1  ABS 0.001
STAGEWISE DIFFERENTIATION APPLIED TO U*UXX + UX**2
0.        1.0       0.2
   51 1000    1    1  ABS 0.001
DIRECT DIFFERENTIATION APPLIED TO U*UXX + UX**2
0.        1.0       0.2
   51 1000    1    1  ABS 0.001
END OF RUNS
*APP MATH24
      SUBROUTINE INITAL
C...
C...  EXPLICIT AND IMPLICIT ORDINARY DIFFERENTIAL EQUATIONS
C...
C...  THE FOLLOWING DISCUSSION AND PROGRAMMING PERTAINS TO EXPLICIT
C...  AND IMPLICIT ORDINARY DIFFERENTIAL EQUATIONS (ODES).  THE DIS-
C...  CUSSION IS IN TERMS OF A FOURTH-ORDER SYSTEM OF ODES WHICH
C...  MODEL A TWO-PENDULUM MASS SPRING SYSTEM.
C...
C...  THE FOLLOWING SYSTEM OF LINEAR ORDINARY DIFFERENTIAL EQUATIONS
C...  HAS BEEN REPORTED BY KANE ET AL* FOR THE DYNAMICS OF A PLANAR
C...  DOUBLE PENDULUM CONSISTING OF TWO IDENTICAL, UNIFORM, PIN-
C...  CONNECTED RODS, EACH OF LENGTH L AND MASS M
C...
C...     - -     - -   -
C...     M*Q   + S*Q = 0                                        (1)
C...        TT
C...
C...  WHERE THE SUBSCRIPT TT DENOTES A SECOND-ORDER DERIVATIVE WITH
C...  RESPECT TO TIME, T.
C...
C...  * KANE, THOMAS R., PETER W. LIKINS AND DAVID A LEVINSON, SPACE-
C...    CRAFT DYNAMICS, MCGRAW-HILL BOOK COMPANY, NEW YORK, 1983, P.
C...    405, PROB. 4.17
C...
C...  EQUATION (1) IS A MATRIX EQUATION WITH THE FOLLOWING ELEMENTS
C...
C...         ....      .. ..                     ..   ..
C...     -   .Q1.  -   .8 3.  -                  .12 -6.
C...     Q = .  ., M = .   ., S = (SIGMA/(M*L**2).     .
C...         .Q2.      .3 2.                     .-6  6.
C...         ....      .. ..                     ..   ..
C...
C...  WHERE Q1 AND Q2 ARE ANGULAR DISPLACEMENTS OF THE TWO PENDULUMS
C...  DEPICTED BELOW
C...
C...        .                    Q1                         Q2
C...        .                    +                          +
C...        ....         L       .     ....       L         .
C...        .S1.........................S2...................
C...        ....         M             ....       M
C...        .
C...        .
C...
C...  EQUAL LINEAR TORSIONAL SPRINGS, S1 AND S2, OF MODULUS SIGMA ARE
C...  ATTACHED AS INDICATED AND BOTH SPRINGS ARE UNDEFORMED WHEN ANGLES
C...  Q1 AND Q2 ARE EQUAL TO ZERO.
C...
C...  (1)  CONVERT EQUATION (1) TO A SYSTEM OF FOUR FIRST-ORDER ORDI-
C...       NARY DIFFERENTIAL EQUATIONS (ODES) BY DEFINING THE FOUR
C...       STATE VARIABLES
C...
C...       X1 = Q1, X2 = Q1 , X3 = Q2, X4 = Q2
C...                       T                  T
C...
C...       TAKE SIGMA/M*L**2 = 1.
C...
C...  (2)  WRITE THE SYSTEM OF FIRST-ORDER ODES IN MATRIX FORM AS
C...
C...       - -    --   -
C...       A*X  + BX = 0                                        (2)
C...          T
C...
C...             -   ..         ..T     -     -
C...       WHERE X = .X1 X2 X3 X4.  AND A AND B ARE 4 X 4 MATRICES TO
C...                 ..         ..
C...
C...       BE DETERMINED FROM PART (1).  A SUPERSCRIPT T DENOTES A MATRIX
C...       TRANSPOSE (IN PARTICULAR, A ROW MATRIX TRANSPOSES TO A COLUMN
C...       MATRIX).
C...
C...  (3)  NUMERICALLY INTEGRATE EQUATION (2) FOR THE INITIAL CONDITIONS
C...
C...       Q1(0) = 1, Q1 (0) = Q2(0) = Q2 (0) = 0
C...                    T                T
C...
C...  (1)  THE SECOND-ORDER ODES ARE
C...
C...       8*Q1   + 3*Q2   + 12*Q1 - 6*Q2 = 0
C...           TT       TT
C...
C...       3*Q1   + 2*Q2   -  6*Q1 + 6*Q2 = 0
C...           TT       TT
C...
C...       IF THE SUBSTITUTIONS FOR Q1 AND Q2 ARE MADE, THE PRECEDING
C...       SECOND-ORDER ODES REDUCE TO FOUR FIRST-ORDER ODES
C...
C...       8*X2  + 3*X4  + 12*X1 - 6*X3 = 0
C...           T       T
C...
C...       3*X2  + 2*X4  -  6*X1 + 6*X3 = 0
C...           T       T
C...
C...       X1  = X2
C...         T
C...
C...       X3  = X4
C...         T
C...
C...  (2)  THE PRECEDING FOUR FIRST-ORDER ODES CAN BE WRITTEN IN MATRIX
C...       FORM AS
C...
C...       ..       .. ..   ..   ..           .. ..  ..   .. ..
C...       .         . .     .   .             . .    .   .   .
C...       . 0 8 0 3 . . X1  .   . 12  0 -6  0 . . X1 .   . 0 .
C...       .         . .   T .   .             . .    .   .   .
C...       . 0 3 0 2 . . X2  .   . -6  0  6  0 . . X2 .   . 0 .
C...       .         .*.   T . + .             .*.    . = .   .   (3)
C...       . 1 0 0 0 . . X3  .   .  0 -1  0  0 . . X3 .   . 0 .
C...       .         . .   T .   .             . .    .   .   .
C...       . 0 0 1 0 . . X4  .   .  0  0  0 -1 . . X4 .   . 0 .
C...       .         . .   T .   .             . .    .   .   .
C...       ..       .. ..   ..   ..           .. ..  ..   .. ..
C...
C...                    -     -
C...       THE MATRICES A AND B ARE CLEARLY IDENTIFIED FROM THE PRECED-
C...       ING MATRIX EQUATION.
C...
C...  (3)  MATRIX EQUATION (2) DEFINES A SET OF IMPLICIT ODES.  THE
C...       TERM IMPLICIT DENOTES THE COUPLING OF THE ODES THROUGH
C...       THE DERIVATIVES IN T, I.E., EACH ODE IN GENERAL CONTAINS
C...                                                            -
C...       MORE THAN ONE DERIVATIVE DUE TO THE COUPLING MATRIX, A.
C...
C...       MOST, BUT NOT ALL, NUMERICAL INTEGRATORS REQUIRE EXPLICIT
C...       ODES, I.E., A SYSTEM OF ODES IN WHICH EACH EQUATION CONTAINS
C...       ONLY ONE DERIVATIVE.  THE EXCEPTIONS ARE INTEGRATORS LIKE
C...       LSODI AND DASSL.  THUS, EQUATION (2) MUST BE PREMULTIPLIED
C...          --1                 -
C...       BY A   (THE INVERSE OF A) IN ORDER TO ARRIVE AT A SYSTEM OF
C...       EXPLICIT ODES).
C...
C...       ANOTHER WAY TO LOOK AT THIS REQUIREMENT IS TO CONSIDER THE
C...                                                  -
C...       COUPLING MATRIX TO BE THE IDENTITY MATRIX, I, IN THE CASE OF
C...       EXPLICIT ODES.  THUS,
C...
C...       --1 - -    --1 - -   -
C...       A  *A*X  + A  *B*X = 0
C...
C...       OR
C...
C...       - -    --1 - -   -
C...       I*X  + A  *B*X = 0
C...          T
C...
C...       IN ORDER TO ARRIVE AT THIS FINAL FORM IN THE PRESENT CASE,
C...       THE FIRST TWO EQUATIONS OF MATRIX EQUATION (3) CAN BE SOLVED
C...       SIMULTANEOUSLY FOR X2  AND X4 .  IF THE FIRST EQUATION IS
C...                            T       T
C...       IS MULTIPLIED BY 2 AND THE SECOND BY 3, AND THE TWO EQUA-
C...       TIONS ARE SUBTRACTED, AN EQUATION EXPLICIT IN X2  IS OBTAINED
C...                                                       T
C...       7*X2  + 42*X1 - 30*X3 = 0
C...           T
C...
C...       SIMILARLY, IF THE FIRST EQUATION OS MULTIPLIED BY 3 AND
C...       THE SECOND BY 8, AND THE TWO EQUATIONS ARE SUBTRACTED, AN
C...       EQUATION EXPLICIT IN X4  IS OBTAINED
C...                              T
C...
C...       -7*X4  + 84*X1 - 66*X3 = 0
C...            T
C...
C...       WE NOW HAVE A SET OF FOUR EXPLICIT ODES WHICH CAN BE INTE-
C...       GRATED SUBJECT TO THE GIVEN INITIAL CONDITIONS.
C...
C...       AS AN ADDITIONAL POINT, NOTE THAT A SET OF LINEARLY COUPLED
C...       ODES, E.G., EQUATION (3), CAN BE UNCOUPLED, I.E., CONVERTED
C...       FROM IMPLICIT TO EXPLICIT FORM USING A CONVENTIONAL LINEAR
C...       ALGEBRAIC EQUATION SOLVER.  THIS IS A USEFUL TECHNIQUE IF
C...       ODE INTEGRATOR DESIGNED SPECIFICALLY FOR IMPLICIT ODES IS
C...       NOT READILY AVAILABLE.
C...
C...  (3)  THE NUMERICAL INTEGRATION OF THE EXPLICIT ODES IS PROGRAMMED
C...       IN THE SUBSEQUENT SUBROUTINES INITAL, DERV AND PRINT.
C...
C...  DSS/2 COMMON AREA
      COMMON/T/      T,  NOSTOP,  NORUN
     1      /Y/    X1 ,     X2 ,    X3 ,    X4
     2      /F/    X1T,     X2T,    X3T,    X4T
     3      /C/     IP
C...
C...  SET THE INITIAL CONDITIONS
      X1=1.
      X2=0.
      X3=0.
      X4=0.
C...
C...  INITIAL DERIVATIVES
      CALL DERV
      IP=0
      RETURN
      END
      SUBROUTINE DERV
      COMMON/T/      T,  NOSTOP,  NORUN
     1      /Y/    X1 ,     X2 ,    X3 ,    X4
     2      /F/    X1T,     X2T,    X3T,    X4T
     3      /C/     IP
C...
C...  FOUR FIRST-ORDER EXPLICIT ODES
      X1T=X2
      X2T=( 1.0/7.0)*(-42.0*X1+30.0*X3)
      X3T=X4
      X4T=(-1.0/7.0)*(-84.0*X1+66.0*X3)
      RETURN
      END
      SUBROUTINE PRINT(NI,NO)
      COMMON/T/      T,  NOSTOP,  NORUN
     1      /Y/    X1 ,     X2 ,    X3 ,    X4
     2      /F/    X1T,     X2T,    X3T,    X4T
     3      /C/     IP
C...
C...  DIMENSION THE ARRAYS FOR THE PLOTTED SOLUTION
      DIMENSION X1X3P(2,1001), X2X4P(2,1001), TP(1001)
C...
C...  PRINT A HEADING FOR THE SOLUTION
      IP=IP+1
      IF(IP.EQ.1)WRITE(NO,2)
2     FORMAT(9X,'T',10X,'Q1',9X,'Q1T',10X,'Q2',9X,'Q2T')
C...
C...  PRINT THE SOLUTION EVERY 50TH CALL TO SUBROUTINE PRINT
      IF(((IP-1)/50*50).EQ.(IP-1))THEN
         WRITE(NO,1)T,X1,X2,X3,X4
1        FORMAT(F10.2,4F12.4)
      END IF
C...
C...  STORE THE SOLUTION FOR PLOTTING
      X1X3P(1,IP)=X1
      X1X3P(2,IP)=X3
      X2X4P(1,IP)=X2
      X2X4P(2,IP)=X4
      TP(IP)=T
C...
C...  PLOT THE SOLUTION
      IF(IP.LT.1001)RETURN
C...
C...  *****************************************************************
C...
C...  THE FOLLOWING CALLS TO A CONTINUOUS PLOTTER ARE MACHINE DEPENDENT
C...  AND MUST BE MODIFIED FOR OTHER COMPUTERS OR CONVERTED TO COMMENTS
C...
C...  PLOT Q1(T), Q2(T) VS T
      CALL QIKSAX(3,3)
      CALL QIKPLT(TP,X1X3P,IP,3H*T*,14H*Q1(T), Q2(T)*,2H**,2)
C...
C...  PLOT Q1T(T), Q2T(T) VS T
      CALL QIKSAX(3,3)
      CALL QIKPLT(TP,X2X4P,IP,3H*T*,16H*Q1T(T), Q2T(T)*,2H**,2)
C...
C...  *****************************************************************
C...
      RETURN
      END
DYNAMICS OF TWO COUPLED PENDULUMS
0.        10.0      0.01
    4 1000    1    1  REL 0.001
END OF RUNS
*APP MATH25
      SUBROUTINE INITAL
C...
C...  EVEN WHEN THE ANALYTICAL SOLUTION TO AN ODE IS AVAILABLE, THE
C...  NUMERICAL SOLUTION MAY BE MUCH EASIER TO COMPUTE AND USE
C...
C...  THE FOLLOWING FIRST-ORDER, LINEAR ORDINARY DIFFERENTIAL EQUATION
C...  IS INTEGRATED ANALYTICALLY AND NUMERICALLY.  THE ANALYTICAL
C...  SOLUTION IS USED TO COMPUTE THE TRUNCATION ERROR OF THE NUMERICAL
C...  COMPUTED BY EULER INTEGRATION.  THIS ERROR IS THEN PLOTTED VS THE
C...  INTEGRATION STEP SIZE TO DETERMINE THE APPARENT ORDER OF THE EULER
C...  METHOD.  A NUMERICAL SOLUTION IS ALSO COMPUTED BY ONE OF THE VARI-
C...  ABLE STEP INTEGRATORS OF DSS/2.
C...
C...     A*DH/DT = Q0 - Q, H(0) = 100                            (1)(2)
C...
C...     Q = CV*(H**0.5)                                            (3)
C...
C...  THE CONSTANTS HAVE THE VALUES
C...
C...     A       500
C...
C...     Q0      10000
C...
C...     CV      500
C...
C...  EQUATIONS (1) TO (3) ARE A MATHEMATICAL MODEL FOR THE FOLLOWING
C...  PHYSICAL SYSTEM
C...
C...        Q0 ........
C...                  .
C...                  .
C...            .     .     .
C...            .     +     .
C...            .           .
C...       H(T) .............
C...            .           .
C...            .     A     .
C...            .           .         ...
C...            ...................... . ........... ----+ Q
C...                                  ...
C...                                   CV
C...
C...  THE HEIGHT OF LIQUID IN THE TANK, H(T), IS COMPUTED FROM AN
C...  UNSTEADY MATERIAL BALANCE, EQUATION (1).  THE FLOW THROUGH THE
C...  VALVE IS GIVEN BY THE USUAL SQUARE-ROOT RELATIONSHIP, EQUATION
C...  (3).
C...
C...  THE ANALYTICAL SOLUTION TO EQUATIONS (1) TO (3) CAN BE DERIVED BY
C...  SEPARATION OF VARIABLES
C...
C...     A*DH/(Q0 - CV*(H**0.5)) = DT
C...
C...  IF WE MAKE THE SUBSTITUTION H = X**2, THEN (WITH DH = 2*X*DX)
C...
C...     A*2*X*DX/(Q0 - CV*X)) = DT                                 (4)
C...
C...  FROM THE TABULATED INTEGRAL
C...
C...     INT X*DX/(A + B*X) = X/B - (A/B**2)*LN(A + B*X)
C...
C...  (INT DENOTES AN INDEFNITE INTEGRAL), EQUATION (4) INTEGRATES TO
C...
C...     2*A*(-X/CV - (Q0/CV**2)*LN(Q0 - CV*X)) = T + CONST
C...
C...  RETURNING TO H, AND PUTTING IN THE LIMITS, T = 0, H = H0, T = T,
C...  H = H,
C...
C...     2*A*(-H**0.5/CV - (Q0/CV**2)*LN(Q0 - CV*H**0.5))
C...
C...   - 2*A*(-H0**0.5/CV - (Q0/CV**2)*LN(Q0 - CV*H0**0.5)) = T     (5)
C...
C...  EQUATION (5) IS A TRANSCENDENTAL EQUATION IN H AND CANNOT EASILY
C...  BE SOLVED ANALYTICALLY FOR H.  A NUMERICAL PROCEDURE, NEWTON'S
C...  METHOD, WILL THEREFORE BE USED TO OBTAIN H.
C...
C...  DSS/2 COMMON AREA
      COMMON/T/      T
     1      /Y/      H
     2      /F/   DHDT
     3      /C/      A,     Q0,     CV,     H0,     IP
C...
C...  SET THE MODEL PARAMETERS
      A=500.
      Q0=10000.
      CV=500.
      H0=100.
C...
C...  INITIAL CONDITION (2)
      H=H0
C...
C...  INITIAL DERIVATIVE
      CALL DERV
      IP=0
      RETURN
      END
      SUBROUTINE DERV
      COMMON/T/      T
     1      /Y/      H
     2      /F/   DHDT
     3      /C/      A,     Q0,     CV,     H0,     IP
C...
C...  MODEL ALGEBRA
      Q=CV*SQRT(H)
C...
C...  MODEL DIFFERENTIAL EQUATIONS (EQUATION (1))
      DHDT=(1./A)*(Q0-Q)
      RETURN
      END
      SUBROUTINE PRINT(NI,NO)
      COMMON/T/      T
     1      /Y/      H
     2      /F/   DHDT
     3      /C/      A,     Q0,     CV,     H0,     IP
C...
C...  DIMENSION THE ARRAYS FOR PLOTTING
      DIMENSION TP(51), HP(51)
C...
C...  PRINT A HEADING FOR THE SOLUTION
      IF(IP.EQ.0)WRITE(NO,1)
1     FORMAT(9X,'T',11X,'H',7X,'DH/DT')
C...
C...  PRINT THE NUMERICAL SOLUTION
      WRITE(NO,2)T,H,DHDT
2     FORMAT(F10.1,2F12.2)
C...
C...  STORE THE SOLUTION FOR PLOTTING
      IP=IP+1
      TP(IP)=T
      HP(IP)=H
C...
C...  PLOT THE SOLUTION
      IF(IP.LT.51)RETURN
C...
C...  ******************************************************************
C...
C...  THE FOLLOWING CALLS TO A CONTINUOUS PLOTTER ARE MACHINE DEPENDENT
C...  AND WILL HAVE TO BE CONVERTED TO THE USER*S LOCAL PLOTTER OR CON-
C...  VERTED TO COMMENTS
C...  CALL QIKSAX(3,3)
C...  CALL QIKPLT(TP,HP,IP,3H*T*,6H*H(T)*,2H**,1)
C...
C...  ******************************************************************
C...
      CALL TPLOTS(1,IP,TP,HP)
      WRITE(NO,3)
3     FORMAT(1H ,//,' H(T) VS T')
C...
C...  PERFORM AN EULER INTEGRATION OF EQUATIONS (1) TO (3) AND AN
C...  ANALYSIS OF THE ASSOCIATED TRUNCATION ERROR
      CALL EULER(NI,NO)
      RETURN
      END
      SUBROUTINE EULER(NI,NO)
C...
C...  SUBROUTINE EULER PERFORMS A FIXED-STEP EULER INTEGRATION OF
C...  EQUATIONS (1) TO (3), AND AN ANALYSIS OF THE ASSOCIATED
C...  TRUNCATION ERROR
C...
C...  DIMENSION THE ARRAYS REQUIRED BY SUBROUTINE IFLSQ
      DIMENSION DTP(5), EP(5), AE(2), WK(10), XP(2), YP(2)
C...
C...  EXTERNAL THE FUNCTION CALLED BY SUBROUTINE IFLSQ
      EXTERNAL F
C...
C...  INITIALIZE THE COUNTER FOR THE PLOTTED RESULTS
      IP=0
C...
C...  INITIALIZE THE MODEL PARAMETERS
      A=500.
      Q0=10000.
      CV=500.
      H0=100.
C...
C...  SET THE FINAL TIME
      TF=100.
C...
C...  STEP THROUGH A SERIES OF EULER INTEGRATIONS
      NCASES=5
      DO 1 I=1,NCASES
C...
C...  SET THE INTEGRATION STEP SIZE
      IF(I.EQ.1)DT=10.
      IF(I.EQ.2)DT=5.
      IF(I.EQ.3)DT=2.
      IF(I.EQ.4)DT=1.
      IF(I.EQ.5)DT=0.5
C...
C...  COMPUTE THE NUMBER OF EULER STEPS
      NSTEPS=TF/DT+1.
C...
C...  PRINT A HEADING FOR THE NUMERICAL SOLUTION
      WRITE(NO,5)DT
5     FORMAT(1H1,25H INTEGRATION STEP (DT) = ,F6.2,//,
     1    9X,1HT,11X,1HH,10X,2HHA,5X,7HABS ERR,5X,7HREL ERR)
C...
C...  BEGIN THE EULER INTEGRATION
C...
C...  INITIALIZE THE PRINT TIME
      TP=0.
C...
C...  INITIALIZE THE INDEPENDENT VARIABLE
      T=-DT
C...
C...  SET THE INITIAL CONDITIONS
      H=H0
C...
C...  STEP THROUGH THE EULER INTEGRATION
      DO 2 J=1,NSTEPS
      T=T+DT
C...
C...  PRINT THE ANALYTICAL AND NUMERICAL SOLUTIONS AND THE ERRORS
C...  AT THE SPECIFIED PRINT TIMES
      IF(T.LT.(0.9999*TP).OR.T.GT.(1.0001*TP))GO TO 4
C...
C...  THE ANALYTICAL SOLUTION CANNOT BE COMPUTED BY NEWTON'S METHOD
C...  IN FUNCTION ANAL AS THE SYSTEM APPROACHES THE STEADY STATE H =
C...  400.  THIS DIFFICULTY ARISES FROM THE FACT THAT AT STEADY STATE,
C...  Q0 - CV*(H**0.5) = 0 AND THE LN(Q0 - CV*(H**05)) TERM BEGINS TO
C...  CAUSE PROBLEMS IN THE NEWTON ITERATION (SEE THE EQUATIONS IN
C...  FUNCTION ANAL).  THEREFORE, THE ANALYTICAL SOLUTION IS COMPUTED
C...  AND PRINTED ALONG WITH THE NUMERICAL SOLUTION ONLY UP TO AND IN-
C...  CLUDING T = 50.  H = 400 CAN EASILY BE ESTABLISHED AS THE STEADY
C...  STATE SOLUTION.  SINCE Q0 - CV*(H**0.5) = 0, WITH Q0 = 10000,
C...  CV = 500, H = (10000/500)**2 = 400
      IF(T.LE.50.0001)THEN
C...
C...  COMPUTE THE ANALYTICAL SOLUTION
      HA=ANAL(A,Q0,CV,H0,T)
C...
C...  COMPUTE THE ABSOLUTE AND RELATIVE DIFFERENCES BETWEEN THE
C...  ANALYTICAL AND NUMERICAL SOLUTIONS
      ABSERR=(H-HA)
      RELERR=ABSERR/HA
C...
C...  PRINT THE SOLUTIONS AND DIFFERENCES
      WRITE(NO,3)T,H,HA,ABSERR,RELERR
3     FORMAT(F10.1,4F12.5)
      TP=TP+10.
C...
C...  BEYOND T = 50, ONLY THE ANALYTICAL SOLUTION IS PRINTED
      ELSE
      WRITE(NO,3)T,H
      TP=TP+10.
      END IF
C...
C...  STORE THE ABSOLUTE ERROR AT T = 50 FOR SUBSEQUENT PLOTTING
      IF(T.LT.(49.9999).OR.T.GT.(50.0001))GO TO 4
      IP=IP+1
      DTP(IP)=ALOG10(DT)
      EP(IP)=ALOG10(ABS(ABSERR))
C...
C...  TAKE AN EULER STEP
4     DHDT=(1./A)*(Q0-CV*SQRT(H))
      H=H+DHDT*DT
2     CONTINUE
C...
C...  THE CURRENT EULER SOLUTION IS COMPLETE
1     CONTINUE
C...
C...  ALL OF THE EULER SOLUTIONS ARE COMPLETE, SO CALL SUBROUTINE IFLSQ
C...  TO COMPUTE THE LINEAR LEAST SQUARES COEFFICIENTS OF THE ERROR-DT
C...  VALUES (IFLSQ IS FROM THE IMSL LIBRARY AND CANNOT BE PROVIDED AS
C...  PART OF DSS/2)
      M=5
      N=2
      CALL IFLSQ(F,DTP,EP,M,AE,N,WK,IER)
C...
C...  PRINT THE LEAST SQUARES COEFFICIENTS
      WRITE(NO,601)(AE(I),I=1,N)
601   FORMAT(1H ,//,27H LEAST SQUARES COEFFICIENTS,2E12.4)
C...
C...  COMPUTE TWO POINTS ON THE LEAST SQUARES LINE FOR PLOTTING
      XP(1)=ALOG10(0.1)
      XP(2)=ALOG10(10.)
      YP(1)=AE(1)+AE(2)*XP(1)
      YP(2)=AE(1)+AE(2)*XP(2)
C...
C...  PLOT THE ABSOLUTE ERROR VS INTEGRATION STEP SIZE ON A LOG-LOG
C...  BASIS TO DETERMINE THE APPARENT ORDER OF EULER*S METHOD
C...
C...  ******************************************************************
C...
C...  THE FOLLOWING CALLS TO A CONTINUOUS PLOTTER ARE MACHINE DEPENDENT
C...  AND WILL HAVE TO BE CONVERTED TO THE USER*S LOCAL PLOTTER OR CON-
C...  VERTED TO COMMENTS
C...
C...  CALL QIKSAX(3,3)
C...  CALL QIKPLT(DTP,EP,-M,9H*LOG(DT)*,14H*LOG(ABS ERR)*,2H**,1)
C...
C...  PLOT THE LEAST SQUARES LINE
C...  CALL PLOT(-7.,1.,-3)
C...  CALL QLINE(XP,YP,2,0)
C...
C...  ******************************************************************
C...
      RETURN
      END
      FUNCTION F(K,X)
C...
C...  FUNCTION F DEFINES THE BASIS FUNCTIONS FOR THE LINEAR LEAST
C...  SQUARES LINE RELATING THE ABSOLUTE ERROR (ABSERR) AND INTEGRATION
C...  STEP SIZE (DT)
C...
      IF(K.EQ.1)F=1.
      IF(K.EQ.2)F=X
      RETURN
      END
      FUNCTION ANAL(A,Q0,CV,H0,T)
C...
C...  FUNCTION ANAL COMPUTES A SOLUTION TO EQUATION (5) FOR A GIVEN
C...  VALUE OF T BY NEWTON'S METHOD.
C...
C...     2*A*(-H**0.5/CV - (Q0/CV**2)*LN(Q0 - CV*H**0.5))
C...
C...   - 2*A*(-H0**0.5/CV - (Q0/CV**2)*LN(Q0 - CV*H0**0.5)) = T     (5)
C...
      COMMON/IO/ NI, NO
C...
C...  SET THE INITIAL (TRIAL) VALUE OF H, MAXIMUM NUMBER OF ITERATIONS,
C...  ERROR TOLERANCE FOR THE NEWTON ITERATION
      HOLD=H0+200.
      IMAX=100
      EPS=0.001
C...
C...  INITIALIZE THE ITERATION COUNTER
      ITER=1
C...
C...  COMPUTE THE CONSTANT TERM IN EQUATION (5)
      SRH0=SQRT(H0)
      C1=-2.0*A*(-SRH0/CV-(Q0/CV**2)*ALOG(Q0-CV*SRH0))
C...
C...  PERFORM A NEWTON ITERATION
1     SRHOLD=SQRT(HOLD)
      FH=2.0*A*(-SRHOLD/CV-(Q0/CV**2)*ALOG(Q0-CV*SRHOLD))+C1-T
      DFHDH=2.0*A*(-0.5/(CV*SRHOLD)-(Q0/CV**2)*(1./(Q0-CV*SRHOLD))*
     1     (-0.5*CV/SRHOLD))
      HNEW=HOLD-FH/DFHDH
C...
C...  CHECK FOR CONVERGENCE
      IF(ABS(HNEW-HOLD).LT.EPS)THEN
C...
C...  CONVERGENCE HAS BEEN ACHIEVED
      ANAL=HNEW
      RETURN
C...
C...  CONVERGENCE HAS NOT BEEN ACHIEVED SO PERFORM ANOTHER ITERATION
C...  IF THE MAXIMUM NUMBER OF ITERATIONS HAS NOT BEEN EXCEEDED
      ELSE
      ITER=ITER+1
      IF(ITER.GT.IMAX)THEN
C...
C...     PRINT AN ERROR MESSAGE INDICATING LACK OF CONVERGENCE
         WRITE(NO,2)ITER
2        FORMAT(' CONVERGENCE WAS NOT ACHIEVED AFTER',I3,' ITERATIONS')
         STOP
      ELSE
C...
C...     GO ON TO THE NEXT ITERATION
         HOLD=HNEW
         GO TO 1
      END IF
      END IF
      END
ANALYTICAL AND NUMERICAL SOLUTIONS
0.        100.      2.
    1 1000    1    1  REL 0.001
END OF RUNS
*APP MATH26
      SUBROUTINE INITAL
C...
C...  EFFECT OF ODE STIFFNESS ON EXPLICIT INTEGRATOR PERFORMANCE
C...
C...  CONSIDER THE FOLLOWING SYSTEM OF TWO LINEAR, CONSTANT COEFFICIENT
C...  ODES:
C...
C...      DY1/DT + A*Y1 = 1                                     (1)
C...
C...      DY2/DT + B*Y2 = Y1                                    (2)
C...
C...  WHICH ARE TO BE INTEGRATED SUBJECT TO THE INITIAL CONDITIONS
C...
C...      Y1(0) = Y2(0) = 0                                  (3)(4)
C...
C...  (1.1)  DERIVE THE ANALYTICAL SOLUTION TO EQUATIONS (1) TO (4).
C...
C...  (1.2)  COMPUTE A NUMERICAL SOLUTION TO EQUATIONS (1) TO (4),
C...         AND COMPARE IT WITH THE ANALYTICAL SOLUTION OF (1.1).
C...         MAKE THIS COMPARISON FOR THE TWO CASES
C...
C...         A = 1, B = 10 (NONSTIFF - EIGENVALUES A AND B ARE NOT
C...                                   WIDELY SEPARATED)
C...
C...         A = 1, B =1000 (MODERATELY STIFF)
C...
C...         IN EACH CASE, PRINT THE TOTAL NUMBER OF CALLS TO SUBROUTINE
C...         DERV AS THE NUMERICAL SOLUTION IS COMPUTED.  BECAUSE THE
C...         SECOND CASE IS STIFFER THAN THE FIRST, THE EXPLICIT IN-
C...         TEGRATOR (SPECIFIED IN THE THIRD DATA LINE OF EACH RUN)
C...         SHOULD REQUIRE GREATER COMPUTATIONAL EFFORT IN COMPUTING
C...         THE SOLUTION FOR THE SECOND CASE.  THIS WILL BE EVIDENT
C...         FROM THE NUMBER OF CALLS TO SUBROUTINE DERV.
C...
C...  EQUATION (1) CAN BE INTEGRATED BY ITSELF.  THE SOLUTION WILL
C...  BE THE SUM OF A HOMOGENEOUS SOLUTION AND A PARTICULAR SOLUTION,
C...  I.E.,
C...
C...      Y1 = Y1H + Y1P
C...
C...  WHERE
C...
C...      YH = C*EXP(-A*T), YP = C1
C...
C...  SUBSTITUTION IN EQUATION (1) GIVES
C...
C...      DY1/DT = C*(-A)*EXP(-A*T)
C...
C...      + A*Y1 = A*(C*EXP(-A*T) + C1)
C...
C...        - 1  = - 1
C...      ------   --------------------
C...         0               0
C...
C...  FROM WHICH WE OBTAIN C1 = 1/A.  THE SOLUTION THEN IS
C...
C...      Y1 = C*EXP(-A*T) + 1/A
C...
C...  FROM INITIAL CONDITION (3), C = -1/A, AND THE SOLUTION TO EQUA-
C...  TIONS (1) AND (3) IS
C...
C...      Y1 = (1/A)*(1 - EXP(-A*T))                            (5)
C...
C...  EQUATION (5) CAN THEN BE SUBSTITUTED IN EQUATION (2)
C...
C...      DY2/DT + B*Y2 = (1/A)*(1 - EXP(-A*T))                 (6)
C...
C...  AGAIN, THE SOLUTION TO EQUATION (6) WILL BE THE SUM OF A HOMO-
C...  GENEOUS SOLUTION AND A PARTICULAR SOLUTION
C...
C...      Y2 = C*EXP(-B*T) + C1+ C2*EXP(-A*T)                   (7)
C...
C...  WHICH, WHEN SUBSTITUTED IN EQUATION (2) GIVES
C...
C...      DY2/DT = C*(-B)*EXP(-B*T) + C2*(-A)*EXP(-A*T)
C...
C...      B*Y2   = B*(C*EXP(-B*T) + C1 + C2*EXP(-A*T))
C...
C...      -(1/A)*(1 - EXP(-A*T)) = -(1/A)*(1 - EXP(-A*T))
C...
C...      = 0                              = 0
C...
C...  SO THAT
C...
C...      C1 = 1/(A*B), -A*C2 + B*C2 + (1/A) = 0 OR C2 = 1/(A*(A - B))
C...
C...  THEN, FROM INITIAL CONDITION (4),
C...
C...      0 = C + C1 + C2 OR C = -(C1 + C2) = -1/(A*B) - 1/(A*(A - B))
C...
C...                            = 1/(B*(B - A))
C...
C...  THESE VALUES OF C, C1 AND C2 WHEN USED IN EQUATION (7) GIVE Y2(T)
C...
C...      Y2(T) = 1/(A*B) + 1/(B*(B - A))*EXP(-B*T)
C...                                                            (8)
C...                      + 1/(A*(A - B))*EXP(-A*T)
C...
C...  ALSO, DY2(0)/DT CAN NOW BE COMPUTED AS
C...
C...      DY2(0)/DT = C*(-B) + C2*(-A) =
C...
C...                = 1/(B*(B - A))*(-B) + 1/(A*(A - B))*(-A) = 0
C...
C...  THIS PROPERTY OF A ZERO FIRST DERIVATIVE AT T = 0 FOR SYSTEMS
C...  OF FIRST-ORDER ODES WHICH START AT A ZERO INITIAL CONDITION IS
C...  A SIGNIFICANT FACTOR IN DETERMINING THE SHAPE OF THE SOLUTION
C...  CURVES FOR THE ODES, I.E., FOR THE SECOND ODE (AND ADDITIONAL
C...  ODES BEYOND THE SECOND IF THEY ARE PART OF THE PROBLEM), THE
C...  SOLUTION STARTS WITH A ZERO SLOPE.
C...
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/        Y1,        Y2
     2      /F/     DY1DT,     DY2DT
     3      /C/         A,         B,     NDERV,        IP
C...
C...  SET THE PROBLEM PARAMETERS
      IF(NORUN.EQ.1)THEN
         A=1.
         B=10.
      ELSE IF(NORUN.EQ.2)THEN
         A=1.
         B=1000.
      END IF
C...
C...  INITIAL CONDITIONS (3) AND (4)
      Y1=0.
      Y2=0.
C...
C...  INITIAL DERIVATIVES
      CALL DERV
      IP=0
C...
C...  INITIALIZE THE COUNTER FOR THE CALLS TO SUBROUTINE DERV
      NDERV=0
      RETURN
      END
      SUBROUTINE DERV
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/        Y1,        Y2
     2      /F/     DY1DT,     DY2DT
     3      /C/         A,         B,     NDERV,        IP
C...
C...  EQUATION (1)
      DY1DT=-A*Y1+1.0
C...
C...  EQUATION (2)
      DY2DT=-B*Y2+Y1
C...
C...  INCREMENT THE COUNTER FOR THE CALLS TO DERV
      NDERV=NDERV+1
      RETURN
      END
      SUBROUTINE PRINT(NI,NO)
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/        Y1,        Y2
     2      /F/     DY1DT,     DY2DT
     3      /C/         A,         B,     NDERV,        IP
C...
C...  PRINT A HEADING FOR THE SOLUTION
      IP=IP+1
      IF(IP.EQ.1)THEN
         WRITE(NO,1)
1        FORMAT(9X,'T',4X,'Y1 (NUM)',3X,'Y1 (ANAL)',
     1                 4X,'Y2 (NUM)',3X,'Y2 (ANAL)',
     2                 5X,'NDERV')
      END IF
C...
C...  COMPUTE THE ANALYTICAL SOLUTIONS
C...
C...  THE FOLLOWING CODING AVOIDS AN UNDERFLOW OF THE EXPONENTIAL
C...  FUNCTIONS IN THE ANALYTICAL SOLUTIONS
      IF((-A*T).LT.(-100.0))THEN
         EXPA=0.
      ELSE
         EXPA=EXP(-A*T)
      END IF
      IF((-B*T).LT.(-100.0))THEN
         EXPB=0.
      ELSE
         EXPB=EXP(-B*T)
      END IF
      Y1A=1.0/A*(1.0-EXPA)
      Y2A=1.0/(A*B)+1.0/(B*(B-A))*EXPB+1.0/(A*(A-B))*EXPA
C...
C...  PRINT THE ANALYTICAL AND NUMERICAL SOLUTIONS
      WRITE(NO,2)T,Y1,Y1A,Y2,Y2A,NDERV
2     FORMAT(F10.1,4E12.4,I10)
      RETURN
      END
EFFECT OF ODE STIFFNESS ON EXPLICIT INTEGRATOR PERFORMANCE
0.        10.       1.
    210000    1    1  REL 0.0001
EFFECT OF ODE STIFFNESS ON EXPLICIT INTEGRATOR PERFORMANCE
0.        10.       1.
    210000    1    1  REL 0.0001
END OF RUNS
*APP MATH27
      SUBROUTINE INITAL
C...
C...  LINEAR STABILITY ANALYSIS OF A NONLINEAR SECOND-ORDER ORDINARY
C...  DIFFERENTIAL EQUATION
C...
C...  CONSIDER THE FOLLOWING NONLINEAR ORDINARY DIFFERENTIAL EQUATION
C...  (ODE)
C...
C...      2    2
C...     D Y/DT  + EXP(A*Y) + Y = 2, Y(0) = DY(0)/DT = 0
C...
C...  INTUITIVELY IT SEEMS THAT THE SOLUTION TO THE PROBLEM COULD BE
C...  UNSTABLE (Y(T) COULD BECOME UNBOUNDED).  FOR EXAMPLE, IF A GT 0
C...  AND Y GT 0 SO THAT THE PRODUCT A*Y IS POSITIVE, THE TERM EXP(A*Y)
C...  WILL INCREASE AS Y INCREASES, POSSIBLY LEADING TO AN UNSTABLE
C...  SOLUTION.
C...
C...  ALSO, IF A LT 0 AND Y LT 0, EXP(A*T) WILL AGAIN INCREASE IF
C...  Y DECREASES (BECOMES MORE NEGATIVE), BUT WILL DECREASE IF Y
C...  INCREASES (BECOMES MORE POSITIVE).  THUS THE SITUATION WITH
C...  REGARD TO STABILITY IS RATHER COMPLICATED, AND DEPENDS ON THE
C...  VALUES OF A AND Y.  THIS STABILITY IS INVESTIGATED IN THE
C...  FOLLOWING LINEAR ANALYSIS.
C...
C...  IF THE ODE IS LINEARIZED AROUND THE POINT YS,
C...
C...      2    2
C...     D Y/DT  + EXP(A*YS) + A*EXP(A*YS)*(Y - YS) + Y = 2
C...
C...  SUBTRACTION OF THE STEADY STATE EQUATION
C...
C...     EXP(A*YS) + YS = 2
C...
C...  GIVES
C...
C...      2    2
C...     D Y/DT  + A*EXP(A*YS)*(Y - YS) + (Y - YS) = 0
C...
C...  IF A PERTURBATION VARIABLE YP IS NOW DEFINED AS YP = Y - YS,
C...  THE LINEARIZED ODE CAN BE WRITTEN IN TERMS OF YP
C...
C...      2     2
C...     D YP/DT  + A*EXP(A*YS)*YP + YP = 0
C...
C...  WITH THE INITIAL CONDITIONS
C...
C...     YP(0) = -YS, DYP(0)/DT = 0
C...
C...  NOTE THAT THE LINEARIZED PROBLEM DEPENDS ON A AS EXPECTED, AND
C...  ON YS, I.E., THE SOLUTION TO A NONLINEAR PROBLEM, OR A LINEAR
C...  APPROXIMATION, DEPENDS ON THE ABSOLUTE VALUE OF THE DEPENDENT
C...  VARIABLE(S).
C...
C...  IF THIS LINEAR PROBLEM IS SOLVED BY THE LAPLACE TRANSFORM
C...
C...            --                            --
C...     (S**2)*YP + S*YS + (A*EXP(A*YS) + 1)*YP = 0
C...
C...  FROM WHICH THE TRANSFORMED VARIABLE IS
C...
C...     --
C...     YP = -S*YS/(S**2 + A*EXP(A*YS) + 1)
C...
C...  INVERSION GIVES
C...
C...     YP(T) = -YS*COS(W*T), W = (A*EXP(A*YS) + 1)**0.5
C...
C...  THIS RESULT AGAIN INDICATES THAT THE SOLUTION DEPENDS ON A AND
C...  YS.
C...
C...  CONSIDER NOW THE SPECIAL CASE YS = 0, FOR WHICH YP(T) = 0 AND
C...  IN PARTICULAR, YP(0) = 0.  THUS, THE INITIAL CONDITION FOR THE
C...  PERTURBATION EQUATION IS HOMOGENEOUS (ZERO) WHICH IS THE USUAL
C...  PROCEDURE IN DEVELOPING PERTURBATION EQUATIONS, I.E., THE INITIAL
C...  CONDITIONS ARE TAKEN AS HOMOGENEOUS TO SIMPLIFY THE ANALYSIS OF
C...  THE LINEARIZED EQUATION (NOTE ALSO THAT Y(T) = 0 IS A SOLUTION
C...  TO THE NONLINEAR ODE IF THE RIGHT HAND SIDE IS 1, SO THAT IN
C...  ORDER TO AVOID THIS TRIVIAL SOLUTION, THE RIGHT HAND SIDE WAS
C...  TAKEN AS 2).  THE EIGENVALUES OF THE LINEARIZED SYSTEM ARE THE
C...  ROOTS OF THE CHARACTERISTIC EQUATION
C...
C...     S**2 + (A + 1) = 0
C...
C...  OR S1 = (-(A + 1))**0.5 = I*(A + 1)**0.5 AND S2 = -S1. SEVERAL
C...  SPECIAL CASES CAN BE CONSIDERED
C...
C...     A   S1,S2            CHARACTERISTICS OF EIGENVALUES
C...
C...     0   +I,-I     PURE IMAGINARY (I = (-1)**0.5) SO THAT THE
C...                   SOLUTION IS A STABLE OSCILLATION
C...
C...    -1    0,0      ZERO SO THAT THE SOLUTION IS STABLE AND CONSTANT
C...
C...    -2   +1,-1     ONE POSITIVE EIGENVALUE SO THE SYSTEM IS UNSTABLE
C...
C...  IF A GT 0, THE EIGENVALUES ARE PURE IMAGINARY, SO THE SOLUTION IS
C...  A STABLE OSCILLATION, WHILE IF A LT -1, ONE EIGENVALUE IS REAL AND
C...  POSITIVE SO THE SOLUTION IS UNSTABLE.
C...
C...  THESE CONCLUSIONS ARE NOW COMPARED WITH THE NUMERICAL SOLUTION TO
C...  THE NONLINEAR PROBLEM TO SEE HOW WELL THE LINEAR STABILITY ANA-
C...  LYSIS APPLIES TO THE NONLINEAR SYSTEM.  ALSO, SOME ADDITIONAL
C...  COMMENTS CONCERNING STABILITY APPEAR IN SUBROUTINE PRINT.
C...
C...  DSS/2 COMMON AREA
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/        Y1,        Y2
     2      /F/     DY1DT,     DY2DT
     3      /C/         A,        YS,        IP
C...
C...  SET THE VALUES OF A, YS
      IF(NORUN.EQ.1)A=1.
      IF(NORUN.EQ.2)A=0.
      IF(NORUN.EQ.3)A=-1.
      IF(NORUN.EQ.4)A=-2.
      YS=0.
C...
C...  INITIAL CONDITIONS
      Y1=0.
      Y2=0.
C...
C...  INITIAL DERIVATIVES
      CALL DERV
      IP=0
      RETURN
      END
      SUBROUTINE DERV
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/        Y1,        Y2
     2      /F/     DY1DT,     DY2DT
     3      /C/         A,        YS,        IP
C...
C...  ODES
      DY1DT=Y2
      DY2DT=2.0-(EXP(A*Y1)+Y1)
      RETURN
      END
      SUBROUTINE PRINT(NI,NO)
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/        Y1,        Y2
     2      /F/     DY1DT,     DY2DT
     3      /C/         A,        YS,        IP
C...
C...  DIMENSION THE ARRAYS FOR THE PLOTTING
      DIMENSION TP(101), YP(101), YP4(4,101), YTP(101)
C...
C...  PRINT A HEADING FOR THE SOLUTION
      IF(IP.EQ.0)WRITE(NO,1)
1     FORMAT(9X,'T',10X,'Y1',10X,'Y2',6X,'DY1/DT',6X,'DY2/DT')
C...
C...  PRINT THE SOLUTION
      IP=IP+1
      IF(((IP-1)/10*10).EQ.(IP-1))THEN
         WRITE(NO,2)T,Y1,Y2,DY1DT,DY2DT
2        FORMAT(F10.2,4F12.3)
      END IF
C...
C...  STORE THE SOLUTION FOR PLOTTING
      TP(IP)=T
      YP(IP)=Y1
      YP4(NORUN,IP)=Y1
      YTP(IP)=Y2
C...
C...  PLOT Y(T) VS T AT THE END OF EACH RUN
      IF(IP.LT.101)RETURN
      CALL SPLOTS(1,IP,TP,YP)
      WRITE(NO,3)A
3     FORMAT(1H ,/,' Y(T) VS T FOR A = ',F5.1)
C...
C...  *****************************************************************
C...
C...  THE FOLLOWING CALLS TO A CONTINUOUS PLOTTER ARE MACHINE DEPENDENT
C...  AND MUST BE CONVERTED FOR OTHER COMPUTERS OR CHANGED TO COMMENTS
C...
C...  CALL QIKSAX(3,3)
C...  CALL QIKPLT(TP,YP,IP,3H*T*,6H*Y(T)*,
C... 1   23H*NONLINEAR OSCILLATION*,1)
C...
C...  *****************************************************************
C...
C...  PROFESSOR S. H. JOHNSON, DEPARTMENT OF MECHANICAL ENGINEERING AND
C...  MECHANICS, LEHIGH UNIVERSITY, INDICATED THAT FROM A THEOREM BY
C...  LYAPUNOV, IF A LINEARIZED SYSTEM HAS AN UNSTABLE EIGENVALUE (AN
C...  EIGENVALUE IN THE RIGHT HALF COMPLEX PLANE), THE NONLINEAR SYSTEM
C...  WILL BE EITHER UNSTABLE (THE SOLUTION WILL BE UNBOUNDED) OR THE
C...  THE NONLINEAR SYSTEM WILL MOVE TO A STABLE LIMIT CYCLE.  TO IN-
C...  VESTIGATE THESE POSSIBILITITES, THE PHASE PLANE FOR THE NONLINEAR
C...  ODE IS ALSO PLOTTED
      CALL SPLOTS(1,IP,YP,YTP)
      WRITE(NO,5)A
5     FORMAT(1H ,/,' PHASE PLANE PLOT, DY(T)/DT VS Y, A = ',F5.1)
C...
C...  *****************************************************************
C...
C...  THE FOLLOWING CALLS TO A CONTINUOUS PLOTTER ARE MACHINE DEPENDENT
C...  AND MUST BE CONVERTED FOR OTHER COMPUTERS OR CHANGED TO COMMENTS
C...
C...  CALL QIKSAX(3,3)
C...  CALL QIKPLT(YP,YTP,IP,6H*Y(T)*,10H*DY(T)/DT*,
C... 1   13H*LIMIT CYCLE*,1)
C...
C...  *****************************************************************
C...
C...  AT THE END OF THE FOURTH RUN, PLOT THE SOLUTIONS TOGETHER
      IF(NORUN.LT.4)RETURN
      CALL SPLOTS(NORUN,IP,TP,YP4)
      WRITE(NO,4)
4     FORMAT(1H ,/,' Y(T) VS T, A = 1, 0, -1, -2')
C...
C...  *****************************************************************
C...
C...  THE FOLLOWING CALLS TO A CONTINUOUS PLOTTER ARE MACHINE DEPENDENT
C...  AND MUST BE CONVERTED FOR OTHER COMPUTERS OR CHANGED TO COMMENTS
C...
C...  CALL QIKSAX(3,3)
C...  CALL QIKPLT(TP,YP4,IP,3H*T*,6H*Y(T)*,
C... 1   23H*NONLINEAR OSCILLATION*,NORUN)
C...
C...  *****************************************************************
C...
      RETURN
      END
LINEAR STABILITY ANALYSIS OF A NONLINEAR SECOND-ORDER ODE, A = 1
0.        20.0      0.2
    2 1000    1    1  REL 0.001
LINEAR STABILITY ANALYSIS OF A NONLINEAR SECOND-ORDER ODE, A = 0
0.        20.0      0.2
    2 1000    1    1  REL 0.001
LINEAR STABILITY ANALYSIS OF A NONLINEAR SECOND-ORDER ODE, A = -1
0.        20.0      0.2
    2 1000    1    1  REL 0.001
LINEAR STABILITY ANALYSIS OF A NONLINEAR SECOND-ORDER ODE, A = -2
0.        20.0      0.2
    2 1000    1    1  REL 0.001
END OF RUNS
*APP MATH28
      PROGRAM DASSLT
C...
C...  DSS/2 PDE APPLICATION EXECUTED UNDER DASSL WITH SPECIFICATION
C...  OF THE ODE JACOBIAN MATRIX BANDWIDTH
C...
C...  THE FOLLOWING CODING ILLUSTRATES THE EXECUTION OF A DSS/2 APPLI-
C...  CATION UNDER DASSL.  THE APPLICATION IS DESCRIBED IN SUBROUTINE
C...  INITAL.
C...
C...  THE SYSTEM OF ODES PROGRAMMED IN SUBROUTINE DERV IS INTEGRATED
C...  BY DASSL (A SOLVER FOR ALGEBRAIC/ODE SYSTEMS DEVELOPED BY LINDA
C...  R. PETZOLD, LAWRENCE LIVERMORE NATIONAL LABORATORY).
C...
C...  THE MODEL INITIAL CONDITIONS ARE SET IN SUBROUTINE INITAL, AND
C...  THE MODEL DERIVATIVES ARE PROGRAMMED IN SUBROUTINE DERV.  THE
C...  NUMERICAL SOLUTION IS PRINTED AND PLOTTED IN SUBROUTINE PRINT.
C...
C...  SUBROUTINES INITAL, DERV AND PRINT.  THE FOLLOWING CODING IS FOR
C...  250 ORDINARY DIFFERENTIAL EQUATIONS (ODES).  IF MORE ODES ARE TO
C...  BE INTEGRATED, ALL OF THE 250*S SHOULD BE CHANGED TO THE REQUIRED
C...  NUMBER
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/    Y(250)
     2      /F/    F(250)
C...
C...  THE NUMBER OF DIFFERENTIAL EQUATIONS IS AVAILABLE THROUGH COMMON
C...  /N/ FOR USE IN SUBROUTINE RES
      COMMON/N/      NEQN
C...
C...  COMMON AREA TO PROVIDE THE INPUT/OUTPUT UNIT NUMBERS TO OTHER
C...  SUBROUTINES
      COMMON/IO/       NI,        NO
C...
C...  ABSOLUTE DIMENSIONING OF THE ARRAYS REQUIRED BY DASSL.  ARRAY
C...  WORK IS SIZED BY THE FOLLOWING FORMULA FOR BANDED PROCESSING
C...  OF THE ODE JACOBIAN MATRIX VIA FINITE DIFFERENCES: 40+(MAXORD
C...  +4)*NEQN+(2*ML+MU+1)*NEQN+2*(NEQN/(ML+MU+1)+1).  FOR MAXORD = 5,
C...  NEQN = 250, ML = MU = 3, 40+(5+4)*250+(2*3+3+1)*250+2*(250/(3+3
C...  +1)+1) = 5000 (APPROXIMATELY).  IF FEWER THAN 250 EQUATIONS ARE
C...  TO BE SOLVED, THEN ML AND MU CAN BE LARGER FOR THE GIVEN SIZE OF
C...  WORK.  IF NEQN GT 250 AND/OR ML AND MU GT 3, WORK MUST BE DIMEN-
C...  SIONED TO A LARGER SIZE.
C...
C...  THIS SIZING OF ARRAY WORK IS SUGGESTED BY THE USE OF FIVE-POINT
C...  APPROXIMATIONS FOR THE FIRST AND SECOND-ORDER SPATIAL DERIVATIVES
C...  IN EQUATION (1), E.G., U  AND U  .  THUS, WITH JUST ONE PDE, THE
C...                          X      XX
C...  BANDWIDTH OF THE JACOBIAN MATRIX IS FIVE AND ML = MU = 3 SHOULD
C...  BE APPROPRIATE TO ENCOMPASS ALL OF THE ODE JACOBIAN MATRIX.  IF
C...  QUESTIONS REMAIN ABOUT THE CHOICE OF ML AND MU, AND THEREFRE THE
C...  SIZE OF WORK, THE ODE JACOBIAN MATRIX CAN BE MAPPED USING SUB-
C...  ROUTINE EIGEN, AND THE ODE BANDIWDTH CAN BE OBSERVED DIRECTLY
C...  FROM THE MAP
      DIMENSION YV(250), YPRIME(250), DELTA(250),
     1      RWORK(5000),  IWORK(270),   INFO(15)
C...
C...  EXTERNAL THE DERIVATIVE AND ODE JACOBIAN MATRIX ROUTINES CALLED BY
C...  DASSL
      EXTERNAL RES, JAC
C...
C...  ARRAY FOR THE TITLE (FIRST LINE OF DATA), CHARACTERS  END OF RUNS
      CHARACTER TITLE(20)*4, ENDRUN(3)*4
C...
C...  VARIABLE FOR THE TYPE OF ERROR CRITERION
      CHARACTER*3 ABSREL
C...
C...  DEFINE THE CHARACTERS  END OF RUNS
      DATA ENDRUN/'END ','OF RU','NS  '/
C...
C...  DEFINE THE INPUT/OUTPUT UNIT NUMBERS
      NI=5
      NO=6
C...
C...  OPEN INPUT AND OUTPUT FILES
      OPEN(NI,FILE='INPUT')
      OPEN(NO,FILE='OUTPUT')
C...
C...  INITIALIZE THE RUN COUNTER
      NORUN=0
C...
C...  BEGIN A RUN
1     NORUN=NORUN+1
C...
C...  INITIALIZE THE RUN TERMINATION VARIABLE
      NSTOP=0
C...
C...  READ THE FIRST LINE OF DATA
      READ(NI,1000,END=999)(TITLE(I),I=1,20)
C...
C...  TEST FOR  END OF RUNS  IN THE DATA
      DO 2 I=1,3
      IF(TITLE(I).NE.ENDRUN(I))GO TO 3
2     CONTINUE
C...
C...  AND END OF RUNS HAS BEEN READ, SO TERMINATE EXECUTION
999   STOP
C...
C...  READ THE SECOND LINE OF DATA
3     READ(NI,1001,END=999)T0,TF,TP
C...
C...  READ THE THIRD LINE OF DATA
      READ(NI,1002,END=999)NEQN
C...
C...  PRINT A DATA SUMMARY
      WRITE(NO,1003)NORUN,(TITLE(I),I=1,20),
     1                     T0,TF,TP,
     2                     NEQN
C...
C...  INITIALIZE TIME
      T=T0
C...
C...  SET THE INITIAL CONDITIONS
      CALL INITAL
C...
C...  PRINT THE INITIAL CONDITIONS
      CALL PRINT(NI,NO)
C...
C...  SET THE INITIAL CONDITIONS FOR SUBROUTINE DASSL
      CALL DERV
      DO 5 I=1,NEQN
      YV(I)=Y(I)
      YPRIME(I)=F(I)
5     CONTINUE
C...
C...  SET THE PARAMETERS FOR SUBROUTINE DASSL
      TV=T0
      RTOL=1.0E-07
      ATOL=1.0E-07
      LRW=5000
      LIW=270
      DO 7 I=1,15
      INFO(I)=0
7     CONTINUE
C...
C...  SPECIFY THAT THE DASSL BANDED ODE JACOBIAN MATRIX OPTION IS TO
C...  BE USED
      ML=3
      MU=3
      IWORK(1)=ML
      IWORK(2)=MU
      INFO(6)=1
C...
C...  CALL SUBROUTINE DASSL TO COVER ONE PRINT INTERVAL
4     TOUT=TV+TP
      CALL SDASSL(RES,NEQN,TV,YV,YPRIME,TOUT,INFO,RTOL,ATOL,IDID,
     1           RWORK,LRW,IWORK,LIW,RPAR,IPAR,JAC)
C...
C...  PRINT THE SOLUTION
      T=TV
      DO 6 I=1,NEQN
      Y(I)=YV(I)
6     CONTINUE
      CALL PRINT(NI,NO)
C...
C...  TEST FOR AN ERROR CONDITION
      IF(IDID.LT.0)THEN
C...
C...     PRINT A MESSAGE INDICATING AN ERROR CONDITION
         WRITE(NO,1004)IDID
C...
C...     GO ON TO THE NEXT RUN
         GO TO 1
      END IF
C...
C...  CHECK FOR A RUN TERMINATION
      IF(NSTOP.NE.0)GO TO 1
C...
C...  CHECK FOR THE END OF THE RUN
      IF(TV.LT.(TF-0.5*TP))GO TO 4
C...
C...  THE CURRENT RUN IS COMPLETE, SO PRINT THE COMPUTATIONAL STAT-
C...  ISTICS FOR DASSL AND GO ON TO THE NEXT RUN
      WRITE(NO,8)RWORK(7),IWORK(8),IWORK(11),IWORK(12),IWORK(13)
8     FORMAT(1H ,//,' COMPUTATIONAL STATISTICS'                    ,//,
     1 ' LAST STEP SIZE                       ',              E10.3,//,
     2 ' LAST ORDER OF THE METHOD             ',                I10,//,
     3 ' TOTAL NUMBER OF STEPS TAKEN          ',                I10,//,
     4 ' NUMBER OF FUNCTION EVALUATIONS       ',                I10,//,
     5 ' NUMBER OF JACOBIAN EVALUATIONS       ',                I10,/)
      GO TO 1
C...
C...  *****************************************************************
C...
C...  FORMATS
C...
1000  FORMAT(20A4)
1001  FORMAT(3E10.0)
1002  FORMAT(I5)
1003  FORMAT(1H1,
     1 ' RUN NO. - ',I3,2X,20A4,//,
     2 ' INITIAL T - ',E10.3,//,
     3 '   FINAL T - ',E10.3,//,
     4 '   PRINT T - ',E10.3,//,
     5 ' NUMBER OF DIFFERENTIAL EQUATIONS - ',I3,//,
     6 1H1)
1004  FORMAT(1H ,//,' IDID = ',I3,//,
     1 ' INDICATING AN INTEGRATION ERROR, SO THE CURRENT RUN'     ,/,
     2 ' IS TERMINATED.  PLEASE REFER TO THE DOCUMENTATION FOR'   ,/,
     3 ' SUBROUTINE',//,25X,'DASSL',//,
     4 ' FOR AN EXPLANATION OF THESE ERROR INDICATORS'            )
      END
      SUBROUTINE RES(TV,YV,YPRIME,DELTA,IRES,RPAR,IPAR)
C...
C...  SUBROUTINE RES IS AN INTERFACE ROUTINE BETWEEN SUBROUTINES DASSL
C...  AND DERV
C...
C...  COMMON AREA TO INTERFACE WITH SUBROUTINE DERV
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/      Y(1)
     2      /F/      F(1)
C...
C...  THE NUMBER OF DIFFERENTIAL EQUATIONS IS AVAILABLE THROUGH COMMON
C...  /N/
      COMMON/N/      NEQN
C...
C...  ABSOLUTE DIMENSION THE DEPENDENT, DERIVATIVE AND RESIDUAL ARRAYS
      DIMENSION YV(250), YPRIME(250), DELTA(250)
C...
C...  TRANSFER THE INDEPENDENT VARIABLE, DEPENDENT VARIABLE VECTOR
C...  FOR USE IN SUBROUTINE DERV
      T=TV
      DO 1 I=1,NEQN
      Y(I)=YV(I)
1     CONTINUE
C...
C...  EVALUATE THE DERIVATIVE VECTOR
      CALL DERV
C...
C...  TRANSFER THE DERIVATIVE VECTOR FOR USE BY SUBROUTINE DASSL
      DO 2 I=1,NEQN
      DELTA(I)=YPRIME(I)-F(I)
2     CONTINUE
      RETURN
      END
      SUBROUTINE INITAL
C...
C...  ONE-DIMENSIONAL, NONLINEAR, PARABOLIC PDE BY SECOND AND FOURTH-
C...  ORDER FORMULAS FOR SECOND-ORDER SPATIAL DERIVATIVES
C...
C...  CONSIDER THE FOLLOWING NONLINEAR PARABOLIC PARTIAL DIFFERENTIAL
C...  EQUATION (PDE) (1)
C...
C...     U*U  = (1/X**2)*((X**2)*U*U )  + 5*(U**2) + 4*X*U*U    (1)
C...        T                       X X                     X
C...
C...     U(X,0) = EXP(1 - X**2)                                 (2)
C...
C...     U (0,T) = 0, U(1,T) = EXP(-T)                       (3)(4)
C...      X
C...
C...  THE ANALYTIC SOLUTION TO EQUATIONS (1) TO (4) IS
C...
C...     U(X,T) = EXP(1 - X**2 - T)                             (5)
C...
C...  (1)  THIS PROBLEM WAS PROVIDED BY ROBERT D. SKEEL, DEPARTMENT OF
C...       COMPUTER SCIENCE, UNIVERSITY OF ILLINOIS, AND MARTIN BERZINS,
C...       DEPARTMENT OF COMPUTER STUDIES, UNIVERSITY OF LEEDS
C...
C...  IN THE FOLLOWING CODING, EQUATIONS (1) TO (4) ARE SOLVED BY THE
C...  NUMERICAL METHOD OF LINES USING THE SECOND-DERIVATIVE FORMULAS
C...  REPORTED BY SCHIESSER AND STENGLE (2).  THE T INTEGRATION IS
C...  PERFORMED BY DASSL (3).  BOTH SECOND AND FOURTH-ORDER FORMULAS
C...  ARE USED SO THAT THE EFFECT OF THE ORDER OF THE APPROXIMATION IN
C...  COMPUTING SECOND-ORDER DERIVATIVES CAN BE OBSERVED.
C...
C...     (2)  SCHIESSER, W. E., AND G. A. STENGLE, SECOND DERIVATIVE
C...          FORMULAS FOR USE IN THE NUMERICAL METHOD OF LINES,
C...          PROCEEDINGS OF THE IMACS SIXTH INTERNATIONAL SYMPOSIUM
C...          ON COMPUTER METHODS FOR PARTIAL DIFFERENTIAL EQUATIONS,
C...          LEHIGH UNIVERSITY, BETHLEHEM, PA, JUNE 23-26, 1987.
C...
C...     (3)  DASSL IS A TRANSPORTABLE FORTRAN CODE FOR THE NUMERICAL
C...          SOLUTION OF DIFFERENTIAL-ALGEBRAIC SYSTEMS DEVELOPED BY
C...          LINDA R. PETZOLD OF THE LAWRENCE LIVERMORE LABORATORY
C...
C...  BEFORE PROCEEDING WITH THE CODING FOR EQUATIONS (1) TO (4), A
C...  DETAIL SHOULD BE CONSIDERED.  THE FIRST TERM ON THE RIGHT HAND
C...  SIDE OF EQUUATON (1) CAN BE EXPANDED BY THE CHAIN RULE FOR
C...  DIFFERENTIATION OF A PRODUCT
C...
C...     (1/X**2)*((X**2)*U*U )  = U*U   + (U )**2 + (2/X)*U*U
C...                         X X      XX     X                X
C...
C...  ADDITIONALLY, THE SECOND TERM IS INDETERMINATE FOR X = 0 AS A
C...  CONSEQUENCE OF BOUNDARY CONDITION (3), I.E.,
C...
C...       LIM   (2/X)*U*U  = 2*(U*U   + (U )**2)               (6)
C...      X--+0           X         XX     X
C...
C...  THIS RESULT FOR X = 0 IS USED IN THE SUBSEQUENT METHOD OF LINES
C...  CODING.
C...
C...  THE CODING FOR THE SECOND-ORDER FORMULAS IS CONTAINED IN SUBROU-
C...  TINES INTAL1, DERV1 AND PRINT1 WHICH ARE CALLED BY SETTING NORD=2
C...  IN THE FOLLOWING CODE.  THE CODING FOR THE FOURTH-ORDER FORMULAS
C...  IS IN SUBROUTINES INTAL2, DERV2 AND PRINT2 WHICH ARE CALLED BY
C...  SETTING NORD=4.
C...
C...  COMMON AREA FOR INTERFACE WITH SUBROUTINES INITAL, DERV AND
C...  PRINT
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/    U(161)
     2      /F/   UT(161)
     3      /S/   UX(161),  UXX(161)
     4      /C/    X(161),         N,      NORD
C...
C...  SELECT THE ORDER OF THE SECOND-DERIVATIVE FORMULAS
      NORD=2
C...  NORD=4
C...
C...  INITIAL CONDITION
      IF(NORD.EQ.2)CALL INTAL1
      IF(NORD.EQ.4)CALL INTAL2
      RETURN
      END
      SUBROUTINE DERV
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/    U(161)
     2      /F/   UT(161)
     3      /S/   UX(161),  UXX(161)
     4      /C/    X(161),         N,      NORD
C...
C...  SELECT THE SECOND-DERIVATIVE FORMULAS
      IF(NORD.EQ.2)CALL DERV1
      IF(NORD.EQ.4)CALL DERV2
      RETURN
      END
      SUBROUTINE PRINT(NI,NO)
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/    U(161)
     2      /F/   UT(161)
     3      /S/   UX(161),  UXX(161)
     4      /C/    X(161),         N,      NORD
C...
C...  SELECT THE OUTPUT ROUTINE
      IF(NORD.EQ.2)CALL PRINT1(NI,NO)
      IF(NORD.EQ.4)CALL PRINT2(NI,NO)
      RETURN
      END
      SUBROUTINE INTAL1
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/    U(161)
     2      /F/   UT(161)
     3      /S/   UX(161),  UXX(161)
     4      /C/    X(161),         N,      NORD
C...
C...  SET THE NUMBER OF GRID POINTS
      IF(NORUN.EQ.1)N=11
      IF(NORUN.EQ.2)N=21
      IF(NORUN.EQ.3)N=41
      IF(NORUN.EQ.4)N=81
      IF(NORUN.EQ.5)N=161
C...
C...  INITIAL CONDITION
      DO 1 I=1,N
      X(I)=FLOAT(I-1)/FLOAT(N-1)
      U(I)=EXP(1.0-X(I)**2)
1     CONTINUE
C...
C...  INITIAL DERIVATIVES
      CALL DERV
      RETURN
      END
      SUBROUTINE DERV1
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/    U(161)
     2      /F/   UT(161)
     3      /S/   UX(161),  UXX(161)
     4      /C/    X(161),         N,      NORD
C...
C...  FIRST DERIVATIVE UX INCLUDING THE DIRCHLET BOUNDARY CONDITION
C...  AT X = 1
      U (N)= EXP(-T)
      UT(N)=-EXP(-T)
      CALL DSS002(0.,1.,N,U,UX)
C...
C...  SECOND DERIVATIVE INCLUDING THE SYMMETRY (NEUMANN) BOUNDARY
C...  CONDITION AT X =0
      NL=2
      NU=1
      UX(1)=0.
      CALL DSS042(0.,1.,N,U,UX,UXX,NL,NU)
C...
C...  PDE
      DO 1 I=1,N-1
C...     X = 0 (EQUATION (6) IN SUBROUTINE INITAL IS USED HERE)
         IF(I.EQ.1)THEN
            UT(1)=(1.0/U(1))*3.0*(U(1)*UXX(1)+UX(1)**2)+5.0*U(1)
C...
C...     0 LT X LT 1
         ELSE
            UT(I)=(1.0/U(I))*(U(I)*UXX(I)+UX(I)**2+2.0/X(I)*U(I)*UX(I)
     1           +5.0*U(I)**2+4.0*X(I)*U(I)*UX(I))
         END IF
1     CONTINUE
      RETURN
      END
      SUBROUTINE PRINT1(NI,NO)
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/    U(161)
     2      /F/   UT(161)
     3      /S/   UX(161),  UXX(161)
     4      /C/    X(161),         N,      NORD
C...
C...  COMPUTE THE EXACT SOLUTION, THE DIFFERENCE BETWEEN THE NUMERICAL
C...  AND ANALYTICAL SOLUTIONS, AND SAVE THE LARGEST NUMERICAL ERROR
      ERRMAX=0.
      DO 1 I=1,N-1
      UA=EXP(1.0-X(I)**2-T)
      ERR=ABS(UA-U(I))
      IF(ERRMAX.LT.ERR)ERRMAX=ERR
1     CONTINUE
C...
C...  PRINT THE LARGEST NUMERICAL ERROR
      ERRLOG=ALOG10(ERRMAX)
      PNTLOG=ALOG10(FLOAT(N))
      WRITE(NO,2)T,N,ERRMAX,PNTLOG,ERRLOG
2     FORMAT(F10.3,I10,E12.4,2F12.3)
      RETURN
      END
      SUBROUTINE INTAL2
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/    U(161)
     2      /F/   UT(161)
     3      /S/   UX(161),  UXX(161)
     4      /C/    X(161),         N,      NORD
C...
C...  SET THE NUMBER OF GRID POINTS
      IF(NORUN.EQ.1)N=11
      IF(NORUN.EQ.2)N=21
      IF(NORUN.EQ.3)N=41
      IF(NORUN.EQ.4)N=81
      IF(NORUN.EQ.5)N=161
C...
C...  INITIAL CONDITION
      DO 1 I=1,N
      X(I)=FLOAT(I-1)/FLOAT(N-1)
      U(I)=EXP(1.0-X(I)**2)
1     CONTINUE
C...
C...  INITIAL DERIVATIVES
      CALL DERV
      RETURN
      END
      SUBROUTINE DERV2
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/    U(161)
     2      /F/   UT(161)
     3      /S/   UX(161),  UXX(161)
     4      /C/    X(161),         N,      NORD
C...
C...  FIRST DERIVATIVE UX INCLUDING THE DIRCHLET BOUNDARY CONDITION
C...  AT X = 1
      U (N)= EXP(-T)
      UT(N)=-EXP(-T)
      CALL DSS004(0.,1.,N,U,UX)
C...
C...  SECOND DERIVATIVE INCLUDING THE SYMMETRY (NEUMANN) BOUNDARY
C...  CONDITION AT X = 0
      NL=2
      NU=1
      UX(1)=0.
      CALL DSS044(0.,1.,N,U,UX,UXX,NL,NU)
C...
C...  PDE
      DO 1 I=1,N-1
C...     X = 0 (EQUATION (6) IN SUBROUTINE INITAL IS USED HERE)
         IF(I.EQ.1)THEN
            UT(1)=(1.0/U(1))*3.0*(U(1)*UXX(1)+UX(1)**2)+5.0*U(1)
C...
C...     0 LT X LT 1
         ELSE
            UT(I)=(1.0/U(I))*(U(I)*UXX(I)+UX(I)**2+2.0/X(I)*U(I)*UX(I)
     1           +5.0*U(I)**2+4.0*X(I)*U(I)*UX(I))
         END IF
1     CONTINUE
      RETURN
      END
      SUBROUTINE PRINT2(NI,NO)
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/    U(161)
     2      /F/   UT(161)
     3      /S/   UX(161),  UXX(161)
     4      /C/    X(161),         N,      NORD
C...
C...  COMPUTE THE EXACT SOLUTION, THE DIFFERENCE BETWEEN THE NUMERICAL
C...  AND ANALYTICAL SOLUTIONS, AND SAVE THE LARGEST NUMERICAL ERROR
      ERRMAX=0.
      DO 1 I=1,N-1
      UA=EXP(1.0-X(I)**2-T)
      ERR=ABS(UA-U(I))
      IF(ERRMAX.LT.ERR)ERRMAX=ERR
1     CONTINUE
C...
C...  PRINT THE LARGEST NUMERICAL ERROR
      ERRLOG=ALOG10(ERRMAX)
      PNTLOG=ALOG10(FLOAT(N))
      WRITE(NO,2)T,N,ERRMAX,PNTLOG,ERRLOG
2     FORMAT(F10.3,I10,E12.4,2F12.3)
      RETURN
      END
PROBLEM 2.1, SKEEL AND BERZINS, N = 11
0.        1.0       0.1111111
   11 9999    1    1  REL 0.001
PROBLEM 2.1, SKEEL AND BERZINS, N = 21
0.        1.0       0.1111111
   21 9999    1    1  REL 0.001
PROBLEM 2.1, SKEEL AND BERZINS, N = 41
0.        1.0       0.1111111
   41 9999    1    1  REL 0.001
PROBLEM 2.1, SKEEL AND BERZINS, N = 81
0.        1.0       0.1111111
   81 9999    1    1  REL 0.001
PROBLEM 2.1, SKEEL AND BERZINS, N = 161
0.        1.0       0.1111111
  161 9999    1    1  REL 0.001
END OF RUNS
*APP MATH29
      PROGRAM DASSLT
C...
C...  DSS/2 PDE APPLICATION EXECUTED UNDER DASSL WITH SPECIFICATION
C...  OF THE ODE JACOBIAN MATRIX BANDWIDTH (A SECOND TITLE FOR THIS
C...  APPLICATION APPEARS AT THE BEGINNING OF SUBROUTINE INITAL.  ALSO,
C...  THIS APPLICATION CAN BE RUN UNDER THE EXPLICIT DSS/2 INTEGRATORS,
C...  (INTEGRATORS 1 TO 15) BY DELETING THE FOLLOWING MAIN PROGRAM AND
C...  SUBORDINATE ROUTINE RES UP TO THE BEGINNING OF SUBROUTINE INITAL,
C...  SO THAT JUST THE USUAL DSS/2 SUBROUTINES INITAL, DERV AND PRINT,
C...  PLUS DATA, REMAIN.  HOWEVER, EXPERIENCE HAS INDICATED THAT THIS
C...  PROBLEM IS RELATIVELY STIFF, ESPECIALLY AS THE NUMBER OF SPATIAL
C...  GRID POINTS IS INCREASED, E.G., 11 TO 161.  THEREFORE, DASSL
C...  WHICH IS A STIFF SOLVER, IS MORE EFFICIENT THAT THE EXPLICIT
C...  DSS/2 INTEGRATORS)
C...
C...  THE SYSTEM OF ODES PROGRAMMED IN SUBROUTINE DERV IS INTEGRATED
C...  BY DASSL (A SOLVER FOR ALGEBRAIC/ODE SYSTEMS DEVELOPED BY LINDA
C...  R. PETZOLD, LAWRENCE LIVERMORE NATIONAL LABORATORY).
C...
C...  THE MODEL INITIAL CONDITIONS ARE SET IN SUBROUTINE INITAL, AND
C...  THE MODEL DERIVATIVES ARE PROGRAMMED IN SUBROUTINE DERV.  THE
C...  NUMERICAL SOLUTION IS PRINTED AND PLOTTED IN SUBROUTINE PRINT.
C...
C...  SUBROUTINES INITAL, DERV AND PRINT.  THE FOLLOWING CODING IS FOR
C...  250 ORDINARY DIFFERENTIAL EQUATIONS (ODES).  IF MORE ODES ARE TO
C...  BE INTEGRATED, ALL OF THE 250*S SHOULD BE CHANGED TO THE REQUIRED
C...  NUMBER
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/    Y(250)
     2      /F/    F(250)
C...
C...  THE NUMBER OF DIFFERENTIAL EQUATIONS IS AVAILABLE THROUGH COMMON
C...  /N/ FOR USE IN SUBROUTINE RES
      COMMON/N/      NEQN
C...
C...  COMMON AREA TO PROVIDE THE INPUT/OUTPUT UNIT NUMBERS TO OTHER
C...  SUBROUTINES
      COMMON/IO/       NI,        NO
C...
C...  ABSOLUTE DIMENSIONING OF THE ARRAYS REQUIRED BY DASSL.  ARRAY
C...  WORK IS SIZED BY THE FOLLOWING FORMULA FOR BANDED PROCESSING
C...  OF THE ODE JACOBIAN MATRIX VIA FINITE DIFFERENCES: 40+(MAXORD
C...  +4)*NEQN+(2*ML+MU+1)*NEQN+2*(NEQN/(ML+MU+1)+1).  FOR MAXORD = 5,
C...  NEQN = 250, ML = MU = 3, 40+(5+4)*250+(2*3+3+1)*250+2*(250/(3+3
C...  +1)+1) = 5000 (APPROXIMATELY).  IF FEWER THAN 250 EQUATIONS ARE
C...  TO BE SOLVED, THEN ML AND MU CAN BE LARGER FOR THE GIVEN SIZE OF
C...  WORK.  IF NEQN GT 250 AND/OR ML AND MU GT 3, WORK MUST BE DIMEN-
C...  SIONED TO A LARGER SIZE.
C...
C...  THIS SIZING OF ARRAY WORK IS SUGGESTED BY THE USE OF FIVE-POINT
C...  APPROXIMATIONS FOR THE FIRST AND SECOND-ORDER SPATIAL DERIVATIVES
C...  IN EQUATION (1), E.G., U  AND U  .  THUS, WITH JUST ONE PDE, THE
C...                          X      XX
C...  BANDWIDTH OF THE JACOBIAN MATRIX IS FIVE AND ML = MU = 3 SHOULD
C...  BE APPROPRIATE TO ENCOMPASS ALL OF THE ODE JACOBIAN MATRIX.  IF
C...  QUESTIONS REMAIN ABOUT THE CHOICE OF ML AND MU, AND THEREFRE THE
C...  SIZE OF WORK, THE ODE JACOBIAN MATRIX CAN BE MAPPED USING SUB-
C...  ROUTINE EIGEN, AND THE ODE BANDIWDTH CAN BE OBSERVED DIRECTLY
C...  FROM THE MAP
      DIMENSION YV(250), YPRIME(250), DELTA(250),
     1      RWORK(5000),  IWORK(270),   INFO(15)
C...
C...  EXTERNAL THE DERIVATIVE AND ODE JACOBIAN MATRIX ROUTINES CALLED BY
C...  DASSL
      EXTERNAL RES, JAC
C...
C...  ARRAY FOR THE TITLE (FIRST LINE OF DATA), CHARACTERS  END OF RUNS
      CHARACTER TITLE(20)*4, ENDRUN(3)*4
C...
C...  VARIABLE FOR THE TYPE OF ERROR CRITERION
      CHARACTER*3 ABSREL
C...
C...  DEFINE THE CHARACTERS  END OF RUNS
      DATA ENDRUN/'END ','OF RU','NS  '/
C...
C...  DEFINE THE INPUT/OUTPUT UNIT NUMBERS
      NI=5
      NO=6
C...
C...  OPEN INPUT AND OUTPUT FILES
      OPEN(NI,FILE='INPUT')
      OPEN(NO,FILE='OUTPUT')
C...
C...  INITIALIZE THE RUN COUNTER
      NORUN=0
C...
C...  BEGIN A RUN
1     NORUN=NORUN+1
C...
C...  INITIALIZE THE RUN TERMINATION VARIABLE
      NSTOP=0
C...
C...  READ THE FIRST LINE OF DATA
      READ(NI,1000,END=999)(TITLE(I),I=1,20)
C...
C...  TEST FOR  END OF RUNS  IN THE DATA
      DO 2 I=1,3
      IF(TITLE(I).NE.ENDRUN(I))GO TO 3
2     CONTINUE
C...
C...  AND END OF RUNS HAS BEEN READ, SO TERMINATE EXECUTION
999   STOP
C...
C...  READ THE SECOND LINE OF DATA
3     READ(NI,1001,END=999)T0,TF,TP
C...
C...  READ THE THIRD LINE OF DATA
      READ(NI,1002,END=999)NEQN
C...
C...  PRINT A DATA SUMMARY
      WRITE(NO,1003)NORUN,(TITLE(I),I=1,20),
     1                     T0,TF,TP,
     2                     NEQN
C...
C...  INITIALIZE TIME
      T=T0
C...
C...  SET THE INITIAL CONDITIONS
      CALL INITAL
C...
C...  PRINT THE INITIAL CONDITIONS
      CALL PRINT(NI,NO)
C...
C...  SET THE INITIAL CONDITIONS FOR SUBROUTINE DASSL
      CALL DERV
      DO 5 I=1,NEQN
      YV(I)=Y(I)
      YPRIME(I)=F(I)
5     CONTINUE
C...
C...  SET THE PARAMETERS FOR SUBROUTINE DASSL
      TV=T0
      RTOL=1.0E-07
      ATOL=1.0E-07
      LRW=5000
      LIW=270
      DO 7 I=1,15
      INFO(I)=0
7     CONTINUE
C...
C...  SPECIFY THAT THE DASSL BANDED ODE JACOBIAN MATRIX OPTION IS TO
C...  BE USED
      ML=3
      MU=3
      IWORK(1)=ML
      IWORK(2)=MU
      INFO(6)=1
C...
C...  CALL SUBROUTINE DASSL TO COVER ONE PRINT INTERVAL
4     TOUT=TV+TP
      CALL SDASSL(RES,NEQN,TV,YV,YPRIME,TOUT,INFO,RTOL,ATOL,IDID,
     1           RWORK,LRW,IWORK,LIW,RPAR,IPAR,JAC)
C...
C...  PRINT THE SOLUTION
      T=TV
      DO 6 I=1,NEQN
      Y(I)=YV(I)
6     CONTINUE
      CALL PRINT(NI,NO)
C...
C...  TEST FOR AN ERROR CONDITION
      IF(IDID.LT.0)THEN
C...
C...     PRINT A MESSAGE INDICATING AN ERROR CONDITION
         WRITE(NO,1004)IDID
C...
C...     GO ON TO THE NEXT RUN
         GO TO 1
      END IF
C...
C...  CHECK FOR A RUN TERMINATION
      IF(NSTOP.NE.0)GO TO 1
C...
C...  CHECK FOR THE END OF THE RUN
      IF(TV.LT.(TF-0.5*TP))GO TO 4
C...
C...  THE CURRENT RUN IS COMPLETE, SO PRINT THE COMPUTATIONAL STAT-
C...  ISTICS FOR DASSL AND GO ON TO THE NEXT RUN
      WRITE(NO,8)RWORK(7),IWORK(8),IWORK(11),IWORK(12),IWORK(13)
8     FORMAT(1H ,//,' COMPUTATIONAL STATISTICS'                    ,//,
     1 ' LAST STEP SIZE                       ',              E10.3,//,
     2 ' LAST ORDER OF THE METHOD             ',                I10,//,
     3 ' TOTAL NUMBER OF STEPS TAKEN          ',                I10,//,
     4 ' NUMBER OF FUNCTION EVALUATIONS       ',                I10,//,
     5 ' NUMBER OF JACOBIAN EVALUATIONS       ',                I10,/)
      GO TO 1
C...
C...  *****************************************************************
C...
C...  FORMATS
C...
1000  FORMAT(20A4)
1001  FORMAT(3E10.0)
1002  FORMAT(I5)
1003  FORMAT(1H1,
     1 ' RUN NO. - ',I3,2X,20A4,//,
     2 ' INITIAL T - ',E10.3,//,
     3 '   FINAL T - ',E10.3,//,
     4 '   PRINT T - ',E10.3,//,
     5 ' NUMBER OF DIFFERENTIAL EQUATIONS - ',I3,//,
     6 1H1)
1004  FORMAT(1H ,//,' IDID = ',I3,//,
     1 ' INDICATING AN INTEGRATION ERROR, SO THE CURRENT RUN'     ,/,
     2 ' IS TERMINATED.  PLEASE REFER TO THE DOCUMENTATION FOR'   ,/,
     3 ' SUBROUTINE',//,25X,'DASSL',//,
     4 ' FOR AN EXPLANATION OF THESE ERROR INDICATORS'            )
      END
      SUBROUTINE RES(TV,YV,YPRIME,DELTA,IRES,RPAR,IPAR)
C...
C...  SUBROUTINE RES IS AN INTERFACE ROUTINE BETWEEN SUBROUTINES DASSL
C...  AND DERV
C...
C...  COMMON AREA TO INTERFACE WITH SUBROUTINE DERV
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/      Y(1)
     2      /F/      F(1)
C...
C...  THE NUMBER OF DIFFERENTIAL EQUATIONS IS AVAILABLE THROUGH COMMON
C...  /N/
      COMMON/N/      NEQN
C...
C...  ABSOLUTE DIMENSION THE DEPENDENT, DERIVATIVE AND RESIDUAL ARRAYS
      DIMENSION YV(250), YPRIME(250), DELTA(250)
C...
C...  TRANSFER THE INDEPENDENT VARIABLE, DEPENDENT VARIABLE VECTOR
C...  FOR USE IN SUBROUTINE DERV
      T=TV
      DO 1 I=1,NEQN
      Y(I)=YV(I)
1     CONTINUE
C...
C...  EVALUATE THE DERIVATIVE VECTOR
      CALL DERV
C...
C...  TRANSFER THE DERIVATIVE VECTOR FOR USE BY SUBROUTINE DASSL
      DO 2 I=1,NEQN
      DELTA(I)=YPRIME(I)-F(I)
2     CONTINUE
      RETURN
      END
      SUBROUTINE INITAL
C...
C...  ONE-DIMENSIONAL, NONLINEAR, PARABOLIC PDE BY SECOND AND FOURTH-
C...  ORDER FORMULAS FOR SECOND-ORDER SPATIAL DERIVATIVES
C...
C...  CONSIDER THE FOLLOWING NONLINEAR PARABOLIC PARTIAL DIFFERENTIAL
C...  EQUATION (PDE) (1)
C...
C...     U*U  = (1/X**2)*((X**2)*U*U )  + 5*(U**2) + 4*X*U*U    (1)
C...        T                       X X                     X
C...
C...     U(X,0) = EXP(1 - X**2)                                 (2)
C...
C...     U (0,T) = 0, U(1,T) = EXP(-T)                       (3)(4)
C...      X
C...
C...  THE ANALYTIC SOLUTION TO EQUATIONS (1) TO (4) IS
C...
C...     U(X,T) = EXP(1 - X**2 - T)                             (5)
C...
C...  (1)  THIS PROBLEM WAS PROVIDED BY ROBERT D. SKEEL, DEPARTMENT OF
C...       COMPUTER SCIENCE, UNIVERSITY OF ILLINOIS, AND MARTIN BERZINS,
C...       DEPARTMENT OF COMPUTER STUDIES, UNIVERSITY OF LEEDS
C...
C...  IN THE FOLLOWING CODING, EQUATIONS (1) TO (4) ARE SOLVED BY THE
C...  NUMERICAL METHOD OF LINES USING THE SECOND-DERIVATIVE FORMULAS
C...  REPORTED BY SCHIESSER AND STENGLE (2).  THE T INTEGRATION IS
C...  PERFORMED BY DASSL (3).  BOTH SECOND AND FOURTH-ORDER FORMULAS
C...  ARE USED SO THAT THE EFFECT OF THE ORDER OF THE APPROXIMATION IN
C...  COMPUTING SECOND-ORDER DERIVATIVES CAN BE OBSERVED.
C...
C...     (2)  SCHIESSER, W. E., AND G. A. STENGLE, SECOND DERIVATIVE
C...          FORMULAS FOR USE IN THE NUMERICAL METHOD OF LINES,
C...          PROCEEDINGS OF THE IMACS SIXTH INTERNATIONAL SYMPOSIUM
C...          ON COMPUTER METHODS FOR PARTIAL DIFFERENTIAL EQUATIONS,
C...          LEHIGH UNIVERSITY, BETHLEHEM, PA, JUNE 23-26, 1987.
C...
C...     (3)  DASSL IS A TRANSPORTABLE FORTRAN CODE FOR THE NUMERICAL
C...          SOLUTION OF DIFFERENTIAL-ALGEBRAIC SYSTEMS DEVELOPED BY
C...          LINDA R. PETZOLD OF THE LAWRENCE LIVERMORE LABORATORY
C...
C...  BEFORE PROCEEDING WITH THE CODING FOR EQUATIONS (1) TO (4), A
C...  DETAIL SHOULD BE CONSIDERED.  THE FIRST TERM ON THE RIGHT HAND
C...  SIDE OF EQUUATON (1) CAN BE EXPANDED BY THE CHAIN RULE FOR
C...  DIFFERENTIATION OF A PRODUCT
C...
C...     (1/X**2)*((X**2)*U*U )  = U*U   + (U )**2 + (2/X)*U*U
C...                         X X      XX     X                X
C...
C...  ADDITIONALLY, THE SECOND TERM IS INDETERMINATE FOR X = 0 AS A
C...  CONSEQUENCE OF BOUNDARY CONDITION (3), I.E.,
C...
C...       LIM   (2/X)*U*U  = 2*(U*U   + (U )**2)               (6)
C...      X--+0           X         XX     X
C...
C...  THIS RESULT FOR X = 0 IS USED IN THE SUBSEQUENT METHOD OF LINES
C...  CODING.
C...
C...  THE CODING FOR THE SECOND-ORDER FORMULAS IS CONTAINED IN SUBROU-
C...  TINES INTAL1, DERV1 AND PRINT1 WHICH ARE CALLED BY SETTING NORD=2
C...  IN THE FOLLOWING CODE.  THE CODING FOR THE FOURTH-ORDER FORMULAS
C...  IS IN SUBROUTINES INTAL2, DERV2 AND PRINT2 WHICH ARE CALLED BY
C...  SETTING NORD=4.
C...
C...  COMMON AREA FOR INTERFACE WITH SUBROUTINES INITAL, DERV AND
C...  PRINT
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/    U(161)
     2      /F/   UT(161)
     3      /S/   UX(161),  UXX(161)
     4      /C/    X(161),         N,      NORD
C...
C...  SELECT THE ORDER OF THE SECOND-DERIVATIVE FORMULAS
      NORD=2
C...  NORD=4
C...
C...  INITIAL CONDITION
      IF(NORD.EQ.2)CALL INTAL1
      IF(NORD.EQ.4)CALL INTAL2
      RETURN
      END
      SUBROUTINE DERV
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/    U(161)
     2      /F/   UT(161)
     3      /S/   UX(161),  UXX(161)
     4      /C/    X(161),         N,      NORD
C...
C...  SELECT THE SECOND-DERIVATIVE FORMULAS
      IF(NORD.EQ.2)CALL DERV1
      IF(NORD.EQ.4)CALL DERV2
      RETURN
      END
      SUBROUTINE PRINT(NI,NO)
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/    U(161)
     2      /F/   UT(161)
     3      /S/   UX(161),  UXX(161)
     4      /C/    X(161),         N,      NORD
C...
C...  SELECT THE OUTPUT ROUTINE
      IF(NORD.EQ.2)CALL PRINT1(NI,NO)
      IF(NORD.EQ.4)CALL PRINT2(NI,NO)
      RETURN
      END
      SUBROUTINE INTAL1
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/    U(161)
     2      /F/   UT(161)
     3      /S/   UX(161),  UXX(161)
     4      /C/    X(161),         N,      NORD
C...
C...  SET THE NUMBER OF GRID POINTS
      IF(NORUN.EQ.1)N=11
      IF(NORUN.EQ.2)N=21
      IF(NORUN.EQ.3)N=41
      IF(NORUN.EQ.4)N=81
      IF(NORUN.EQ.5)N=161
C...
C...  INITIAL CONDITION
      DO 1 I=1,N
      X(I)=FLOAT(I-1)/FLOAT(N-1)
      U(I)=EXP(1.0-X(I)**2)
1     CONTINUE
C...
C...  INITIAL DERIVATIVES
      CALL DERV
      RETURN
      END
      SUBROUTINE DERV1
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/    U(161)
     2      /F/   UT(161)
     3      /S/   UX(161),  UXX(161)
     4      /C/    X(161),         N,      NORD
C...
C...  FIRST DERIVATIVE UX INCLUDING THE DIRCHLET BOUNDARY CONDITION
C...  AT X = 1
      U (N)= EXP(-T)
      UT(N)=-EXP(-T)
      CALL DSS002(0.,1.,N,U,UX)
C...
C...  SECOND DERIVATIVE INCLUDING THE SYMMETRY (NEUMANN) BOUNDARY
C...  CONDITION AT X =0
      NL=2
      NU=1
      UX(1)=0.
      CALL DSS042(0.,1.,N,U,UX,UXX,NL,NU)
C...
C...  PDE
      DO 1 I=1,N-1
C...     X = 0 (EQUATION (6) IN SUBROUTINE INITAL IS USED HERE)
         IF(I.EQ.1)THEN
            UT(1)=(1.0/U(1))*3.0*(U(1)*UXX(1)+UX(1)**2)+5.0*U(1)
C...
C...     0 LT X LT 1
         ELSE
            UT(I)=(1.0/U(I))*(U(I)*UXX(I)+UX(I)**2+2.0/X(I)*U(I)*UX(I)
     1           +5.0*U(I)**2+4.0*X(I)*U(I)*UX(I))
         END IF
1     CONTINUE
      RETURN
      END
      SUBROUTINE PRINT1(NI,NO)
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/    U(161)
     2      /F/   UT(161)
     3      /S/   UX(161),  UXX(161)
     4      /C/    X(161),         N,      NORD
C...
C...  COMPUTE THE EXACT SOLUTION, THE DIFFERENCE BETWEEN THE NUMERICAL
C...  AND ANALYTICAL SOLUTIONS, AND SAVE THE LARGEST NUMERICAL ERROR
      ERRMAX=0.
      DO 1 I=1,N-1
      UA=EXP(1.0-X(I)**2-T)
      ERR=ABS(UA-U(I))
      IF(ERRMAX.LT.ERR)ERRMAX=ERR
1     CONTINUE
C...
C...  PRINT THE LARGEST NUMERICAL ERROR
      ERRLOG=ALOG10(ERRMAX)
      PNTLOG=ALOG10(FLOAT(N))
      WRITE(NO,2)T,N,ERRMAX,PNTLOG,ERRLOG
2     FORMAT(F10.3,I10,E12.4,2F12.3)
      RETURN
      END
      SUBROUTINE INTAL2
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/    U(161)
     2      /F/   UT(161)
     3      /S/   UX(161),  UXX(161)
     4      /C/    X(161),         N,      NORD
C...
C...  SET THE NUMBER OF GRID POINTS
      IF(NORUN.EQ.1)N=11
      IF(NORUN.EQ.2)N=21
      IF(NORUN.EQ.3)N=41
      IF(NORUN.EQ.4)N=81
      IF(NORUN.EQ.5)N=161
C...
C...  INITIAL CONDITION
      DO 1 I=1,N
      X(I)=FLOAT(I-1)/FLOAT(N-1)
      U(I)=EXP(1.0-X(I)**2)
1     CONTINUE
C...
C...  INITIAL DERIVATIVES
      CALL DERV
      RETURN
      END
      SUBROUTINE DERV2
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/    U(161)
     2      /F/   UT(161)
     3      /S/   UX(161),  UXX(161)
     4      /C/    X(161),         N,      NORD
C...
C...  FIRST DERIVATIVE UX INCLUDING THE DIRCHLET BOUNDARY CONDITION
C...  AT X = 1
      U (N)= EXP(-T)
      UT(N)=-EXP(-T)
      CALL DSS004(0.,1.,N,U,UX)
C...
C...  SECOND DERIVATIVE INCLUDING THE SYMMETRY (NEUMANN) BOUNDARY
C...  CONDITION AT X = 0
      NL=2
      NU=1
      UX(1)=0.
      CALL DSS044(0.,1.,N,U,UX,UXX,NL,NU)
C...
C...  PDE
      DO 1 I=1,N-1
C...     X = 0 (EQUATION (6) IN SUBROUTINE INITAL IS USED HERE)
         IF(I.EQ.1)THEN
            UT(1)=(1.0/U(1))*3.0*(U(1)*UXX(1)+UX(1)**2)+5.0*U(1)
C...
C...     0 LT X LT 1
         ELSE
            UT(I)=(1.0/U(I))*(U(I)*UXX(I)+UX(I)**2+2.0/X(I)*U(I)*UX(I)
     1           +5.0*U(I)**2+4.0*X(I)*U(I)*UX(I))
         END IF
1     CONTINUE
      RETURN
      END
      SUBROUTINE PRINT2(NI,NO)
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/    U(161)
     2      /F/   UT(161)
     3      /S/   UX(161),  UXX(161)
     4      /C/    X(161),         N,      NORD
C...
C...  COMPUTE THE EXACT SOLUTION, THE DIFFERENCE BETWEEN THE NUMERICAL
C...  AND ANALYTICAL SOLUTIONS, AND SAVE THE LARGEST NUMERICAL ERROR
      ERRMAX=0.
      DO 1 I=1,N-1
      UA=EXP(1.0-X(I)**2-T)
      ERR=ABS(UA-U(I))
      IF(ERRMAX.LT.ERR)ERRMAX=ERR
1     CONTINUE
C...
C...  PRINT THE LARGEST NUMERICAL ERROR
      ERRLOG=ALOG10(ERRMAX)
      PNTLOG=ALOG10(FLOAT(N))
      WRITE(NO,2)T,N,ERRMAX,PNTLOG,ERRLOG
2     FORMAT(F10.3,I10,E12.4,2F12.3)
      RETURN
      END
PROBLEM 2.1, SKEEL AND BERZINS, N = 11
0.        1.0       0.1111111
   11 9999    1    1  REL 0.001
PROBLEM 2.1, SKEEL AND BERZINS, N = 21
0.        1.0       0.1111111
   21 9999    1    1  REL 0.001
PROBLEM 2.1, SKEEL AND BERZINS, N = 41
0.        1.0       0.1111111
   41 9999    1    1  REL 0.001
PROBLEM 2.1, SKEEL AND BERZINS, N = 81
0.        1.0       0.1111111
   81 9999    1    1  REL 0.001
PROBLEM 2.1, SKEEL AND BERZINS, N = 161
0.        1.0       0.1111111
  161 9999    1    1  REL 0.001
END OF RUNS
*APP MATH30
      SUBROUTINE INITAL
C...
C...  THE LOGISTIC EQUATION
C...
C...  THE LOGISTIC EQUATION HAS BEEN USED TO MODEL A BROAD SPECTRUM OF
C...  DYNAMIC PROCESSES.  IT IS A SIMPLE FIRST-ORDER, NONLINEAR, INITIAL
C...  -VALUE ORDINARY DIFFERENTIAL EQUATION FOR WHICH THE EARLY GROWTH
C...  RATE (DERIVATIVE WITH RESPECT TO TIME) IS PROPORTIONAL TO THE
C...  CURRENT VALUE OF THE SOLUTION (DEPENDENT VARIABLE).  AS THIS
C...  POSITIVE GROWTH CONTINUES, IT IS INCREASINGLY BALANCED OR OFFSET
C...  BY A NEGATIVE GROWTH PROPORTIONAL TO THE SQUARE OF THE CURRENT
C...  SOLUTION.  WHEN ENOUGH TIME HAS PASSED, THIS SQUARED TERM DOMI-
C...  NATES AND BRINGS THE NET GROWTH TO ZERO.  THUS THE GROWTH RATE,
C...  DY/DT, IS GIVEN BY
C...
C...     DY/DT = K1*Y - K2*Y**2
C...
C...  WITH AN INITIAL CONDITION
C...
C...     Y(0) = Y0
C...
C...  K1, K2 AND Y0 ARE POSITIVE CONSTANTS.
C...
C...  TYPICALLY THE SOLUTION IS A SIGMOID OF THE FORM
C...
C...               .
C...               .
C
C                  .
C                  .
C               YF . . . . . . . . . . . . . . . . . . . . . . . . . .
C                  .                                     X  X  X
C                  .                                  X
C                  .                               X
C                  .                            X
C                  .                          X
C                  .                        X
C                  .                      X
C             Y(T) .                     X
C                  .                    X
C                  .                   X
C                  .                 X
C                  .               X
C                  .            X
C                  .         X
C               Y0 .X  X  X
C                  . . . . . . . . . . . . . . . . . . . . . . . . . .
C                  0                       T
C
C...  WHERE YF CORRESPONDS TO DY/DT = 0 OR (K1 - K2*YF)*YF = 0 SO YF =
C...  K1/K2.  THE DERIVATIVE OF THIS CURVE IS THE WELL-KNOWN SYMMETRICAL
C...  BELL-SHAPED CURVE.
C...
C...  AN APPLICATION OF THE LOGISTIC EQUATION TO GROWTH OF THE WORLD*S
C...  POPULATION WITH A FOOD CONSTRAINT FOLLOWS.  THE WORLD*S POPULATION
C...  HAS RECENTLY BEEN GROWING EXPONENTIALLY WITH K1 = 0.017 TO 0.02
C...  (I.E., 1.7 TO 2.0 PERCENT ANNUALLY).  CLEARLY, HOWEVER, THIS
C...  GROWTH CANNOT CONTINUE INDEFINITELY BECAUSE OF THE EARTH*S FINITE
C...  RESOURCES, AND A DECLINE IN THE GROWTH RATE MUST OCCUR, EITHER
C...  THROUGH AN ORDERLY AND VOLUNTARY REDUCTION IN BIRTH RATES, OR A
C...  CATASTROPHE IMPOSED BY NATURE, E.G., A FAMINE OR EXHAUSTION OF
C...  ENERGY SUPPLIES.  SOME OF THESE IDEAS ARE PRESENTED IN THE FOLLOW-
C...  ING ANALYSIS.
C...
C...  SUBROUTINE INITAL SETS THE INITIAL CONDITION OF THE DIFFERENTIAL
C...  EQUATION FOR GROWTH OF THE WORLD POPULATION WITH A FOOD CONSTRAINT
C...
C...  THIS PROGRAM IS BASED ON A SIMPLIFIED ANALYSIS OF THE GROWTH OF
C...  THE WORLD*S POPULATION AND THE CONSTRAINT ON THIS GROWTH IMPOSED
C...  BY THE EARTH*S CARRYING CAPACITY IN THE FORM OF FOOD PRODUCTION.
C...  OF COURSE, THE MANY FACTORS WHICH INFLUENCE POPULATION GROWTH AND
C...  FOOD PRODUCTION CONSTITUTE A VERY COMPLEX PROBLEM AREA CHARACTER-
C...  IZED BY MANIFOLD INTERACTIONS.  THUS THE FOLLOWING ANALYSIS, BASED
C...  ON A SINGLE FIRST-ORDER DIFFERENTIAL EQUATION, IS INTENDED TO
C...  ELUCIDATE ONLY SOME OF THE GROSS FEATURES OF WORLD POPULATION
C...  GROWTH, PRINCIPALLY THE MAGNITUDE OF A FEW NUMERICAL INDICATORS
C...  WHICH ARE PERHAPS ESTIMATED ONLY SEMIQUANTIATIVELY AT BEST.
C...
C...  IN ADDITION TO THE UNDERLYING COMPLEXITY OF THE PROBLEM AREA, A
C...  SECOND COMPLICATION IS THE GATHERING OF REASONABLY RELIABLE DATA.
C...  FOR EXAMPLE, THE MEASUREMENT OF DEMOGRAPHIC DATA IS VERY NON-
C...  UNIFORM THROUGHOUT THE WORLD WITH RESPECT TO GENERAL AVAILABILITY,
C...  ACCURACY AND RELIABILITY.  THUS DATA REPORTED FROM VARIOUS SOURCES
C...  TEND TO BE CONTRADICTORY AND CLEARLY UNRELIABLE TO SOME EXTENT.
C...  IN THE ANALYSIS WHICH FOLLOWS, ONLY A FEW REPRESENTATIVE DATA
C...  ARE PRESENTED TO GIVE ORDER-OF-MAGNITUDE RESULTS.
C...
C...  TO BEGIN THE ANALYSIS, A MAJOR DEVELOPMENT WHICH HAS BEEN REPORTED
C...  RECENTLY BY SEVERAL RECOGNIZED AUTHORITIES IS THE DECLINE IN THE
C...  GROWTH OF THE WORLD POPULATION.  FOR EXAMPLE,
C...
C...  (1)  BROWN, LESTER R., THE GROWTH OF POPULATION IS SLOWING DOWN,
C...       THE NEW YORK TIMES, PAGE E8, SUNDAY, NOVEMBER 21, 1976 - THE
C...       POPULATION GROWTH RATE IS REPORTED TO HAVE DECLINED FROM 1.9
C...       PERCENT IN 1970 TO 1.64 PERCENT IN 1975.  ADDITIONALLY,
C...       HIGHER DEATH RATES IN A FEW POOR COUNTRIES FROM STARVATION
C...       AND MALNUTRITION ARE REPORTED SUGGESTING THAT A FOOD CON-
C...       STRAINT HAS BEEN REACHED IN THESE COUNTRIES.
C...
C...  (2)  1976 WORLD POPULATION DATA SHEET OF THE POPULATION REFERENCE
C...       BUREAU, INC., 1745 N STREET, N.W., WASHINGTON, D.C., 20036 -
C...       THE WORLDWIDE BIRTH AND DEATH RATES ARE REPORTED AS 30 AND
C...       12 PERSONS/1000 PERSONS/YEAR OR A RATE OF POPULATION GROWTH
C...       OF 3.0 - 1.2 = 1.8 PERCENT.  HOWEVER, THIS GROWTH RATE IS
C...       REPORTED WITH THE FOLLOWING QUALIFICATIONS WHICH INDICATE THE
C...       DIFFICULTY IN COLLECTING RELIABLE WORLDWIDE DEMOGRAPHIC DATA
C...
C...          **FOR THE MORE DEVELOPED COUNTRIES, WITH COMPLETE OR
C...          NEARLY COMPLETE REGISTRATION OF BIRTHS AND DEATHS, NEARLY
C...          ALL THE RATES SHOWN (IN THE TABLE OF THE DATA SHEET) PER-
C...          TAIN TO 1973 OR 1974.  FOR NEARLY ALL THE DEVELOPING
C...          COUNTRIES WITH INCOMPLETE REGISTRATION, THE RATES REFER
C...          TO THE 1970-75 PERIOD AND ARE TAKEN FROM THE MEDIUM
C...          VARIANT ESTIMATES AND PROJECTIONS AS ASSESSED IN 1973
C...          (U.N. SELECTED WORLD DEMOGRAPHIC INDICATORS...).  THESE
C...          FIGURES SHOULD BE CONSIDERED AS ROUGH APPROXIMATIONS
C...          ONLY.**
C...
C...
C...  (3)  KEYFITZ, NATHAN, WORLD RESOURCES AND THE WORLD MIDDLE CLASS,
C...       SCIENTIFIC AMERICAN, VOL. 235, NO. 1, PP. 28-35, JULY, 1976 -
C...       THE ANNUAL PERCENT INCREASE IN WORLD POPULATION IS PLOTTED ON
C...       PAGE 30 FOR FIVE-YEAR INTERVALS FROM 1950 TO 2000 (OF COURSE,
C...       THE LATTER SECTION OF THE PLOT IS A PROJECTION).  IN PARTI-
C...       CULAR, WITHIN THE LIMITED ACCURACY WITH WHICH THE PLOT CAN BE
C...       READ, THE GROWTH RATE FOR 1970 - 1975 IS 1.9 PERCENT, AND FOR
C...       1975 - 1980, 1.95 PERCENT.  THEREFAFTER, THE GROWTH RATE
C...       DECLINES.
C...
C...  PERHAPS THE VARIATION IN REPORTED GROWTH RATES FOR REFERENCES (1)
C...  TO (3) SEEMS INCONSEQUENTIAL, I.E., 1.64 TO 1.95 PERCENT.  HOWEVER
C...  CONSIDER THE MAGNITUDE OF THESE DIFFERENCES IN TERMS OF PEOPLE
C...  /YEAR BASED ON A CURRENT POPULATION OF FOUR BILLION.  A DIFFERENCE
C...  OF 0.1 PERCENT IS 4,000,000,000*0.001 = 4,000,000 PEOPLE/YEAR.
C...  THUS THE MAXIMUM DIFFERENCE OF 0.3 PERCENT (1.64 TO 1.95 PERCENT)
C...  CAN MEAN A DIFFERENCE IN THE GROWTH RATE OF WORLD POPULATION OF AS
C...  MUCH AS 12,000,000 PEOPLE/YEAR, WHICH IS NEARLY EQUAL TO THE
C...  POPULATION OF AUSTRALIA.
C...
C...  ONE FINAL POINT CONCERNING THE ANALYSIS WHICH FOLLOWS.  BROWN
C...  (REFERENCE (1)) HAS REPORTED THAT THE DECREASE IN THE POPULATION
C...  GROWTH RATE IS APPARENTLY DUE TO TWO CAUSES - (1) REDUCED BIRTH
C...  RATES DUE TO INCREASINGLY EFFECTIVE FAMILY PLANNING PROGRAMS AND
C...  (2) INCREASED DEATH RATES DUE TO MALNUTRITION IN SOME OF THE
C...  POORER COUNTRIES.  THUS THE LIMITATION OF POPULATION GROWTH
C...  IMPOSED BY FOOD IS AN IMPORTANT CONSIDERATION, AND IN FACT, A
C...  CRITICAL QUESTION REGARDING THE WELL BEING OF THE HUMAN RACE IN
C...  THE YEARS AHEAD IS WHETHER THE PRODUCTION OF FOOD WILL KEEP PACE
C...  WITH POPULATION GROWTH.
C...
C...  WE NOW CONSIDER THE MATHEMATICAL ANALYSIS OF THE GROWTH OF THE
C...  WORLD*S POPULATION WITH A FOOD CONSTRAINT.  THE ANALYSIS IS BASED
C...  ESSENTIALLY ON MINOR EXTENSIONS OF THE CLASSICAL LOGISTIC DIFFER-
C...  TIAL EQUATION.
C...
C...     DP/DT = BR - DR                                             (1)
C...
C...     BR = BRC*P                                                  (2)
C...
C...     DR = (DRC + FC*P)*P                                         (3)
C...
C...     P = P0, T = T0                                              (4)
C...
C...     P      WORLD POPULATION (PEOPLE)
C...
C...     P0     INITIAL WORLD POPULATION (PEOPLE)
C...
C...     T      TIME (CALENDAR YEAR)
C...
C...     T0     INITIAL TIME (CALENDAR YEAR)
C...
C...     BR     TOTAL WORLD BIRTH RATE (BIRTHS/YEAR)
C...
C...     DR     TOTAL WORLD DEATH RATE (DEATHS/YEAR)
C...
C...     BRC    PER CAPITA WORLD BIRTH RATE COEFFICIENT (BIRTHS/PERSON/
C...            YEAR)
C...
C...     DRC    PER CAPITA WORLD DEATH RATE COEFFICIENT (DEATHS/PERSON/
C...            YEAR)
C...
C...     FC     FOOD COEFFICIENT REFLECTING THE WORLDWIDE EFFECTS OF
C...            FOOD SCARCITY (I.E., STARVATION AND MALNUTRITION)
C...            (DEATHS/PERSON**2/YEAR)
C...
C...  EQUATION (1) IS THE STANDARD DIFFERENTIAL EQUATION FOR POPULATION
C...  GROWTH.  THE TOTAL DEATH RATE, DR, IS MODIFIED BY A LINEAR TERM
C...  IN P (I.E., FC*P) TO ACCOUNT FOR INCREASED DEATHS FROM FOOD
C...  SCARCITY.  THUS THE MODEL CONSISTS OF THE NONLINEAR DIFFERENTIAL
C...  EQUATION
C...
C...     DP/DT = (BRC - DRC)*P - FC*P**2                             (5)
C...
C...  WITH INITIAL CONDITION (4).
C...
C...  FOR THE PURPOSES OF THIS STUDY, WE TAKE BRC = 0.030 AND DRC =
C...  0.013 (I.E., 30 BIRTHS/1000 PEOPLE/YEAR AND 13 DEATHS/1000 PEOPLE/
C...  YEAR) WHICH ARE INTERMEDIATE RATES TAKEN FROM REFERENCES (1) TO
C...  (3) CITED PREVIOUSLY.  THUS THE NET RATE OF INCREASE WITHOUT A
C...  SIGNIFICANT CONTRIBUTION FROM THE FOOD TERM IS 0.017 (I.E., 1.7
C...  PERCENT ANNUAL GROWTH, TAKEN AS THE 1975 WORLDWIDE AVERAGE).
C...
C...  THE VALUE OF FC IS, OF COURSE, UNKNOWN SINCE WE DO NOT HAVE A
C...  CONDITION OF EXTREME FOOD SCARCITY FOR WHICH AN ESTIMATE CAN BE
C...  MADE.  HOWEVER, REASONABLE VALUES CAN BE POSTULATED, AND A PARA-
C...  METRIC STUDY OF FC CAN THEN BE UNDERTAKEN.  FOR EXAMPLE, WE MIGHT
C...  POSTULATE THAT SIGNIFICANT WORLDWIDE STARVATION AND MALNUTRITION
C...  WILL OCCUR WHEN THE WORLD POPULATION HAS MORE THAN DOUBLED SINCE
C...  MANY AGRICULTURAL EXPERTS BELIEVE WORLD FOOD PRODUCTION CAN BE
C...  DOUBLED WITH A MAJOR INTERNATIONAL COMMITMENT OF RESOURCES.  THUS,
C...  IN EQUATION (3), IN ORDER FOR THE SECOND TERM, FC*P, TO BE COM-
C...  PARABLE TO THE FIRST, DRC, WHEN P = 8.0E+09, FC*P = DRC OR FC*
C...  8.0E+09 = 0.013, FC = 0.013/8.0E+09.
C...
C...  FC IS A CRITICAL PARAMETER SINCE IT DETERMINES THE ULTIMATE LIMIT
C...  ON POPULATION IMPOSED BY THE AVAILABILITY OF FOOD.  AS FC IN-
C...  CREASES, THE MAXIMUM SUSTAINABLE POPULATION, I.E., THE EARTH*S
C...  ULTIMATE CARRYING CAPACITY WITH RESPECT TO FOOD, DECREASES AND THE
C...  NUMBER OF FOOD-RELATED DEATHS INCREASES. NOTE ALSO THAT THE NORMAL
C...  DEATH RATE TERM IN EQUATION (5), -DRC*P, IS LINEAR IN P WHILE THE
C...  FOOD-RELATED DEATH RATE TERM, -FC*P**2, IS SECOND-ORDER (SQUARED)
C...  IN P.  THUS THE LATTER WILL EVENTUALLY DOMINANT THE RIGHT HAND
C...  SIDE OF EQUATION (5) FOR LARGE P AND THEREBY DETERMINE THE LONG-
C...  TIME SOLUTION OF EQUATION (5).  THIS CHARACTERISTIC, WHICH IS
C...  MANIFEST AS A MAXIMUM IN THE DERIVATIVE, DP/DT, GIVEN BY EQUATION
C...  (5), IS SUBSEQUENTLY DISCUSSED IN GREATER DETAIL.
C...
C...  THE ANALYTICAL SOLUTION TO EQUATIONS (4) AND (5) IS AVAILABLE FOR
C...  COMPARISON WITH THE NUMERICAL SOLUTION (SEE, FOR EXAMPLE, MAKI,
C...  DANIEL P., AND MAYNARD THOMPSON, MATHEMATICAL MODELS AND APPLI-
C...  CATIONS, PRENTICE-HALL, INC., ENGLEWOOD CLIFFS, N.J., 1973, PP.
C...  313-318)
C...
C...     P = P0*PM/(P0 + (PM - P0)*EXP(-(BRC - DRC)*(T - T0)))       (6)
C...
C...     P0     4.0E+09 (FROM EQUATION (4))
C...
C...     T0     1975 (FROM EQUATION (4))
C...
C...     PM     (BRC - DRC)/FC (MAXIMUM POSSIBLE POPULATION)
C...
C...  A FEW INTERESTING PROPERTIES OF THIS SOLUTION CAN BE CONSIDERED.
C...  FOR EXAMPLE, IF P = PM = (BRC - DRC)/FC IS SUBSTITUTED IN THE
C...  RIGHT HAND SIDE (RHS) OF EQUATION (5)
C...
C...     DPM/DT = (BRC - DRC)*(BRC - DRC)/FC - FC*((BRC - DRC)/FC)**2
C...
C...            = 0
C...
C...  I.E., P REACHES A MAXIMUM WHEN P = PM AND DOES NOT CHANGE SUBSE-
C...  QUENTLY.  ALSO, IF THE RHS OF EQUATION (5) IS DIFFERENTIATED WITH
C...  RESPECT TO P
C...
C...     D(DP/DT)/DP = (BRC - DRC) - 2*FC*P
C...
C...  THIS RESULT CAN THEN BE SET TO ZERO TO FIND THE MAXIMUM VALUE OF
C...  DERIVATIVE, DP/DT
C...
C...     (BRC - DRC) - 2*FC*P = 0 OR P = (BRC - DRC)/(2*FC) = PM/2
C...
C...  THUS THE RATE OF CHANGE OF P IS GREATEST (I.E., DP/DT IS A MAXI-
C...  MUM) WHEN P = PM/2.  THIS IS ACTUALLY A POINT OF INFLECTION IN THE
C...  SOLUTION P(T).  THE MAXIMUM VALUE OF DP/DT IS THEN GIVEN BY
C...
C...     DP/DT = (BRC - DRC)*(BRC - DRC)/(2*FC)
C...
C...           - FC*((BRC - DRC)/(2*FC))**2
C...
C...           = (BRC - DRC)**2/(4*FC) = FC*(PM/2)**2
C...
C...  WHICH CAN BE CONFIRMED BY THE PLOT OF DP/DT VS T, FIGURE 3, FOR
C...  SPECIFIC VALUES OF BRC, DRC AND FC.
C...
C...  TO ESTIMATE TOTAL DEATHS FROM FOOD SCARCITY, FD, THE FOOD-RELATED
C...  DEATH RATE CAN BE INTEGRATED OVER TIME ACCORDING TO THE DIFFER-
C...  ENTIAL EQUATION
C...
C...     DFD/DT = FC*P**2                                            (7)
C...
C...  WITH THE INITIAL CONDITION
C...
C...     FD = FC*P(T0)**2 (T0 = 1975)                                (8)
C...
C...  EQUATION (8) NEGLECTS ALL DEATHS FROM FAMINE PRIOR TO 1975 SO THAT
C...  THE VALUE OF FD COMPUTED FROM THE NUMERICAL INTEGRATION OF EQUA-
C...  TION (7) GIVES CUMULATIVE FOOD-RELATED DEATHS FROM 1975 ON INTO
C...  THE FUTURE.
C...
C...  THE PRECEDING EQUATIONS REFLECT THE BALANCE BETWEEN INCREASING
C...  POPULATION FROM BIRTHS AND DECREASING POPULATION FROM NORMAL
C...  DEATHS, AND WHEN POPULATION EXCEEDS THE EARTH*S CARRYING CAPACITY,
C...  DEATHS FROM FOOD SCARCITY.  CLEARLY THE GROWTH OF THE WORLD*S
C...  POPULATION IS A CRITICAL ISSUE.  THIS GROWTH WILL EITHER BE
C...  BROUGHT UNDER CONTROL VOLUNTARILY AND IN AN ORDERLY MANNER, OR
C...  CONTROL WILL BE IMPOSED EITHER BY NATURE, OR BY MAN, OR BY BOTH,
C...  WITH GREAT SUFFERING.
C...
C...  SOME ENCOURAGING DATA HAVE BEEN REPORTED RECENTLY, FOR EXAMPLE
C...  IN REFERENCES (1) TO (3) CITED PREVIOUSLY, INDICATING THAT THE
C...  WORLDWIDE BIRTH RATE IS BEGINNING TO DROP.  MATHEMATICALLY, THE
C...  DIFFERENCE BRC - DRC (= GRC) IN EQUATION (5) IS BEGINNING TO
C...  DECLINE, PERHAPS FOR THE FIRST TIME SINCE THE DAWN OF HISTORY,
C...  A TRULY HISTORIC EVENT.  THIS DECLINE CAN EASILY BE TAKEN INTO
C...  ACCOUNT IF EQUATION (5) IS INTEGRATED NUMERICALLY THROUGH TIME
C...  RATHER THAN INTEGRATED ANALYTICALLY AS TYPIFIED BY EQUATION (6).
C...  SUCH A NUMERICAL INTEGRATION OF EQUATION (5) IS PROGRAMMED IN
C...  SUBROUTINE DERV IN SUCH A WAY THAT THE USER CAN SPECIFY A POSTU-
C...  LATED REDUCTION IN THE GROWTH RATE COEFFICIENT, GRC, WITH TIME.
C...  THIS PROGRAMMED REDUCTION IS COMPLETELY GENERAL, AND CAN BE GIVEN
C...  ANY SPECIFIC FORM OVER TIME MERELY BY DEFINING A SET OF NUMERICAL
C...  VALUES IN A TABLE.
C...
C...  IN SUMMARY, THE PROGRAM GENERATES OUTPUT BASED ON THE SOLUTION OF
C...  EQUATIONS (1) TO (7) WHICH DEMONSTRATES THE POSSIBLE EFFECTS OF A
C...  REDUCED WORLDWIDE BIRTH RATE AND INCREASED FOOD-RELATED DEATH
C...  RATE.
C...
C...  ADDITIONAL VARIABLES USED IN THIS PROGRAM ARE DEFINED BELOW
C...
C...     GRC    PER CAPITA GROWTH RATE COEFFICIENT = BRC - DRC (PERSONS
C...            /PERSON/YEAR)
C...
C...     GRCT   TABLE WHICH DEFINES NUMERICALLY GRC VS TIME IN SUB-
C...            ROUTINE DERV
C...
C...     IP     INDEX (COUNTER, SUBSCRIPT) FOR PLOTTED POINTS OF THE
C...            NUMERICAL SOLUTION USED IN SUBROUTINE PRINT
C...
C...     IPLOT  INTEGER CONTROL VARIABLE FOR PLOTTING WITH ONE OF THE
C...            FOLLOWING VALUES
C...
C...            1 - ONLY PLOTS OF THE INDIVIDUAL RUNS OF THE MODEL (I.E.
C...                FIGURES 1 TO 8)
C...
C...            2 - 1 PLUS COMPOSITE PLOTS FOR TWO RUNS OF THE MODEL
C...                WITH AND WITHOUT BIRTH CONTROL (I.E., FIGURES 1 TO 8
C...                PLUS FIGURES 9 TO 14 AS COMPOSITE PLOTS)
C...
C...            3 - 2 WITH THE DIFFERENCE BETWEEN THE SOLUTIONS IN THE
C...                COMPOSITE PLOTS (I.E., FIGURES 1 TO 14 WITH DIFFER-
C...                ENCES ALSO INCLUDED IN FIGURES 9 TO 14)
C...
C...  THE OUTPUT OF THIS PROGRAM IS BASICALLY GRAPHICAL, AND THE PARTI-
C...  CULAR PLOTS GENERATED ARE DETERMINED BY CONTROL VARIABLE IPLOT
C...  DESCRIBED ABOVE.  TABULAR NUMERICAL OUTPUT OF THE SOLUTION CAN
C...  ALSO BE GENERATED BY ADDING PRINT STATEMENTS TO SUBROUTINE PRINT.
C...  A SUMMARY OF THE AVAILABLE PLOTS IS GIVEN BELOW
C...
C...     FIGURE 1  - WORLD POPULATION (PEOPLE) VS TIME (CALENDAR YEAR)
C...
C...     FIGURE 2  - RELATIVE ERROR IN THE NUMERICAL SOLUTION OF EQUA-
C...                 (5) DETERMINED FROM THE ANALYTICAL SOLUTION, EQUA-
C...                 TION (6), VS TIME
C...
C...     FIGURE 3  - DERIVATIVE, DP/DT, FROM EQUATION (5) (PEOPLE/YEAR)
C...                 VS TIME
C...
C...     FIGURE 4  - FOOD-RELATED DEATH RATE, FC*P**2, (DEATHS/YEAR) VS
C...                 TIME
C...
C...     FIGURE 5  - RATIO OF FOOD-RELATED DEATH RATE, FC*P**2, TO
C...                 NORMAL DEATH RATE, DRC*P, VS TIME
C...
C...     FIGURE 6  - TOTAL FOOD-RELATED DEATHS, TIME INTEGRAL OF FC*
C...                 P**2, (DEATHS) VS TIME
C...
C...     FIGURE 7  - RATIO OF TOTAL FOOD-RELATED DEATHS, TIME INTEGRAL
C...                 OF FC*P**2, TO TOTAL POPULATION, TIME INTEGRAL OF
C...                 DP/DT, VS TIME
C...
C...     FIGURE 8 -  PER CAPITA WORLDWIDE POPULATION GROWTH RATE, GRC =
C...                 BRC - DRC, (PERSONS/PERSON/YEAR) (REDUCED AS A
C...                 FUNCTION OF TIME AS A CONSEQUENCE OF A WORLDWIDE
C...                 REDUCED BIRTH RATE)
C...
C...     FIGURE 9  - SAME AS FIGURE 1 WITH AND WITHOUT REDUCED BIRTH
C...                 RATE, AND POSSIBLY THE DIFFERENCE (IF IPLOT = 3)
C...
C...     FIGURE 10 - SAME AS FIGURE 3 WITH AND WITHOUT REDUCED BIRTH
C...                 RATE
C...
C...     FIGURE 11 - SAME AS FIGURE 4 WITH AND WITHOUT REDUCED BIRTH
C...                 RATE
C...
C...     FIGURE 12 - SAME AS FIGURE 5 WITH AND WITHOUT REDUCED BIRTH
C...                 RATE
C...
C...     FIGURE 13 - SAME AS FIGURE 6 WITH AND WITHOUT REDUCED BIRTH
C...                 RATE
C...
C...     FIGURE 14 - SAME AS FIGURE 7 WITH AND WITHOUT REDUCED BIRTH
C...                 RATE
C...
C...     FIGURE 15 - SAME AS FIGURE 8 WITH AND WITHOUT REDUCED BIRTH
C...                 RATE
C...
C...  COMMON CARD WHICH LINKS SUBROUTINES INITAL AND INTEG SO THAT THE
C...  INITIAL CONDITION FOR THE MODEL DIFFERENTIAL EQUATION SET IN
C...  INITAL CAN BE USED TO START THE NUMERICAL INTEGRATION IN INTEG
      COMMON/T/TIME,NFIN,NORUN/Y/P,FD/F/DPDT,DFDDT
C...
C...  THE MODEL PARAMETERS ARE PUT IN COMMON SO THAT THEY CAN BE USED
C...  IN SUBROUTINES DERV AND PRINT
      COMMON/PARM/BRC,DRC,GRC,FC,PM,P0,T0,IPLOT
C...
C...  SET THE MODEL PARAMETERS
      BRC=0.030
      DRC=0.013
      GRC=BRC-DRC
      FC=DRC/8.0E+09
      PM=(BRC-DRC)/FC
      P0=4.0E+09
      T0=1975.
      IPLOT=2
C...
C...  SET INITIAL CONDITIONS (4) AND (8)
      P=P0
      FD=FC*P0**2
C...
C...  CALL SUBROUTINE DERV TO INITIALIZE THE DERIVATIVES DP/DT AND
C...  DFD/DT (I.E., DPDT AND DFDDT IN COMMON/F/) FOR PRINTING AND PLOT-
C...  TING IN SUBROUTINE PRINT
      CALL DERV
      RETURN
      END
      SUBROUTINE DERV
C...
C...  SUBROUTINE DERV SETS THE DERIVATIVES OF EQUATIONS (5) AND (7)
C...
C...  COMMON CARD WHICH LINKS THE DERIVATIVE VECTOR COMPUTED BY SUBROU-
C...  TINE DERV WITH THE SOLUTION VECTOR COMPUTED BY SUBROUTINE INTEG
      COMMON/T/TIME,NFIN,NORUN/Y/P,FD/F/DPDT,DFDDT
      COMMON/PARM/BRC,DRC,GRC,FC,PM,P0,T0,IPLOT
C...
C...  SET THE ELEMENTS IN TABLE GRCT WHICH DEFINE THE VARIATION IN THE
C...  WORLD PER CAPITA GROWTH RATE COEFFICIENT, GRC, WITH TIME (NOTE
C...  THAT THE ELEMENTS IN THE TABLE CAN BE NEGATIVE REFLECTING A
C...  NEGATIVE GROWTH RATE OR DECLINING POPULATION).  THE DATA SET BELOW
C...  IN TABLE GRCT CORRESPONDS TO THE TABULAR VALUES
C...
C...               TIME      GRC
C...               1975      1.7
C...               1980      1.6
C...               1985      1.5
C...               1990      1.4
C...               1995      1.3
C...               2000      1.2
C...               2005      1.1
C...               2010      1.0
C...               2015      0.9
C...               2020      0.8
C...               2025      0.7
C...
C...  HOWEVER, ANY OTHER POSTULATED VARIATION OF GRC WITH TIME CAN BE
C...  PROGRAMMED BY CHANGING THE NUMERICAL VALUES OF GRC IN TABLE GRCT,
C...  E.G., THE DATA REPORTED BY KEYFITZ IN PREVIOUSLY CITED REFERENCE
C...  (3) CAN BE USED.
      DIMENSION GRCT(11)
      DATA GRCT/ 1.7, 1.6, 1.5, 1.4, 1.3, 1.2, 1.1, 1.0, 0.9, 0.8, 0.7/
C...
C...  SET THE WORLD PER CAPITA POPULATION GROWTH RATE COEFFICIENT, GRC
C...
C...  CASE 1 - POPULATION GROWTH RATE IS CONSTANT WITH TIME
C...     FOR THE FIRST RUN (NORUN = 1), THE GROWTH RATE COEFFICIENT,
C...     GRC, IS CONSTANT, AND EQUALS THE DIFFERENCE BETWEEN THE BIRTH
C...     RATE COEFFICIENT, BRC, AND THE DEATH RATE COEFFICIENT, DRC,
C...     (AS SET IN SUBROUTINE INITAL), I.E., NO REDUCTION IN THE GROWTH
C...     RATE WITH TIME OCCURS, OR IN OTHER WORDS, NO EFFECTIVE WORLD-
C...     WIDE BIRTH CONTROL PROGRAMS DEVELOPES WITH TIME
         IF(NORUN.EQ.1)GO TO 1
C...
C...  CASE 2 - POPULATION GROWTH RATE DECLINES WITH TIME
C...     FOR THE SECOND RUN (NORUN = 2), THE EFFECT OF A REDUCED RATE OF
C...     GROWTH OF THE WORLD*S POPULATION WITH TIME IS PROGRAMMED.
C...     SPECIFICALLY, A POSTULATED REDUCTION IN THE GROWTH RATE COEFFI-
C...     CIENT, GRC, IS DEFINED IN TABLE GRCT ABOVE, THAN COMPUTED AS A
C...     FUNCTION OF TIME THROUGH THE USE OF THE TABLE LOOK-UP FUNCTION
C...     TABLE.  TIME RUNS FROM T0 (= 1975) TO T0 + 50 (= 2025) IN
C...     INCREMENTS OF FIVE YEARS.  THE VARIATION OF GRC WITH TIME IS
C...     PLOTTED IN FIGURE 8
         IF(NORUN.EQ.2)GRC=TABLE(GRCT,TIME,T0,T0+50.,5.)/100.
C...
C...  EQUATION (5)
1     DPDT=GRC*P-FC*P**2
C...
C...  EQUATION (7)
      DFDDT=FC*P**2
      RETURN
      END
      SUBROUTINE PRINT(NI,NO)
C...
C...  SUBROUTINE PRINT PRINTS AND PLOTS THE NUMERICAL AND ANALYTICAL
C...  SOLUTION OF EQUATIONS (5) AND (7)
C...
      COMMON/T/TIME,NFIN,NORUN/Y/P,FD/F/DPDT,DFDDT
      COMMON/PARM/BRC,DRC,GRC,FC,PM,P0,T0,IPLOT
      DATA IP/0/
C...
C...  DIMENSION THE ARRAYS WHICH STORE FOR SUBSEQUENT PLOTTING THE
C...  NUMERICAL SOLUTIONS FROM INDIVIDUAL RUNS OF THE MODEL
      DIMENSION
     1  P1(101), P2(101), P3(101), P4(101), P5(101), P6(101), P7(101),
     2  P8(101), TP(101)
C...
C...  DIMENSION THE ARRAYS WHICH STORE THE NUMERICAL SOLUTIONS FOR THE
C...  COMPOSITE PLOTS WITH AND WITHOUT BIRTH CONTROL.  THE FOLLOWING
C...  DIMENSION STATEMENTS ARE AN INEFFICIENT (WASTEFUL) USE OF STORAGE.
C...  UNFORTUNATELY, SUBROUTINE PLOTS CALLED BELOW USES THE ARRAYS AS
C...  INPUTS AND IT WILL NOT PLOT CORRECTLY UNLESS THE DECLARED DIMEN-
C...  SIONS OF THE ARRAYS BELOW MATCH EXACTLY THE NUMBER OF DEPENDENT
C...  VARIABLES PER PLOT AND THE NUMBER OF POINTS PER DEPENDENT VARIABLE
C...  SPECIFIED IN CALLING PLOTS I.E., THE TWO DIMENSIONS OF THE ARRAYS
C...  DEFINED BELOW MUST CORRESPOND RESPECTIVELY TO THE FIRST TWO ARGU-
C...  MENTS OF PLOTS
      DIMENSION
     1 P21(2,101), P23(2,101), P24(2,101), P25(2,101), P26(2,101),
     2 P27(2,101), P28(2,101)
      DIMENSION
     1 P31(3,101), P33(3,101), P34(3,101), P35(3,101), P36(3,101),
     2 P37(3,101), P38(3,101)
C...
C...  STORE THE NUMERICAL SOLUTION FOR PLOTTING (NOTE - THE SOLUTION
C...  CAN ALSO BE PRINTED IN TABULAR NUMERICAL FORM BY INSERTING WRITE
C...  STATEMENTS AT THIS POINT)
      IP=IP+1
C...
C...     STORE THE NUMERICAL SOLUTION FOR THE INDIVIDUAL RUNS OF THE
C...     MODEL
         P1(IP)=P
         P2(IP)=(P-PE(P0,PM,BRC,DRC,T0,TIME))/P
         P3(IP)=DPDT
         P4(IP)=FC*P**2
         P5(IP)=FC*P/DRC
         P6(IP)=FD
         P7(IP)=FD/P
         P8(IP)=GRC
         TP(IP)=TIME
C...
C...     STORE THE NUMERICAL SOLUTION FOR THE COMPOSITE PLOTS WITH AND
C...     WITHOUT BIRTH CONTROL
         IF(IPLOT.EQ.1)GO TO 100
         P21(NORUN,IP)=P1(IP)
         P23(NORUN,IP)=P3(IP)
         P24(NORUN,IP)=P4(IP)
         P25(NORUN,IP)=P5(IP)
         P26(NORUN,IP)=P6(IP)
         P27(NORUN,IP)=P7(IP)
         P28(NORUN,IP)=P8(IP)
         IF(IPLOT.EQ.2)GO TO 100
         P31(NORUN,IP)=P1(IP)
         P33(NORUN,IP)=P3(IP)
         P34(NORUN,IP)=P4(IP)
         P35(NORUN,IP)=P5(IP)
         P36(NORUN,IP)=P6(IP)
         P37(NORUN,IP)=P7(IP)
         P38(NORUN,IP)=P8(IP)
C...
C...     STORE THE DIFFERENCE IN THE NUMERICAL SOLUTIONS WITH AND
C...     WITHOUT BIRTH CONTROL
         IF(NORUN.NE.2)GO TO 100
         P31(3,IP)=P31(1,IP)-P31(2,IP)
         P33(3,IP)=P33(1,IP)-P33(2,IP)
         P34(3,IP)=P34(1,IP)-P34(2,IP)
         P35(3,IP)=P35(1,IP)-P35(2,IP)
         P36(3,IP)=P36(1,IP)-P36(2,IP)
         P37(3,IP)=P37(1,IP)-P37(2,IP)
         P38(3,IP)=P38(1,IP)-P38(2,IP)
C...
C...  PLOT THE NUMERICAL SOLUTION
100   IF(IP.LT.101)RETURN
      CALL PLOTS(1,IP,TP,P1)
      WRITE(NO,1)PM
1     FORMAT(//,16X,12H FIGURE 1 - ,
     1 58HPOPULATION (PEOPLE) VS TIME (YEAR)                        , /,
     2 27X,45H MAXIMUM POPULATION WITHOUT REDUCED BIRTHS = ,E10.3   ,  )
      CALL PLOTS(1,IP,TP,P2)
      WRITE(NO,2)
2     FORMAT(//,16X,12H FIGURE 2 - ,
     1 58HRELATIVE ERROR IN NUMERICAL SOLUTION VS TIME              , /,
     2 28X,54HNOTE - THE ANALYTICAL SOLUTION, EQUATION (6), APPLIES , /,
     3 28X,54HONLY FOR BRC CONSTANT (I.E., NO REDUCED BIRTH RATE)   ,  )
      CALL PLOTS(1,IP,TP,P3)
      WRITE(NO,3)
3     FORMAT(//,16X,12H FIGURE 3 - ,
     1 58HDERIVATIVE DP/DT (PEOPLE/YEAR) VS TIME (YEAR)             ,  )
      CALL PLOTS(1,IP,TP,P4)
      WRITE(NO,4)
4     FORMAT(//,16X,12H FIGURE 4 - ,
     1 58HFOOD-RELATED DEATH RATE (DEATHS/YEAR) VS TIME             ,  )
      CALL PLOTS(1,IP,TP,P5)
      WRITE(NO,5)
5     FORMAT(//,16X,12H FIGURE 5 - ,
     1 58HFOOD-RELATED DEATH RATE/NORMAL DEATH RATE VS TIME         ,  )
      CALL PLOTS(1,IP,TP,P6)
      WRITE(NO,6)
6     FORMAT(//,16X,12H FIGURE 6 - ,
     1 58HTOTAL FOOD-RELATED DEATHS (DEATHS) VS TIME                ,  )
      CALL PLOTS(1,IP,TP,P7)
      WRITE(NO,7)
7     FORMAT(//,16X,12H FIGURE 7 - ,
     1 58HTOTAL FOOD-RELATED DEATHS/TOTAL POPULATION VS TIME        ,  )
C...
C...  PLOT THE EFFECT OF A WORLDWIDE REDUCED BIRTH RATE
      IF(NORUN.EQ.1)GO TO 101
      CALL PLOTS(1,IP,TP,P8)
      WRITE(NO,8)
8     FORMAT(//,16X,12H FIGURE 8 - ,
     1 58HNORMAL BIRTH RATE - NORMAL DEATH RATE (PEOPLE/PERSON/YEAR),  ,
     2 8H VS TIME)
C...
C...  PLOT THE NUMERICAL SOLUTIONS WITH AND WITHOUT BIRTH CONTROL (IPLOT
C...  = 2 OR 3), AND THE DIFFERENCE BETWEEN THE TWO CASES (IPLOT = 3)
      IF(IPLOT.EQ.1)GO TO 101
      IF(IPLOT.EQ.2)CALL PLOTS(IPLOT,IP,TP,P21)
      IF(IPLOT.EQ.3)CALL PLOTS(IPLOT,IP,TP,P31)
      WRITE(NO,9)
9     FORMAT(//,16X,12H FIGURE 9 - ,
     1 58HPOPULATION (PEOPLE) VS TIME (YEAR)                        ,  )
      IF(IPLOT.EQ.2)WRITE(NO,16)
      IF(IPLOT.EQ.3)WRITE(NO,17)
      IF(IPLOT.EQ.2)CALL PLOTS(IPLOT,IP,TP,P23)
      IF(IPLOT.EQ.3)CALL PLOTS(IPLOT,IP,TP,P33)
      WRITE(NO,10)
10    FORMAT(//,16X,13H FIGURE 10 - ,
     1 58HDERIVATIVE DP/DT (PEOPLE/YEAR) VS TIME (YEAR)             ,  )
      IF(IPLOT.EQ.2)WRITE(NO,16)
      IF(IPLOT.EQ.3)WRITE(NO,17)
      IF(IPLOT.EQ.2)CALL PLOTS(IPLOT,IP,TP,P24)
      IF(IPLOT.EQ.3)CALL PLOTS(IPLOT,IP,TP,P34)
      WRITE(NO,11)
11    FORMAT(//,16X,13H FIGURE 11 - ,
     1 58HFOOD-RELATED DEATH RATE (DEATHS/YEAR) VS TIME             ,  )
      IF(IPLOT.EQ.2)WRITE(NO,16)
      IF(IPLOT.EQ.3)WRITE(NO,17)
      IF(IPLOT.EQ.2)CALL PLOTS(IPLOT,IP,TP,P25)
      IF(IPLOT.EQ.3)CALL PLOTS(IPLOT,IP,TP,P35)
      WRITE(NO,12)
12    FORMAT(//,16X,13H FIGURE 12 - ,
     1 58HFOOD-RELATED DEATH RATE/NORMAL DEATH RATE VS TIME         ,  )
      IF(IPLOT.EQ.2)WRITE(NO,16)
      IF(IPLOT.EQ.3)WRITE(NO,17)
      IF(IPLOT.EQ.2)CALL PLOTS(IPLOT,IP,TP,P26)
      IF(IPLOT.EQ.3)CALL PLOTS(IPLOT,IP,TP,P36)
      WRITE(NO,13)
13    FORMAT(//,16X,13H FIGURE 13 - ,
     1 58HTOTAL FOOD-RELATED DEATHS (DEATHS) VS TIME                ,  )
      IF(IPLOT.EQ.2)WRITE(NO,16)
      IF(IPLOT.EQ.3)WRITE(NO,17)
      IF(IPLOT.EQ.2)CALL PLOTS(IPLOT,IP,TP,P27)
      IF(IPLOT.EQ.3)CALL PLOTS(IPLOT,IP,TP,P37)
      WRITE(NO,14)
14    FORMAT(//,16X,13H FIGURE 14 - ,
     1 58HTOTAL FOOD-RELATED DEATHS/TOTAL POPULATION VS TIME        ,  )
      IF(IPLOT.EQ.2)WRITE(NO,16)
      IF(IPLOT.EQ.3)WRITE(NO,17)
      IF(IPLOT.EQ.2)CALL PLOTS(IPLOT,IP,TP,P28)
      IF(IPLOT.EQ.3)CALL PLOTS(IPLOT,IP,TP,P38)
      WRITE(NO,15)
15    FORMAT(//,16X,13H FIGURE 15 - ,
     1 58HNORMAL BIRTH RATE - NORMAL DEATH RATE (PEOPLE/PERSON/YEAR),  ,
     2 8H VS TIME)
      IF(IPLOT.EQ.2)WRITE(NO,16)
      IF(IPLOT.EQ.3)WRITE(NO,17)
16    FORMAT(29X,48H1 - NO REDUCED BIRTHS   2 - REDUCED BIRTHS      ,  )
17    FORMAT(17X,48H1 - NO REDUCED BIRTHS   2 - REDUCED BIRTHS   3 -,  ,
     2 58H DIFFERENCE (1 - 2)                                       ,  )
101   IP=0
      RETURN
      END
      FUNCTION PE(P0,PM,BRC,DRC,T0,T)
C...
C...  FUNCTION PE COMPUTES THE ANALYTICAL SOLUTION TO EQUATIONS (4)
C...  AND (5) I.E., EQUATION (6)
C...
      PE=P0*PM/(P0+(PM-P0)*EXP(-(BRC-DRC)*(T-T0)))
      RETURN
      END
      FUNCTION TABLE(YT,X,XS,XL,XI)
C...
C...  FUNCTION TABLE PERFORMS A LINEAR INTERPOLATION WITHIN A ONE-
C...  DIMENSIONAL TABLE
C...
C...  ARGUMENTS
C...
C...     YT  ARRAY OF TABULAR DEPENDENT VARAIBLE VALUES IN WHICH AN
C..          INTERPOLATION IS PERFORMED (INPUT)
C...
C...     X   VALUE OF THE INDEPENDENT VARIABLE FOR WHICH AN INTERPOLA-
C...         TION IS PERFORMED IN TABLE YT (INPUT)
C...
C...     XS  SMALLEST VALUE OF THE INDEPENDENT VARIABLE CORRESPONDING TO
C...         YT(1) (INPUT)
C...
C...     XL  LARGEST VALUE OF THE INDEPENDENT VARIABLE CORRESPONDING TO
C...         THE LAST ELEMENT IN YT (INPUT)
C...
C...     XI  INCREMENT IN THE INDEPENDENT VARIABLE ASSUMED CONSTANT FROM
C...         XS TO XL (INPUT)
C...
      DIMENSION YT(1)
C...
C...  IF X IS OUTSIDE THE RANGE XS LE X LE XL, USE ONE OF THE TERMINAL
C...  VALUES OF YT
      IF(X.GT.XS)GO TO 1
      TABLE=YT(1)
      GO TO 3
1     IF(X.LT.XL)GO TO 2
C...
C...  COMPUTE THE NUMBER OF DATA IN THE TABLE YT TO REFERENCE THE LAST
C...  VALUE
      ND=INT((XL-XS)/XI+0.5)+1
      TABLE=YT(ND)
      GO TO 3
C...
C...  COMPUTE TABLE POSITION INDEX I CORRESPONDING TO THE POINT X AND
C...  THE BASE POINT, XB, FOR THE INTERPOLATION
2     I=INT((X-XS)/XI)
      XB=FLOAT(I)*XI+XS
C...
C...  PERFORM THE LINEAR INTERPOLATION BETWEEN THE POINTS XB = I*XI +
C...  XS AND XB + XI = (I+1)*XI + XS.  FIRST INCREMENT I BY 1 TO GENER-
C...  ATE A VALID SUBSCRIPT FOR ARRAY YT
      I=I+1
      TABLE=YT(I)+(X-XB)/XI*(YT(I+1)-YT(I))
3     RETURN
      END
FC = DRC/8.0E+09, NO REDUCED BIRTH RATE
1975.     2025.     0.5
    2  100    2    1  REL 0.001
FC = DRC/8.0E+09, REDUCED BIRTH RATE
1975.     2025.     0.5
    2  100    2    1  REL 0.001
END OF RUNS
*APP MATH31
      SUBROUTINE INITAL
C...
C...  A DIFFERENTIAL FORM OF THE HENON 'STRANGE ATTRACTOR' EQUATIONS
C...
C...  THE FOLLOWING FIRST ORDER, NONLINEAR DIFFERENCE EQUATIONS,
C...  REPORTED BY HENON, ARE DESCRIBED BY STRANG (1) AND GREBOGI ET
C...  AL (2):
C...
C...      N+1    N           N 2
C...     U    = U  - (7/5)*(U )  + 1                            (1)
C...      1      2           1
C...
C...      N+1           N
C...     U    = (3/10)*U                                        (2)
C...      2             1
C...
C...     (1)  STRANG, G., INTRODUCTION TO APPLIED MATHEMATICS,
C...          WELLESLEY-CAMBRIDGE PRESS, WELLESLEY, MA, PP. 504-
C...          505, 1986.
C...
C...     (2)  GREBOGI, C., E. OTT AND J. A. YORKE, CHAOS, STRANGE
C...          ATTRACTORS, AND FRACTAL BASIN BOUNDARIES IN NONLINEAR
C...          DYNAMICS, SCIENCE, V238, 30OCT87, PP 632-638
C...
C...  THE SOLUTION TO EQUATIONS (1) AND (2), PLOTTED AS A PHASE PLANE
C...  (U1 VS U2) EXHIBITS THE INTERESTING PROPERTIES OF  HENON'S
C...  'STRANGE ATTRACTOR' (E.G., CONVERGENCE TO A COMMON POINT WITH
C...  INFINITELY FINE DETAIL).
C...
C...  IF EQUATIONS (1) AND (2) ARE REWRITTEN AS:
C...
C...      N+1    N    N           N 2        N
C...     U    - U  = U  - (7/5)*(U )  + 1 - U                   (3)
C...      1      1    2           1          1
C...     ---------
C...     (N+1) - N
C...
C...
C...      N+1    N           N    N
C...     U    - U  = (3/10)*U  - U                              (4)
C...      2      2           1    2
C...     ---------
C...     (N+1) - N
C...
C...  SINCE N IS A DISCRETE VARIABLE WITH SUCCESSIVE VALUES DIFFERING
C...  BY ONE, THE LEFT HAND SIDES OF EQUATIONS (3) AND (4) CAN BE CON-
C...  SIDERED DISCRETE (E.G., FINITE DIFFERENCE) APPROXIMATIONS OF THE
C...  DERIVATIVES DU /DT AND DU /DT.  THIS SUGGESTS TWO DIFFERENTIAL
C...                1          2
C...  EQUATIONS:
C...
C...                          2
C...     DU /DT = U  - (7/5)*U  + 1 - U                         (5)
C...       1       2          1        1
C...
C...     DU /DT = (3/10)*U  - U                                 (6)
C...       2              1    2
C...
C...  THE FOLLOWING CODING NUMERICALLY INTEGRATES EQUATIONS (5) AND
C...  (6) FOR A SERIES OF INITIAL CONDITIONS, AS EXPLAINED IN THE
C...  COMMENTS.  THE SOLUTION IS PLOTTED AS A PHASE PLANE (U2 VS U1)
C...  AND THE DERIVATIVES ARE ALSO PLOTTED IN THE SAME FORMAT (DU /DT
C...  VS DU /DT).                                                2
C...       1
C...
C...  THE SOLUTION HAS THE FOLLOWING PROPERTIES:
C...
C...  (1)  ALL OF THE SOLUTION CURVES (FOR 25 INITIAL CONDITIONS)
C...       CONVERGE TO THE SAME POINT, U1 = 0.63135, U2 = 0.18941,
C...       WHICH APPEARS TO CORRESPOND TO STRANG'S FIGURE 6.14.
C...       THIS IS AN EQUILIBRIUM POINT FOR EQUATIONS (5) AND (6),
C...       I.E., DU /DT = DU /DT = 0.
C...               1        2
C...
C...  (2)  THE SOLUTION HAS THE 'NEVER ENDING NESTING OF DETAIL'
C...       DESCRIBED BY STRANG SINCE EACH SMALLER SECTION OF THE
C...       PHASE PLANE IN THE NEIGHBORHOOD OF THE EQUILIBRIUM POINT
C...       WILL HAVE THE SAME NUMBER OF SOLUTION CURVES (25 IN THIS
C...       CASE) CONVERGING TO THE EQUILIBRIUM POINT.
C...
C...  (3)  THE EQUILIBRIUM SOLUTION TO THE DIFFERENTIAL EQUATIONS
C...       IS ALSO THE EQUILIBRIUM SOLUTION TO THE HENON DIFFERNCE
C...       EQUATIONS (TO WITHIN THE ACCURACY OF THE NUMERICAL INTE-
C...       GRATION).
C...
C...  THESE RESULTS SUGGEST THAT SIMILAR RESULTS CAN BE PRODUCED FOR
C...  ANY DIFFERENTIAL EQUATIONS WITH AN EQUILIBRIUM POINT TO WHICH
C...  ALL SOLUTION CURVES CONVERGE FROM A GIVEN SET OF INITIAL CONDI-
C...  TIONS.
C...
C...  TO EXPLORE THIS POINT FURTHER USING THE PRESENT SYSTEM OF EQUA-
C...  TIONS (5) AND (6), IF THE DERIVATIVES ARE SET TO ZERO, THE
C...  RESULTING SYSTEM OF TWO NONLINEAR ALGEBRAIC EQUATIONS CAN EASILY
C...  BE SOLVED FOR U1 AND U2:
C...
C...                      2
C...     0 = U2 - (7/5)*U1  + 1 - U1                            (7)
C...
C...     0 = (3/10)*U1 - U2                                     (8)
C...
C...  SOLVING EQUATION (8) FOR U2 AND SUBSTITUTING IN EQUATION (7)
C...  GIVES A QUADRATIC EQUATION IN U1
C...
C...                             2
C...     0 = (3/10)*U1 - (7/5)*U1  + 1 - U1
C...
C...  WHICH HAS THE ROOTS U1 = 0.63135446 AND -1.1313545.  THE CORRES-
C...  VALUES OF U2 FROM EQUATION (8) ARE U2 = 0.18940634 AND -0.33940
C...  635.
C...
C...  AS THE OUTPUT FROM THE FOLLOWING PROGRAM INDICATES, FOR THE 25
C...  INITIAL CONDITIONS, ALL OF THE SOLUTIONS CONVERGE TO THE POINT
C...  U1 = 0.63135446, U2 =0.18940634.  HOWEVER, WHEN THESE INITIAL
C...  CONDITIONS ARE EXTENDED CLOSER TO THE POINT U1 = -1.1313545,
C...  U2 = -0.33940635, THE NUMERICAL SOLUTION IMMEDIATELY BECOMES
C...  UNSTABLE.  (NUMERICAL OUTPUT COULD NOT BE COMPUTED FOR THE FIRST
C...  TIME STEP BEYOND THE INITIAL CONDITION U1(0) = -2, U2(0) = -0.4.
C...  THIS CASE CAN EASILY BE PROGRAMMED BELOW BY LETTING -2 LE U1(0)
C...  LE 2 IN INCREMENTS OF 1 AND -0.4 LE U2(0) LE 0.4 IN INCREMENTS
C...  OF 0.2).
C...
C...  THIS INSTABILITY CAN BE INVESTIGATED IN THE FOLLOWING WAY.  THE
C...  JACOBIAN MATRIX OF EQUATIONS (5) AND (6) IS:
C...
C...         ..        ..
C...         . A11  A12 .
C...     J = .          .
C...         . A21  A22 .
C...         ..        ..
C...
C...  WHERE
C...
C...     A11 = - 1 - 2*(7/5)*U1, A12 = 1, A21 = 3/10, A22 = -1
C...
C...  THE EIGENVALUE PROBLEM FOR J IS:
C...
C...         ..                ..
C...         . A11 - E    A12   .
C...      DET.                  . = 0
C...         .   A21    A22 - E .
C...         ..                ..
C...
C...  OR
C...
C...     E**2 - (A11 + A12)*E + (A11*A22 - A12*A21) = 0
C...
C...  SUBSTITUTING FOR A11 TO A22,
C...
C...     E**2 - (- 1 - 2*(7/5)*U1 + 1)*E +
C...
C...    ((- 1 - 2*(7/5)*U1)*(-1) - (1)*(-1)) = 0
C...
C...  OR
C...
C...     E**2 + A*U1*E + A*U1 = 0                               (9)
C...
C...  WHERE A = 2*(7/5).
C...
C...  IF EQUATION (9) IS FACTORED FOR THE EIGENVALUES,
C...
C...              - A*U1 + (OR -) ((A*U1**2) - 4*1*A*U1)**0.5
C...     E1, E2 = -------------------------------------------   (10)
C...                                 2*1
C...
C...  FROM EQUATION (10), WE SEE THAT IF U1 GT 0, E.G., THE PREVIOUS
C...  EQUILIBRIUM POINT U1 = 0.63135446, E1 AND E2 ARE REAL AND NEGA-
C...  TIVE.  THIS EXPLAINS WHY THE SOLUTIONS IN THE NEIGHBORHOOD OF
C...  OF U1 = 0.63135446, U2 = 0.18940634 ARE STABLE.
C...
C...  ON THE OTHER HAND, IF U1 LT 0, E.G., THE PREVIOUS EQUILIBRIUM
C...  POINT U1 = -1.1313545, E1 AND E2 ARE REAL, BUT E1 IS POSITIVE
C...  WHILE E2 IS NEGATIVE.  THEREFORE, E1 IS AN UNSTABLE EIGENVALUE
C...  WHICH EXPLAINS WHY THE SOLUTIONS IN THE NEIGHBORHOOD OF U1 =
C...  -1.1313545, U2 = -0.33940635 ARE UNSTABLE.
C...
C...  TO SUMMARIZE,
C...
C...     U1 = 0.63135446, U2 = 0.18940634
C...
C...  IS A STABLE EQUILIBRIUM POINT, WHILE
C...
C...     U1 = -1.1313545, U2 = -0.33940635
C...
C...  IS AN UNSTABLE EQUILIBRIUM POINT.
C...
C...  THE CODING FOR THE STABLE CASE FOLLOWS.
C...
C...                                                         WES
C...                                                       25OCT87
C...
      COMMON/T/      T,  NSTOP,  NORUN
     1      /Y/     U1,     U2
     2      /F/  DU1DT,  DU2DT
     3      /C/     IP
C...
C...  SET THE INITIAL CONDITIONS SO THAT -1 LE U1(0) LE 1 IN INCREMENTS
C...  OF 0.5, -0.35 LE U2(0) LE 0.25 IN INCREMENTS OF 0.15, WHICH, IN
C...  ALL COMBINATIONS, GIVES A TOTAL OF 25 INITIAL CONDITIONS.  THESE
C...  INITIAL CONDITIONS ARE PRINTED AT THE BEGINNING OF EACH RUN (T =
C...  .00 OUTPUT)
      DATA U10,U20/-1.5,-0.35/
C...
C...  RESET U1(0) TO -1.5 AT THE BEGINNING OF EVERY FIFTH RUN, AND INCRE-
C...  MENT U2(0) BY 0.15
      IF(((NORUN-6)*(NORUN-11)*(NORUN-16)*(NORUN-21)).EQ.0)THEN
         U10=-1.5
         U20=U20+0.15
      END IF
C...
C...  INCREMENT U1(0) BY 0.5
      U10=U10+0.5
C...
C...  SET THE INITIAL CONDITIONS
      U1=U10
      U2=U20
C...
C...  INITIAL DERIVATIVES
      CALL DERV
      IP=0
      RETURN
      END
      SUBROUTINE DERV
      COMMON/T/      T,  NSTOP,  NORUN
     1      /Y/     U1,     U2
     2      /F/  DU1DT,  DU2DT
     3      /C/     IP
C...
C...  DIFFERENTIAL EQUATIONS
      DU1DT=U2-(7.0/5.0)*U1**2+1.0-U1
      DU2DT=(3.0/10.0)*U1-U2
      RETURN
      END
      SUBROUTINE PRINT(NI,NO)
      COMMON/T/      T,  NSTOP,  NORUN
     1      /Y/     U1,     U2
     2      /F/  DU1DT,  DU2DT
     3      /C/     IP
C...
C...  DIMENSION THE ARRAYS FOR PLOTTING
      REAL  U1P(25,201),    U2P(25,201),
     1   DU1DTP(25,201), DU2DTP(25,201),
     2           X(201),         Y(201)
C...
C...  INITIALIZE THE VARIABLES FOR SAVING THE MINIMUM AND MAXIMUM
C...  VALUES OF U1, U2, DU1/DT AND DU2/DT
      DATA U1MIN,U1MAX,DU1MIN,DU1MAX,
     1     U2MIN,U2MAX,DU2MIN,DU2MAX
     2     /8*0.0/
C...
C...  PRINT A HEADING FOR THE SOLUTION
      IP=IP+1
      IF(IP.EQ.1)THEN
         WRITE(NO,1)
1        FORMAT(9X,'T',10X,'U1',10X,'U2',6X,'DU1/DT',6X,'DU2/DT')
      END IF
C...
C...  PRINT THE SOLUTION EVERY 20TH CALL TO SUBROUTINE PRINT
      IF(((IP-1)/20*20).EQ.(IP-1))THEN
         WRITE(NO,2)T,U1,U2,DU1DT,DU2DT
2        FORMAT(F10.2,4F12.5)
      END IF
C...
C...  STORE THE SOLUTION FOR PLOTTING AS A PHASE PLANE
      U1P(NORUN,IP)=U1
      U2P(NORUN,IP)=U2
      DU1DTP(NORUN,IP)=DU1DT
      DU2DTP(NORUN,IP)=DU2DT
C...
C...  SAVE THE MINUMUM AND MAXIMUM VALUES OF U1, U2, DU1/DT AND DU2/DT
C...  TO ASSIST IN THE SCALING OF THE PLOTS
      IF(U1.LT.U1MIN)U1MIN=U1
      IF(U1.GT.U1MAX)U1MAX=U1
      IF(U2.LT.U2MIN)U2MIN=U2
      IF(U2.GT.U2MAX)U2MAX=U2
      IF(DU1DT.LT.DU1MIN)DU1MIN=DU1DT
      IF(DU1DT.GT.DU1MAX)DU1MAX=DU1DT
      IF(DU2DT.LT.DU2MIN)DU2MIN=DU2DT
      IF(DU2DT.GT.DU2MAX)DU2MAX=DU2DT
C...
C...  TEST FOR THE LAST RUN WHEN THE SOLUTIONS ARE PLOTTED
      IF((IP.LT.201).OR.(NORUN.LT.25))RETURN
C...
C...  PRINT THE MIMIMUM AND MAXIMUM VALUES FOR SCALING THE PLOTS
      WRITE(NO,3) U1MIN, U1MAX, U2MIN, U2MAX,
     1           DU1MIN,DU1MAX,DU2MIN,DU2MAX
3     FORMAT(1H1,////,
     1      ' MAXIMA AND MINIMA OF U1, U2, DU1/DT AND DU2/DT',//,
     2   5X,'  U1MIN = ',F7.3,'  U1MAX = ',F7.3,/,
     3   5X,'  U2MIN = ',F7.3,'  U2MAX = ',F7.3,/,
     4   5X,' DU1MIN = ',F7.3,' DU1MAX = ',F7.3,/,
     5   5X,' DU2MIN = ',F7.3,' DU2MAX = ',F7.3)
C...
C...  PRINT AND COMPUTE THE RESIDUAL OF THE HENON DIFFERENCE EQUATIONS
C...  AT THE EQUILIBRIUM POINT FOR THE DIFFERENTIAL EQUATIONS
      U1=0.63135446
      U2=0.18940634
      R1=U1-U2+(7.0/5.0)*U1**2-1.0
      R2=U2-(3.0/10.0)*U1
      WRITE(NO,10)U1,U2,R1,R2
10    FORMAT(1H ,////,
     1      ' RESIDUALS OF THE HENON DIFFERENCE EQUATIONS',//,
     2   5X,'     U1 = ',F7.5,'     U2 = ',F7.5,/,
     3   5X,'  RES 1 = ',F7.5,'  RES 2 = ',F7.5)
C...
C...  CONTINUOUS PLOT OF U2(T) VS U1(T)
C...
C...  ****************************************************************
C...
C...  THE FOLLOWING CALLS TO A CONTINUOUS PLOTTER ARE MACHINE DEPENDENT
C...  AND MUST BE CONVERTED FOR OTHER COMPUTERS OR CHANGED TO COMMENTS
C...
C...  SCALE THE AXES
C...  CALL QIKSET(6.0,-1.5,0.5,8.0,-0.4,0.1)
C...  CALL QIKSAX(3,3)
C...
C...  FIRST CURVE
      DO 4 J=1,IP
      X(J)=U1P(1,J)
      Y(J)=U2P(1,J)
4     CONTINUE
C...  CALL QIKPLT(X,Y,IP,7H*U1(T)*,7H*U2(T)*,
C... 1 33H*DIFFERENTIAL FORM OF HENON EQNS*,1)
C...  CALL PLOT(-7.0,1.0,-3)
C...
C...  SUBSEQUENT CURVES
      DO 6 I=2,NORUN
      DO 5 J=1,IP
      X(J)=U1P(I,J)
      Y(J)=U2P(I,J)
5     CONTINUE
C...  CALL QLINE(X,Y,IP,M)
6     CONTINUE
C...
C...  CONTINUOUS PLOT OF DU2(T)/DT VS DU1(T)/DT
C...
C...  SCALE THE AXES
C...  CALL QIKSET(6.0,-2.0,0.5,8.0,-0.8,0.2)
C...  CALL QIKSAX(3,3)
C...
C...  FIRST CURVE
      DO 7 J=1,IP
      X(J)=DU1DTP(1,J)
      Y(J)=DU2DTP(1,J)
7     CONTINUE
C...  CALL QIKPLT(X,Y,IP,8H*DU1/DT*,8H*DU2/DT*,
C... 1 33H*DIFFERENTIAL FORM OF HENON EQNS*,1)
C...  CALL PLOT(-7.0,1.0,-3)
C...
C...  SUBSEQUENT CURVES
      DO 9 I=2,NORUN
      DO 8 J=1,IP
      X(J)=DU1DTP(I,J)
      Y(J)=DU2DTP(I,J)
8     CONTINUE
C...  CALL QLINE(X,Y,IP,M)
9     CONTINUE
C...
C...  ****************************************************************
C...
      RETURN
      END
DIFFERENTIAL FORM OF THE HENON EQUATIONS
0.        20.0      0.1
    2 1000    1    1  REL 0.001
REPEATS
   24
END OF RUNS
*APP MATH32
      SUBROUTINE INITAL
C...
C...  AN ANALYSIS OF THE NONLINEAR STRUCTURE OF THE HENON 'STRANGE
C...  ATTRACTOR' EQUATIONS
C...
C...  THE FOLLOWING FIRST ORDER, NONLINEAR DIFFERENCE EQUATIONS,
C...  REPORTED BY HENON, ARE DESCRIBED BY STRANG (1) AND GREBOGI ET
C...  AL (2):
C...
C...      N+1    N           N 2
C...     U    = U  - (7/5)*(U )  + 1                            (1)
C...      1      2           1
C...
C...      N+1           N
C...     U    = (3/10)*U                                        (2)
C...      2             1
C...
C...     (1)  STRANG, G., INTRODUCTION TO APPLIED MATHEMATICS,
C...          WELLESLEY-CAMBRIDGE PRESS, WELLESLEY, MA, PP. 504-
C...          505, 1986.
C...
C...     (2)  GREBOGI, C., E. OTT AND J. A. YORKE, CHAOS, STRANGE
C...          ATTRACTORS, AND FRACTAL BASIN BOUNDARIES IN NONLINEAR
C...          DYNAMICS, SCIENCE, V238, 30OCT87, PP 632-638
C...
C...  THE SOLUTION TO EQUATIONS (1) AND (2), PLOTTED AS A PHASE PLANE
C...  (U1 VS U2) EXHIBITS THE INTERESTING PROPERTIES OF  HENON'S
C...  'STRANGE ATTRACTOR' (E.G., CONVERGENCE TO A COMMON POINT WITH
C...  INFINITELY FINE DETAIL).
C...
C...  IF EQUATIONS (1) AND (2) ARE REWRITTEN AS:
C...
C...      N+1    N    N           N 2        N
C...     U    - U  = U  - (7/5)*(U )  + 1 - U                   (3)
C...      1      1    2           1          1
C...     ---------
C...     (N+1) - N
C...
C...
C...      N+1    N           N    N
C...     U    - U  = (3/10)*U  - U                              (4)
C...      2      2           1    2
C...     ---------
C...     (N+1) - N
C...
C...  SINCE N IS A DISCRETE VARIABLE WITH SUCCESSIVE VALUES DIFFERING
C...  BY ONE, THE LEFT HAND SIDES OF EQUATIONS (3) AND (4) CAN BE CON-
C...  SIDERED DISCRETE (E.G., FINITE DIFFERENCE) APPROXIMATIONS OF THE
C...  DERIVATIVES DU /DT AND DU /DT.  THIS SUGGESTS TWO DIFFERENTIAL
C...                1          2
C...  EQUATIONS:
C...
C...                          2
C...     DU /DT = U  - (7/5)*U  + 1 - U                         (5)
C...       1       2          1        1
C...
C...     DU /DT = (3/10)*U  - U                                 (6)
C...       2              1    2
C...
C...  PREVIOUS ANALYSIS OF EQUATIONS (5) AND (6) BY NUMERICAL INTEGRA-
C...  INDICATED THAT THEY HAVE TWO EQUILIBRIUM POINTS, ONE STABLE AND
C...  THE OTHER UNSTABLE (IN A DSS/2 STUDY ENTITLED 'A DIFFERENTIAL FORM
C...  OF THE HENON 'STRANGE ATTRACTOR' EQUATIONS').  THE PURPOSE OF
C...  THIS STUDY IS TO DETERMINE IF THE STABLE EQUILIBRIUM POINT IS
C...  AFFECTED SIGNIFICANTLY BY THE STRUCTURE OF EQUATIONS (5) AND (6),
C...  AND IN PARTICULAR, BY THE NONLINEAR TERM:
C...
C...                                 2
C...                         -(7/5)*U
C...                                 1
C...  OF EQUATION (5).
C...
C...  TO IMPLEMENT THIS ANALYSIS, EQUATION (5) WAS MODIFIED TO:
C...
C...                                   IN   2+IN
C...     DU /DT = U  - (7/5)*(1/0.63135  )*U     + 1 - U        (7)
C...       1       2                        1           1
C...
C...  WHERE IN HAS THE SUCCESSIVE VALUES -2, -1, 0 AND 1.  THUS, THE
C...  POWER ON U  IN THE NONLINEAR TERM HAS THE SUCCESSIVE VALUES 0,
C...            1
C...  1, 2 AND 3.
C...
C...                      IN
C...  THE FACTOR 1/0.63135   IS INCLUDED TO REDUCE EQUATION (7) TO
C...  EQUATION (5) IF U  = 0.63135, I.E., U  APPROACHES THE FINAL VALUE
C...                   1                   1
C...  OF 0.63135 AS IN THE PRECEDING STUDY.
C...
C...  THE FOLLOWING PROGRAMMING COMPUTES A NUMERICAL SOLUTION TO
C...  EQUATION (7) FOR IN = -2, -1, 0 AND 1, AND PLOTS THE SOLUTIONS
C...  FOR FOUR SETS OF INITIAL CONDITIONS (A TOTAL OF 16 RUNS).  THE
C...  INITIAL CONDITIIONS ARE:
C...
C...                U1(0)      U2(0)
C...
C...      (1)        -1       -0.35
C...
C...      (2)         1       -0.35
C...
C...      (3)        -1        0.35
C...
C...      (4)         1        0.35
C...
C...  IN ALL 16 CASES, THE SOLUTIONS CONVERGE TO THE EQUILIBRIUM POINT
C...  U1 = 0.63135446, U2 = 0.18940634, INDICATING THE POWER IN THE
C...  NONLINEAR TERM OF EQUATION (7) DOES NOT AFFECT THIS FINAL POINT
C...  OF THE SOLUTION.
C...                                                         WES
C...                                                       10OCT87
C...
      COMMON/T/      T,  NSTOP,  NORUN
     1      /Y/     U1,     U2
     2      /F/  DU1DT,  DU2DT
     3      /C/     IN,     IP
C...
C...  SET THE INCREMENT IN THE POWER OF EQUATION (5) AT THE BEGINNING
C...  OF RUNS 1, 5, 9 AND 13
      IF((NORUN-1)*(NORUN-5)*(NORUN-9)*(NORUN-13).EQ.0)THEN
      IN=-3
      END IF
C...
C...  INCREMENT THE POWER OF EQUATION (5)
      IN=IN+1
C...
C...  INITIAL CONDITIONS
      IF(NORUN.LT.5)THEN
         U1=-1.0
         U2=-0.35
      ELSE IF((NORUN.GE.5).AND.(NORUN.LT.9))THEN
         U1=1.0
         U2=-0.35
      ELSE IF((NORUN.GE.9).AND.(NORUN.LT.13))THEN
         U1=-1.0
         U2=0.35
      ELSE IF((NORUN.GE.13).AND.(NORUN.LE.17))THEN
         U1=1.0
         U2=0.35
      END IF
C...
C...  INITIAL DERIVATIVES
      CALL DERV
      IP=0
      RETURN
      END
      SUBROUTINE DERV
      COMMON/T/      T,  NSTOP,  NORUN
     1      /Y/     U1,     U2
     2      /F/  DU1DT,  DU2DT
     3      /C/     IN,     IP
C...
C...  DIFFERENTIAL EQUATIONS
      DU1DT=U2-(7.0/5.0)*(1.0/0.63135**IN)*U1**(2+IN)+1.0-U1
      DU2DT=(3.0/10.0)*U1-U2
      RETURN
      END
      SUBROUTINE PRINT(NI,NO)
      COMMON/T/      T,  NSTOP,  NORUN
     1      /Y/     U1,     U2
     2      /F/  DU1DT,  DU2DT
     3      /C/     IN,     IP
C...
C...  DIMENSION THE ARRAYS FOR PLOTTING
      REAL  U1P(16,201),    U2P(16,201),
     1   DU1DTP(16,201), DU2DTP(16,201),
     2           X(201),         Y(201)
C...
C...  INITIALIZE THE VARIABLES FOR SAVING THE MINIMUM AND MAXIMUM
C...  VALUES OF U1, U2, DU1/DT AND DU2/DT
      DATA U1MIN,U1MAX,DU1MIN,DU1MAX,
     1     U2MIN,U2MAX,DU2MIN,DU2MAX
     2     /8*0.0/
C...
C...  PRINT A HEADING FOR THE SOLUTION
      IP=IP+1
      IF(IP.EQ.1)THEN
         WRITE(NO,1)
1        FORMAT(9X,'T',10X,'U1',10X,'U2',6X,'DU1/DT',6X,'DU2/DT')
      END IF
C...
C...  PRINT THE SOLUTION EVERY 20TH CALL TO SUBROUTINE PRINT
      IF(((IP-1)/20*20).EQ.(IP-1))THEN
         WRITE(NO,2)T,U1,U2,DU1DT,DU2DT
2        FORMAT(F10.2,4F12.5)
      END IF
C...
C...  STORE THE SOLUTION FOR PLOTTING AS A PHASE PLANE
      U1P(NORUN,IP)=U1
      U2P(NORUN,IP)=U2
      DU1DTP(NORUN,IP)=DU1DT
      DU2DTP(NORUN,IP)=DU2DT
C...
C...  SAVE THE MINUMUM AND MAXIMUM VALUES OF U1, U2, DU1/DT AND DU2/DT
C...  TO ASSIST IN THE SCALING OF THE PLOTS
      IF(U1.LT.U1MIN)U1MIN=U1
      IF(U1.GT.U1MAX)U1MAX=U1
      IF(U2.LT.U2MIN)U2MIN=U2
      IF(U2.GT.U2MAX)U2MAX=U2
      IF(DU1DT.LT.DU1MIN)DU1MIN=DU1DT
      IF(DU1DT.GT.DU1MAX)DU1MAX=DU1DT
      IF(DU2DT.LT.DU2MIN)DU2MIN=DU2DT
      IF(DU2DT.GT.DU2MAX)DU2MAX=DU2DT
C...
C...  TEST FOR THE LAST RUN WHEN THE SOLUTIONS ARE PLOTTED
      IF((IP.LT.201).OR.(NORUN.LT.16))RETURN
C...
C...  PRINT THE MIMIMUM AND MAXIMUM VALUES FOR SCALING THE PLOTS
      WRITE(NO,3) U1MIN, U1MAX, U2MIN, U2MAX,
     1           DU1MIN,DU1MAX,DU2MIN,DU2MAX
3     FORMAT(1H1,////,
     1      ' MAXIMA AND MINIMA OF U1, U2, DU1/DT AND DU2/DT',//,
     2   5X,'  U1MIN = ',F7.3,'  U1MAX = ',F7.3,/,
     3   5X,'  U2MIN = ',F7.3,'  U2MAX = ',F7.3,/,
     4   5X,' DU1MIN = ',F7.3,' DU1MAX = ',F7.3,/,
     5   5X,' DU2MIN = ',F7.3,' DU2MAX = ',F7.3)
C...
C...  PRINT AND COMPUTE THE RESIDUAL OF THE HENON DIFFERENCE EQUATIONS
C...  AT THE EQUILIBRIUM POINT FOR THE DIFFERENTIAL EQUATIONS
      U1=0.63135446
      U2=0.18940634
      R1=U1-U2+(7.0/5.0)*U1**2-1.0
      R2=U2-(3.0/10.0)*U1
      WRITE(NO,10)U1,U2,R1,R2
10    FORMAT(1H ,////,
     1      ' RESIDUALS OF THE HENON DIFFERENCE EQUATIONS',//,
     2   5X,'     U1 = ',F7.5,'     U2 = ',F7.5,/,
     3   5X,'  RES 1 = ',F7.5,'  RES 2 = ',F7.5)
C...
C...  CONTINUOUS PLOT OF U2(T) VS U1(T)
C...
C...  ******************************************************************
C...
C...  THE FOLLOWING CALLS TO A CONTINUOUS PLOTTER ARE MACHINE DEPENDENT
C...  AND MUST BE CONVERTED FOR OTHER COMPUTERS OR CHANGED TO COMMENTS
C...
C...  SCALE THE AXES
C...  CALL QIKSET(6.0,-1.5,0.5,8.0,-0.4,0.1)
C...  CALL QIKSAX(3,3)
C...
C...  FIRST CURVE
      DO 4 J=1,IP
      X(J)=U1P(1,J)
      Y(J)=U2P(1,J)
4     CONTINUE
C...  CALL QIKPLT(X,Y,IP,7H*U1(T)*,7H*U2(T)*,
C... 1 33H*DIFFERENTIAL FORM OF HENON EQNS*,1)
C...  CALL PLOT(-7.0,1.0,-3)
C...
C...  SUBSEQUENT CURVES
      DO 6 I=2,NORUN
      DO 5 J=1,IP
      X(J)=U1P(I,J)
      Y(J)=U2P(I,J)
5     CONTINUE
C...  CALL QLINE(X,Y,IP,M)
6     CONTINUE
C...
C...  CONTINUOUS PLOT OF DU2(T)/DT VS DU1(T)/DT
C...
C...  SCALE THE AXES
C...  CALL QIKSET(6.0,-4.0,1.5,8.0,-0.8,0.2)
C...  CALL QIKSAX(3,3)
C...
C...  FIRST CURVE
      DO 7 J=1,IP
      X(J)=DU1DTP(1,J)
      Y(J)=DU2DTP(1,J)
7     CONTINUE
C...  CALL QIKPLT(X,Y,IP,8H*DU1/DT*,8H*DU2/DT*,
C... 1 33H*DIFFERENTIAL FORM OF HENON EQNS*,1)
C...  CALL PLOT(-7.0,1.0,-3)
C...
C...  SUBSEQUENT CURVES
      DO 9 I=2,NORUN
      DO 8 J=1,IP
      X(J)=DU1DTP(I,J)
      Y(J)=DU2DTP(I,J)
8     CONTINUE
C...  CALL QLINE(X,Y,IP,M)
9     CONTINUE
C...
C...  ******************************************************************
C...
      RETURN
      END
DIFFERENTIAL FORM OF THE HENON EQUATIONS
0.        20.0      0.1
    2 1000    1    1  REL 0.001
REPEATS
   15
END OF RUNS
*APP MATH33
      PROGRAM LORENZ
C...
C...  CRISIS TRANSITION IN THE CHOATIC LORENZ EQUATIONS
C...
C...  CONSIDER THE FOLLOWING SYSTEM OF THREE NONLINEAR ODES (1,2):
C...
C...     DX/DT = P*Y - P*X
C...
C...     DY/DT = -X*Z + R*X - Y
C...
C...     DZ/DT = X*Y - B*Z
C...
C...  (1)  LORENZ, E. N., J. ATMOS. SCI., V20, 130 (1963)
C...
C...  (2)  GREBOGI, C., E. OTT AND J. A. YORKE, SCIENCE, V238, 632-
C...       638 (1987)
C...
C...  COMPUTE A SOLUTION TO THIS SYSTEM OF EQUATIONS USING FIXED
C...  STEP EULER INTEGRATION (NOT DSS/2) FOR:
C...
C...     0 LE T LE 75, P = 10, B = 8/3
C...
C...     X(0) = 1, Y(0) = Z(0) = 0
C...
C...     (1)  CASE 1: R = 28
C...
C...     (2)  CASE 2: R = 22
C...
C...  PLOT X(T) VS T FOR THE TWO CASES (SEVERAL THOUSAND POINTS MAY BE
C...  REQUIRED TO DEFINE THE SOLUTION OVER THE INDICATED INTERVAL IN T).
C...
C...  DIMENSION THE ARRAYS FOR THE PLOTTED SOLUTION
      DIMENSION TP(0:10000), XP(0:10000)
C...
C...  DEFINE THE INPUT/OUTPUT UNIT NUMBERS
      NI=5
      NO=6
C...
C...  DEFINE THE INPUT/OUTPUT FILES
      OPEN(NI,FILE='INPUT')
      OPEN(NO,FILE='OUTPUT')
C...
C...  SPECIFY OPTIONAL PRINTING OF THE SOLUTION
C...  NWRITE=1
C...
C...  SET THE PROBLEM PARAMETERS
      P=10.
      B=8./3.
      NSTEPS=10000
      H=75./FLOAT(NSTEPS)
C...
C...  STEP THROUGH THE TWO CASES
      DO 1 NCASE=1,2
      IF(NCASE.EQ.1)R=28.
      IF(NCASE.EQ.2)R=22.
C...
C...  INITIAL CONDITIONS
      X=1.0
      Y=0.
      Z=0.
C...
C...  STEP THROUGH THE EULER INTEGRATION
      DO 2 J=0,NSTEPS
C...
C...  STORE THE SOLUTION FOR PLOTTING
      T=H*FLOAT(J)
      TP(J)=T
      XP(J)=X
C...
C...  CALCULATE THE DERIVATIVES
      DXDT=P*Y-P*X
      DYDT=-X*Z+R*X-Y
      DZDT=X*Y-B*Z
C...
C...  PRINT THE SOLUTION
      IF(NWRITE.EQ.1)THEN
         WRITE(NO,3)T,X,Y,Z,DXDT,DYDT,DZDT
3        FORMAT(F10.2,6F10.3)
      END IF
C...
C...  TAKE AN EULER STEP
      X=X+DXDT*H
      Y=Y+DYDT*H
      Z=Z+DZDT*H
C...
C...  STORE THE SOLUTION AND GO ON TO THE NEXT EULER STEP
2     CONTINUE
C...
C...  PLOT THE SOLUTION
C...
C...  ****************************************************************
C...
C...  THE FOLLOWING CALLS TO A CONTINUOUS PLOTTER ARE MACHINE DEPENDENT
C...  AND MUST BE CONVERTED FOR OTHER COMPUTERS OR CHANGED TO COMMENTS
C...
      IF(NCASE.EQ.1)THEN
C...     CALL QIKSAX(3,3)
C...     CALL QIKPLT(TP,XP,NSTEPS+1,3H*T*,6H*X(T)*,
C... 1      28H*LORENZ EQUATIONS, R = 28*,1)
      ELSE IF(NCASE.EQ.2)THEN
C...     CALL QIKSAX(3,3)
C...     CALL QIKPLT(TP,XP,NSTEPS+1,3H*T*,6H*X(T)*,
C... 1      28H*LORENZ EQUATIONS, R = 22*,1)
      END IF
C...
C...  ****************************************************************
C...
C...  GO ON TO THE NEXT CASE
1     CONTINUE
      END
*APP MATH34
      PROGRAM LORENZ
C...
C...  INTERMITTENCY IN THE CHAOTIC LORENZ EQUATIONS
C...
C...  CONSIDER THE FOLLOWING SYSTEM OF THREE NONLINEAR ODES (1,2):
C...
C...     DX/DT = P*Y - P*X
C...
C...     DY/DT = -X*Z + R*X - Y
C...
C...     DZ/DT = X*Y - B*Z
C...
C...  (1)  LORENZ, E. N., J. ATMOS. SCI., V20, 130 (1963)
C...
C...  (2)  GREBOGI, C., E. OTT AND J. A. YORKE, SCIENCE, V238, 632-
C...       638 (1987)
C...
C...  COMPUTE A SOLUTION TO THIS SYSTEM OF EQUATIONS USING FIXED
C...  STEP EULER INTEGRATION (NOT DSS/2) FOR:
C...
C...     0 LE T LE 10, P = 10, B = 8/3
C...
C...     X(0) = 1, Y(0) = Z(0) = 0
C...
C...     (1)  CASE 1: R = 166.0
C...
C...     (2)  CASE 2: R = 166.2
C...
C...  PLOT Z(T) VS T FOR THE TWO CASES (SEVERAL THOUSAND POINTS MAY BE
C...  REQUIRED TO DEFINE THE SOLUTION OVER THE INDICATED INTERVAL IN T).
C...
C...  DIMENSION THE ARRAYS FOR THE PLOTTED SOLUTION
      DIMENSION TP(0:10000), ZP(0:10000)
C...
C...  DEFINE THE INPUT/OUTPUT UNIT NUMBERS
      NI=5
      NO=6
C...
C...  DEFINE THE INPUT/OUTPUT FILES
      OPEN(NI,FILE='INPUT')
      OPEN(NO,FILE='OUTPUT')
C...
C...  SPECIFY OPTIONAL PRINTING OF THE SOLUTION
C...  NWRITE=0
C...
C...  SET THE PROBLEM PARAMETERS
      P=10.
      B=8./3.
      NSTEPS=10000
      H=10./FLOAT(NSTEPS)
C...
C...  STEP THROUGH THE TWO CASES
      DO 1 NCASE=1,2
      IF(NCASE.EQ.1)R=166.0
      IF(NCASE.EQ.2)R=166.2
C...
C...  INITIAL CONDITIONS
      X=1.0
      Y=0.
      Z=0.
C...
C...  STEP THROUGH THE EULER INTEGRATION
      DO 2 J=0,NSTEPS
C...
C...  STORE THE SOLUTION FOR PLOTTING
      T=H*FLOAT(J)
      TP(J)=T
      ZP(J)=Z
C...
C...  CALCULATE THE DERIVATIVES
      DXDT=P*Y-P*X
      DYDT=-X*Z+R*X-Y
      DZDT=X*Y-B*Z
C...
C...  PRINT THE SOLUTION
      IF(NWRITE.EQ.1)THEN
         WRITE(NO,3)T,X,Y,Z,DXDT,DYDT,DZDT
3        FORMAT(F10.2,6F10.3)
      END IF
C...
C...  TAKE AN EULER STEP
      X=X+DXDT*H
      Y=Y+DYDT*H
      Z=Z+DZDT*H
C...
C...  STORE THE SOLUTION AND GO ON TO THE NEXT EULER STEP
2     CONTINUE
C...
C...  PLOT THE SOLUTION
C...
C...  ******************************************************************
C...
C...  THE FOLLOWING CALLS TO A CONTINUOUS PLOTTER ARE MACHINE DEPENDENT
C...  AND MUST BE CONVERTED FOR OTHER MACHINES OR CHANGED TO COMMENTS
C...
      IF(NCASE.EQ.1)THEN
C...     CALL QIKSAX(3,3)
C...     CALL QIKPLT(TP,ZP,NSTEPS+1,3H*T*,6H*Z(T)*,
C... 1      29H*LORENZ EQUATIONS, R = 166.0*,1)
      ELSE IF(NCASE.EQ.2)THEN
C...     CALL QIKSAX(3,3)
C...     CALL QIKPLT(TP,ZP,NSTEPS+1,3H*T*,6H*Z(T)*,
C... 1      29H*LORENZ EQUATIONS, R = 166.2*,1)
C...
C...  ******************************************************************
C...
      END IF
C...
C...  GO ON TO THE NEXT CASE
1     CONTINUE
      END
*APP MATH35
      SUBROUTINE INITAL
C...
C...  ONE-DIMENSIONAL BURGERS' EQUATION WITH DIRICHLET AND NEUMANN
C...  BOUNDARY CONDITIONS, ILLUSTRATING THE NUMERICAL METHOD OF LINES
C...  INTEGRATION OF ONE-DIMENSIONAL ELLIPTIC, HYPERBOLIC AND PARABOLIC
C...  PARTIAL DIFFERENTIAL EQUATIONS (PDES) - EXPLICIT TIME INTEGRATION
C...
C...  THIS PROBLEM ILLUSTRATES THE METHOD OF LINES PROGRAMMING OF A
C...  ONE-DIMENSIONAL HYPERBOLIC-PARABOLIC (CONVECTIVE-DIFFUSION)
C...  PARTIAL DIFFERENTIAL EQUATION (PDE), THE WELL-KNOWN BURGERS'
C...  EQUATION
C...
C...     U  = -U*U  + VIS*U                                     (1)
C...      T       X        XX
C...
C...  WHERE
C...
C...     U       DEPENDENT VARIABLE TO BE COMPUTED
C...
C...     T       INITIAL-VALUE INDEPENDENT VARIABLE (TYPICALLY TIME)
C...
C...     X       BOUNDARY-VALUE INDEPENDENT VARIABLE (TYPICALLY SPACE)
C...
C...     VIS     COEFFICIENT, TYPICALLY A VISCOSITY, WHICH CHANGES THE
C...             CHARACTER OF EQUATION (1)
C...
C...                VIS LARGE - EQUATION (1) IS STRONGLY PARABOLIC
C...
C...                VIS SMALL - EQUATION (1) IS STRONGLY HYPERBOLIC
C...
C...  A LETTER SUBSCRIPT DENOTES A PARTIAL DERIVATIVE, E.G., U  IS THE
C...                                                          T
C...  FIRST-ORDER PARTIAL DERIVATIVE OF U WITH RESPECT TO T.
C...
C...  EQUATION (1) IS A WELL-ESTABLISHED TEST PROBLEM FOR PDE SOFTWARE
C...  BECAUSE IT
C...
C...     (1)  HAS AN EXACT SOLUTION (A), E.G.,
C...
C...             U(X,T) = 1/(1 + EXP(X/(2*VIS) - T/(4*VIS)))    (2)
C...
C...           (A)  BENTON, E. R., AND G. W. PLATZMAN, A TABLE OF
C...           SOLUTIONS OF THE ONE-DIMENSIONAL BURGERS EQUATION,
C...           QUARTERLY OF APPLIED MATHEMATICS, JULY, 1972, PP
C...           195-212.
C...
C...     (2)  IS A STRINGENT TEST PROBLEM, PARTICULARLY FOR SMALL VIS,
C...          FOR WHICH THE SOLUTION EXHIBITS STEEP, MOVING FRONTS.
C...
C...  IN THE SUBSEQUENT PROGRAMMING OF EQUATION (1), THE INITIAL AND
C...  BOUNDARY CONDITIONS HAVE BEEN CHOSEN TO BE CONSISTENT WITH
C...  EQUATION (2).  ALSO, VIS = 1.0, WHICH GIVES EQUATION (1) A
C...  MIXED HYPERBOLIC-PARABOLIC CHARACTER, RESULTS IN A VERY SMOOTH
C...  SOLUTION FROM EQUATION (2), I.E., THIS CHOICE OF VIS WAS MADE
C...  TO FACILITATE THE CALCULATION OF THE NUMERICAL SOLUTION IN ORDER
C...  TO DEMONSTRATE VARIOUS COMPUTATIONAL AND PROGRAMMING PROCEDURES
C...  WITH A MODEST COMPUTING EFFORT.
C...
C...  EQUATION (1) IS INTEGRATED BY THE NUMERICAL METHOD OF LINES IN
C...  THE SUBSEQUENT PROGRAMMING FOR TWO TYPES OF BOUNDARY CONDITIONS
C...  AT X = 0 AND X = XL (IN THE SUBSEQUENT DISCUSSION, XL HAS THE
C...  NUMERICAL VALUE XL = 1)
C...
C...     (1)  DIRICHLET BOUNDARY CONDITIONS IN WHICH U(0,T) AND
C...          U(XL,T) ARE SPECIFIED
C...
C...     (2)  NEUMANN BOUNDARY CONDITIONS IN WHICH U (0,T) AND
C...          U (XL,T) ARE SPECIFIED                X
C...           X
C...
C...  ALSO, TWO APPROACHES TO THE CALCULATION OF THE DERIVATIVE U
C...                                                             XX
C...  (WHICH WILL SUBSEQUENTLY BE DESIGNATED WITH THE IN-LINE NOTATION
C...  UXX) IN EQUATION (1) ARE USED
C...
C...     (1)  STAGEWISE DIFFERENTIATION, I.E., UX IS CALCULATED FROM U
C...          AND THEN UXX IS CALCULATED FROM UX
C...
C...     (2)  DIRECT DIFFERENTIATION, I.E., UXX IS CALCULATED DIRECTLY
C...          FROM U
C...
C...  THUS, THERE ARE A TOTAL OF FOUR COMBINATIONS (2 TYPES OF BOUNDARY
C...  CONDITIONS X 2 TYPES OF UXX CALCULATIONS) IN SUBROUTINES DERV1,
C...  DERV2, DERV3 AND DERV4.  COMMENTS ARE GIVEN IN EACH OF THESE
C...  SUBROUTINES EXPLAINING THE PROGRAMMING IN DETAIL.
C...
C...  SINCE THE EXACT SOLUTION, EQUATION (2), IS AVAILABLE, THE ERROR
C...  IN THE NUMERICAL SOLUTION CAN BE COMPUTED.  IN PARTICULAR, THE
C...  ERROR IN U(X=XL/2,T=1.0) IS COMPUTED FOR 11, 21, 31, 41 AND 51
C...  GRID POINTS IN X IN THE NUMERICAL METHOD OF LINES SOLUTION.  THIS
C...  ERROR IS THEN PLOTTED VS THE GRID SPACING LOGARITHMICALLY AT THE
C...  END OF THE 20TH RUN (4 COMBINATIONS MENTIONED PREVIOUSLY X 5
C...  NUMBERS OF GRID POINTS FOR EACH COMBINATION).  THESE CALCULATIONS,
C...  AND THE ASSOCIATED PLOTTING, ARE EXPLAINED IN THE COMMENTS IN
C...  SUBROUTINE PRINT.
C...
C...  THE EXACT SOLUTION IN THIS CASE IS (WITH X = XL/2 = 0.5, T = 1)
C...
C...     U(0.5,1.0) = 1/(1 + EXP(0.5/(2*VIS) - 1/(4*VIS)))
C...
C...                = 1/(1 + EXP(0)) = 1/2 = 0.5
C...
C...  NOTE THAT THIS RESULT IS INDEPENDENT OF VIS.  THUS, VIS CAN BE
C...  DECREASED TO MAKE THE NUMERICAL SOLUTION MORE DIFFICULT TO
C...  COMPUTE, I.E., THE PROBLEM IS MORE HYPERBOLIC AND LESS PARABOLIC,
C...  YET THE NUMERICAL SOLUTION SHOULD REMAIN CLOSE TO 0.5 IF REASON-
C...  ABLE ACCURACY IS TO BE MAINTAINED.
C...
C...  IN ADDITION TO THE COMMENTS IN THE FOLLOWING CODING, THE READER
C...  CAN ALSO REFER TO THE COMMENTS IN THE SPATIAL DIFFERENTIATION
C...  ROUTINES, DSS004, DSS020 AND DSS044.  IN PARTICULAR, CENTERED
C...  APPROXIMATIONS IN SUBROUTINES DSS004 AND DSS044 ARE USED TO
C...  CALCULATE UXX IN EQUATION (1), I.E., CENTERED APPROXIMATIONS
C...  SHOULD BE USED IN PARABOLIC PROBLEMS, AND NONCENTERED (FIVE-
C...  POINT BIASED UPWIND) APPROXIMATIONS IN SUBROUTINE DSS020 ARE
C...  USED TO CALCULATE UX IN EQUATION (1), I.E., NONCENTERED
C...  APPROXIMATIONS SHOULD BE USED IN HYPERBOLIC PROBLEMS.  ALL
C...  OF THESE APPROXIMATIONS ARE DERIVED FROM THE TAYLOR SERIES
C...  AS EXPLAINED IN THE THREE SUBROUTINES.
C...
C...  TWO SPECIAL CASES OF THIS PROBLEM CAN BE CONSIDERED
C...
C...     (1)  VIS = 0
C...
C...     IN THIS CASE, EQUATION (1) REDUCES TO
C...
C...     U  = -U*U  = -(U**2) /2                                (3)
C...      T       X          X
C...
C...     EQUATION (3) HAS THE ANALYTICAL SOLUTION
C...
C...     U(X,T) = X/(1 + T)                                     (4)
C...
C...     THE USE OF EQUATIONS (3) AND (4) IN THE FOLLOWING PROGRAMMING
C...     REQUIRES SOME MODIFICATION OF THE PROGRAMMING.
C...
C...     (2)  BOUNDARY-VALUE ORDINARY DIFFERENTIAL EQUATION (ODE)
C...
C...     THE STEADY STATE FORM OF EQUATION (1) IS THE BOUNDARY-VALUE
C...     ORDINARY DIFFERENTIAL EQUATION
C...
C...     U   - U*U  = 0                                         (5)
C...      XX      X
C...
C...     (NOTE THAT U  = 0 IN EQUATION (1)), WHICH CAN ALSO BE CONSIDER-
C...                 T
C...     AS A ONE-DIMENSIONAL ELLIPTIC PDE (WITH ONE INDEPENDENT VARI-
C...     ABLE, X).
C...
C...     EQUATION (5) CAN BE SOLVED SUBJECT TO TWO BOUNDARY CONDITIONS
C...     BY ALLOWING THE SOLUTION OF EQUATION (1) TO PROCEED TO U  = 0.
C...                                                             T
C...     (AN EXACT SOLUTION CAN ALSO BE EASILY DERIVED).  IF THE BOUND-
C...     ARY CONDITIONS ARE SELECTED AS U(0,INF) = U(XL,INF) = 1, THE
C...     EXACT SOLUTION IS U(X,INF) = 1.  THIS SOLUTION CAN BE DEMON-
C...     STRATED BY ALLOWING THE NUMERICAL SOLUTION TO EQUATION (1) TO
C...     PROCEED TO T = INF, I.E., U  = 0.
C...                                T
C...
C...     THIS DISCUSSION SUGGESTS A GENERAL METHOD FOR SOLVING BOUNDARY-
C...     VALUE ODES, I.E., A PSEUDO TIME DERIVATIVE IS ADDED TO THE ODES
C...     AND THE RESULTING PDES ARE INTEGRATED TO STEADY STATE FOR WHICH
C...     THE TIME DERIVATIVES ESSENTIALLY GO TO ZERO.  THIS APPROACH HAS
C...     BEEN USED EFFECTIVELY IN THE SOLUTION OF SOME RELATIVELY COM-
C...     PLEX BOUNDARY-VALUE ODES (WHICH, AGAIN, CAN ALSO BE CONSIDERED
C...     ONE-DIMENSIONAL ELLIPTIC PDES).  THIS APPROACH IS ALSO TERMED
C...     THE METHOD OF FALSE TRANSIENTS.
C...
C...  FINALLY, THE VERIFICATION OF EQUATION (2) AS A SOLUTION TO EQUA-
C...  TION (1) FOLLOWS:
C...
C...  LET EX = EXP(X/(2*VIS) - T/(4*VIS)).  THEN EQUATION (2) CAN BE
C...  WRITTEN AS:
C...
C...     U(X,T) = 1/(1 + EX)
C...
C...  THE VARIOUS TERMS IN EQUATION (1) ARE:
C...
C...     U  = (-1/(1 + EX)**2)*EX*(-1/(4*VIS))
C...      T
C...
C...     U*U  = (1/(1 + EX))*(-1/(1 + EX)**2)*EX*(1/(2*VIS))
C...        X
C...
C...     -VIS*U   = -VIS*((-1/(1 + EX)**2)*EX*(1/(2*VIS))**2
C...           XX
C...
C...              + EX*(1/(2*VIS)*2/(1 + EX)**3)*EX*(1/(2*VIS)))
C...
C...  SUMMATION OF THESE TERMS GIVES:
C...
C...     0 = (1/(1 + EX)**2)*EX*(1/(4*VIS))*(1 + 1)
C...
C...       - (1/(1 + EX)**3)*EX*(1/(2*VIS))*(1 + EX)
C...
C...       = 0
C...
C...  WE NOW PROCEED TO THE NUMERICAL METHOD OF LINES SOLUTION OF EQUA-
C...  TION (1) SUBJECT TO DIRICHLET AND NEUMANN BOUNDARY CONDITIONS, AND
C...  AN INITIAL CONDITION, WHICH ARE CONSISTENT WITH THE EXACT SOLU-
C...  TION, EQUATION (2).
C...
C...  DSS/2 COMMON
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/     U(51)
     2      /F/    UT(51)
     3      /S/    UX(51),   UXX(51)
     4      /R/       VIS,        XL,     X(51)
     5      /I/         N,        IP
C...
C...  EQUATION PARAMETERS
      VIS=1.0
      XL =1.0E+00
C...
C...  NUMBER OF GRID POINTS
C...     DIRICHLET BOUNDARY CONDITIONS
         IF((NORUN- 1)*(NORUN- 6).EQ.0)N=11
         IF((NORUN- 2)*(NORUN- 7).EQ.0)N=21
         IF((NORUN- 3)*(NORUN- 8).EQ.0)N=31
         IF((NORUN- 4)*(NORUN- 9).EQ.0)N=41
         IF((NORUN- 5)*(NORUN-10).EQ.0)N=51
C...
C...     NEUMANN BOUNDARY CONDITIONS
         IF((NORUN-11)*(NORUN-16).EQ.0)N=11
         IF((NORUN-12)*(NORUN-17).EQ.0)N=21
         IF((NORUN-13)*(NORUN-18).EQ.0)N=31
         IF((NORUN-14)*(NORUN-19).EQ.0)N=41
         IF((NORUN-15)*(NORUN-20).EQ.0)N=51
C...
C...  INITIAL CONDITIONS (T = 0 IN EQUATION (2))
      DO 1 I=1,N
      X(I)=XL*FLOAT(I-1)/FLOAT(N-1)
      U(I)=UA(X(I),T,VIS)
1     CONTINUE
C...
C...  INITIAL DERIVATIVES
      CALL DERV
      IP=0
      RETURN
      END
      SUBROUTINE DERV
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/     U(51)
     2      /F/    UT(51)
     3      /S/    UX(51),   UXX(51)
     4      /R/       VIS,        XL,     X(51)
     5      /I/         N,        IP
C...
C...  DIRICHLET BOUNDARY CONDITIONS, STAGEWISE DIFFERENTIATION
      IF((NORUN.GE. 1).AND.(NORUN.LE. 5))CALL DERV1
C...
C...  DIRICHLET BOUNDARY CONDITIONS, DIRECT DIFFERENTIATION
      IF((NORUN.GT. 6).AND.(NORUN.LE.10))CALL DERV2
C...
C...  NEUMANN BOUNDARY CONDITIONS, STAGEWISE DIFFERENTIATION
      IF((NORUN.GE.11).AND.(NORUN.LE.15))CALL DERV3
C...
C...  NEUMANN BOUNDARY CONDITIONS, DIRECT DIFFERENTIATION
      IF((NORUN.GE.16).AND.(NORUN.LE.20))CALL DERV4
      RETURN
      END
      SUBROUTINE DERV1
C...
C...  DIRICHLET BOUNDARY CONDITIONS, STAGEWISE DIFFERENTIATION
C...
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/     U(51)
     2      /F/    UT(51)
     3      /S/    UX(51),   UXX(51)
     4      /R/       VIS,        XL,     X(51)
     5      /I/         N,        IP
C...
C...     X = 0 (X = 0 IN EQUATION (2))
         U(1)=UA(X(1),T,VIS)
C...
C...     X = XL (X = XL IN EQUATION (2))
         U(N)=UA(X(N),T,VIS)
C...
C...  SPATIAL DERIVATIVES
C...
C...     UX IN UXX (BY FIVE-POINT CENTERED APPROXIMATIONS)
         CALL DSS004(0.0E+00,XL,N,U,UX)
C...
C...     UXX (BY FIVE-POINT CENTERED APPROXIMATIONS)
         CALL DSS004(0.0E+00,XL,N,UX,UXX)
C...
C...     UX IN U*UX (BY FIVE-POINT BIASED UPWIND APPROXIMATIONS)
         CALL DSS020(0.0E+00,XL,N,U,UX,1.0E+00)
C...
C...  BURGERS' EQUATION
C...
C...     X = 0
         UT(1)=0.0E+00
C...
C...     0 LT X LT XL
         NM1=N-1
         DO 1 I=2,NM1
         UT(I)=-U(I)*UX(I)+VIS*UXX(I)
1        CONTINUE
C...
C...     X = XL
         UT(N)=0.0E+00
      RETURN
      END
      SUBROUTINE DERV2
C...
C...  DIRICHLET BOUNDARY CONDITIONS, DIRECT DIFFERENTIATION
C...
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/     U(51)
     2      /F/    UT(51)
     3      /S/    UX(51),   UXX(51)
     4      /R/       VIS,        XL,     X(51)
     5      /I/         N,        IP
C...
C...     X = 0 (X = 0 IN EQUATION (2))
         U(1)=UA(X(1),T,VIS)
C...
C...     X = XL (X = XL IN EQUATION (2))
         U(N)=UA(X(N),T,VIS)
C...
C...  SPATIAL DERIVATIVES
C...
C...     UXX (BY SECOND DERIVATIVE APPROXIMATIONS)
         CALL DSS044(0.0E+00,XL,N,U,UX,UXX,1,1)
C...
C...     UX IN U*UX (BY FIVE-POINT BIASED UPWIND APPROXIMATIONS)
         CALL DSS020(0.0E+00,XL,N,U,UX,1.0E+00)
C...
C...  BURGERS' EQUATION
C...
C...     X = 0
         UT(1)=0.0E+00
C...
C...     0 LT X LT XL
         NM1=N-1
         DO 1 I=2,NM1
         UT(I)=-U(I)*UX(I)+VIS*UXX(I)
1        CONTINUE
C...
C...     X = XL
         UT(N)=0.0E+00
      RETURN
      END
      SUBROUTINE DERV3
C...
C...  NEUMANN BOUNDARY CONDITIONS, STAGEWISE DIFFERENTIATION
C...
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/     U(51)
     2      /F/    UT(51)
     3      /S/    UX(51),   UXX(51)
     4      /R/       VIS,        XL,     X(51)
     5      /I/         N,        IP
C...
C...  SPATIAL DERIVATIVES
C...
C...     UX IN UXX (BY FIVE-POINT CENTERED APPROXIMATIONS)
         CALL DSS004(0.0E+00,XL,N,U,UX)
C...
C...     X = 0 (X = 0 IN EQUATION (2))
         UX(1)=DUA(X(1),T,VIS)
C...
C...     X = XL (X = XL IN EQUATION (2))
         UX(N)=DUA(X(N),T,VIS)
C...
C...     UXX (BY FIVE-POINT CENTERED APPROXIMATIONS)
         CALL DSS004(0.0E+00,XL,N,UX,UXX)
C...
C...     UX IN U*UX (BY FIVE-POINT BIASED UPWIND APPROXIMATIONS)
         CALL DSS020(0.0E+00,XL,N,U,UX,1.0E+00)
C...
C...     X = 0 (X = 0 IN EQUATION (2))
         UX(1)=DUA(X(1),T,VIS)
C...
C...     X = XL (X = XL IN EQUATION (2))
         UX(N)=DUA(X(N),T,VIS)
C...
C...  BURGERS' EQUATION
C...
C...     0 LE X LE XL
         DO 1 I=1,N
         UT(I)=-U(I)*UX(I)+VIS*UXX(I)
1        CONTINUE
      RETURN
      END
      SUBROUTINE DERV4
C...
C...  NEUMANN BOUNDARY CONDITIONS, DIRECT DIFFERENTIATION
C...
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/     U(51)
     2      /F/    UT(51)
     3      /S/    UX(51),   UXX(51)
     4      /R/       VIS,        XL,     X(51)
     5      /I/         N,        IP
C...
C...     X = 0 (X = 0 IN EQUATION (2))
         UX(1)=DUA(X(1),T,VIS)
C...
C...     X = XL (X = XL IN EQUATION (2))
         UX(N)=DUA(X(N),T,VIS)
C...
C...  SPATIAL DERIVATIVES
C...
C...     UXX (BY SECOND DERIVATIVE APPROXIMATIONS)
         CALL DSS044(0.0E+00,XL,N,U,UX,UXX,2,2)
C...
C...     UX IN U*UX (BY FIVE-POINT BIASED UPWIND APPROXIMATIONS)
         CALL DSS020(0.0E+00,XL,N,U,UX,1.0E+00)
C...
C...     X = 0 (X = 0 IN EQUATION (2))
         UX(1)=DUA(X(1),T,VIS)
C...
C...     X = XL (X = XL IN EQUATION (2))
         UX(N)=DUA(X(N),T,VIS)
C...
C...  BURGERS' EQUATION
C...
C...     0 LE X LE XL
         DO 1 I=1,N
         UT(I)=-U(I)*UX(I)+VIS*UXX(I)
1        CONTINUE
      RETURN
      END
      FUNCTION UA(X,T,VIS)
C...
C...  FUNCTION UA IMLEMENTS THE ANALYTICAL SOLUTION, EQUATION (2)
C...
      EX=EXP(X/(2.0E+00*VIS)-T/(4.0E+00*VIS))
      UA=1.0E+00/(1.0E+00+EX)
      RETURN
      END
      FUNCTION DUA(X,T,VIS)
C...
C...  FUNCTION DUA IMPLEMENTS THE DERIVATIVE OF THE ANALYTICAL SOLUTION,
C...  EQUATION (2), WITH RESPECT TO X
C...
      EX=EXP(X/(2.0E+00*VIS)-T/(4.0E+00*VIS))
      DUA=-1.0E+00*(1.0E+00+EX)**(-2)*EX*(1.0E+00/(2.0E+00*VIS))
      RETURN
      END
      SUBROUTINE PRINT(NI,NO)
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/     U(51)
     2      /F/    UT(51)
     3      /S/    UX(51),   UXX(51)
     4      /R/       VIS,        XL,     X(51)
     5      /I/         N,        IP
C...
C...  DIMENSION THE ARRAYS FOR PLOTTING
      DIMENSION DXP(5), EP1(2,5), EP2(2,5)
C...
C...  PRINT A HEADING FOR THE NUMERICAL SOLUTION
      IP=IP+1
      IF(IP.EQ.1)WRITE(NO,1)
1     FORMAT(11X,'T',7X,'U(XL/2,T)',6X,'U(XL/2,T)',8X,'ERROR',/,
     1              19X,'  (NUM)  ',6X,'  (ANAL) ')
C...
C...  COMPUTE THE ANALYTICAL SOLUTION AND THE ERROR IN THE NUMERICAL
C...  SOLUTION AT X = XL/2
      N2=N/2+1
      XL2=X(N2)
      UANAL=UA(XL2,T,VIS)
      ERROR=U(N2)-UANAL
C...
C...  PRINT THE NUMERICAL AND ANALYTICAL SOLUTIONS, AND THE ERROR
      WRITE(NO,2)T,U(N2),UANAL,ERROR
2     FORMAT(F12.2,2F15.6,E16.4)
C...
C...  STORE THE SOLUTION U(X=0.5,T=1.0)FOR PLOTTING
C...
C...     THE ERRORS FOR NORUN = 1 TO 5 (NPLOT = 1), AND NORUN = 6 TO
C...     10 (NPLOT = 2) ARE PLOTTED VS THE GRID SPACING ON THE SAME
C...     LOG-LOG PLOT (DIRICHLET BOUNDARY CONDITIONS)
         IF((T.GT.0.95E+00).AND.(T.LT.1.05E+00))THEN
C...
C...        NPLOT=1
            IF((NORUN.GE. 1).AND.(NORUN.LE. 5))THEN
               NPLOT=1
               DXP(NORUN)=ALOG10(XL/FLOAT(N-1))
               EP1(NPLOT,NORUN-0)=ALOG10(ABS(ERROR))
C...
C...        NPLOT=2
            ELSE IF((NORUN.GE. 6).AND.(NORUN.LE.10))THEN
               NPLOT=2
               EP1(NPLOT,NORUN-5)=ALOG10(ABS(ERROR))
            END IF
C...
C...     THE ERRORS FOR NORUN = 11 TO 15 (NPLOT = 1), AND NORUN = 16 TO
C...     10 (NPLOT = 2) ARE PLOTTED VS THE GRID SPACING ON THE SAME
C...     LOG-LOG PLOT (NEUMANN BOUNDARY CONDITIONS)
C...
C...        NPLOT = 1
            IF((NORUN.GE.11).AND.(NORUN.LE.15))THEN
               NPLOT=1
               EP2(NPLOT,NORUN-10)=ALOG10(ABS(ERROR))
C...
C...        NPLOT=2
            ELSE IF((NORUN.GE.16).AND.(NORUN.LE.20))THEN
               NPLOT=2
               EP2(NPLOT,NORUN-15)=ALOG10(ABS(ERROR))
            END IF
         END IF
C...
C...  PLOT THE ERROR VS GRID SPACING AT THE END OF FOUR SERIES OF FIVE
C...  RUNS
      IF((T.GT.1.95E+00).AND.(T.LT.2.05E+00).AND.(NORUN.EQ.20))THEN
C...
C...     DIRICHLET BC
         CALL TPLOTS(2,5,DXP,EP1)
C...
C...     PRINT A LABEL FOR THE PLOT
         WRITE(NO,11)
11       FORMAT(
     1 ' DIRICHLET BC, LOG(ERROR) VS LOG(DX)')
C...
C...     NEUMANN BC
         CALL TPLOTS(2,5,DXP,EP2)
C...
C...     PRINT A LABEL FOR THE PLOT
         WRITE(NO,12)
12       FORMAT(
     1 ' NEUMANN BC, LOG(ERROR) VS LOG(DX)')
      END IF
      RETURN
      END
ONE-D BURGERS' EQUATION, DIRICHLET BC, STAGEWISE DIFFERENTIATION, N = 11
0.        2.0       0.2
   11 1000    1    1  REL 0.001
ONE-D BURGERS' EQUATION, DIRICHLET BC, STAGEWISE DIFFERENTIATION, N = 21
0.        2.0       0.2
   21 1000    1    1  REL 0.001
ONE-D BURGERS' EQUATION, DIRICHLET BC, STAGEWISE DIFFERENTIATION, N = 31
0.        2.0       0.2
   31 1000    1    1  REL 0.001
ONE-D BURGERS' EQUATION, DIRICHLET BC, STAGEWISE DIFFERENTIATION, N = 41
0.        2.0       0.2
   41 1000    1    1  REL 0.001
ONE-D BURGERS' EQUATION, DIRICHLET BC, STAGEWISE DIFFERENTIATION, N = 51
0.        2.0       0.2
   51 1000    1    1  REL 0.001
ONE-D BURGERS' EQUATION, DIRICHLET BC, DIRECT DIFFERENTIATION, N = 11
0.        2.0       0.2
   11 1000    1    1  REL 0.001
ONE-D BURGERS' EQUATION, DIRICHLET BC, DIRECT DIFFERENTIATION, N = 21
0.        2.0       0.2
   21 1000    1    1  REL 0.001
ONE-D BURGERS' EQUATION, DIRICHLET BC, DIRECT DIFFERENTIATION, N = 31
0.        2.0       0.2
   31 1000    1    1  REL 0.001
ONE-D BURGERS' EQUATION, DIRICHLET BC, DIRECT DIFFERENTIATION, N = 41
0.        2.0       0.2
   41 1000    1    1  REL 0.001
ONE-D BURGERS' EQUATION, DIRICHLET BC, DIRECT DIFFERENTIATION, N = 51
0.        2.0       0.2
   51 1000    1    1  REL 0.001
ONE-D BURGERS' EQUATION, NEUMANN BC, STAGEWISE DIFFERENTIATION, N = 11
0.        2.0       0.2
   11 1000    1    1  REL 0.001
ONE-D BURGERS' EQUATION, NEUMANN BC, STAGEWISE DIFFERENTIATION, N = 21
0.        2.0       0.2
   21 1000    1    1  REL 0.001
ONE-D BURGERS' EQUATION, NEUMANN BC, STAGEWISE DIFFERENTIATION, N = 31
0.        2.0       0.2
   31 1000    1    1  REL 0.001
ONE-D BURGERS' EQUATION, NEUMANN BC, STAGEWISE DIFFERENTIATION, N = 41
0.        2.0       0.2
   41 1000    1    1  REL 0.001
ONE-D BURGERS' EQUATION, NEUMANN BC, STAGEWISE DIFFERENTIATION, N = 51
0.        2.0       0.2
   51 1000    1    1  REL 0.001
ONE-D BURGERS' EQUATION, NEUMANN BC, DIRECT DIFFERENTIATION, N = 11
0.        2.0       0.2
   11 1000    1    1  REL 0.001
ONE-D BURGERS' EQUATION, NEUMANN BC, DIRECT DIFFERENTIATION, N = 21
0.        2.0       0.2
   21 1000    1    1  REL 0.001
ONE-D BURGERS' EQUATION, NEUMANN BC, DIRECT DIFFERENTIATION, N = 31
0.        2.0       0.2
   31 1000    1    1  REL 0.001
ONE-D BURGERS' EQUATION, NEUMANN BC, DIRECT DIFFERENTIATION, N = 41
0.        2.0       0.2
   41 1000    1    1  REL 0.001
ONE-D BURGERS' EQUATION, NEUMANN BC, DIRECT DIFFERENTIATION, N = 51
0.        2.0       0.2
   51 1000    1    1  REL 0.001
END OF RUNS
*APP MATH36
      PROGRAM LSODET
C...
C...  AN INTERFACE BETWEEN DSS/2 APPLICATIONS AND INTEGRATOR LSODE
C...
C...  THE FOLLOWING PROGRAM CALLS A DSS/2 APPLICATION, DEFINED AS THE
C...  USER-SUPPLIED SUBROUTINES INITAL, DERV AND PRINT, PLUS DATA.
C...  THE SYSTEM OF ODES PROGRAMMED IN SUBROUTINE DERV IS INTEGRATED
C...  BY LSODE (THE BASIC SOLVER IN ODEPACK, A LIBRARY OF INTEGRATORS
C...  DEVELOPED BY ALAN C. HINDMARSH, LAWRENCE LIVERMORE NATIONAL LAB-
C...  ORATORY).
C...
C...  THE MODEL INITIAL CONDITIONS ARE SET IN SUBROUTINE INITAL, AND
C...  THE MODEL DERIVATIVES ARE PROGRAMMED IN SUBROUTINE DERV.  THE
C...  NUMERICAL SOLUTION IS PRINTED AND PLOTTED IN SUBROUTINE PRINT.
C...
C...  SUBROUTINES INITAL, DERV AND PRINT.  THE FOLLOWING CODING IS FOR
C...  250 ORDINARY DIFFERENTIAL EQUATIONS (ODES).  IF MORE ODES ARE TO
C...  BE INTEGRATED, ALL OF THE 250*S SHOULD BE CHANGED TO THE REQUIRED
C...  NUMBER
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/    Y(250)
     2      /F/    F(250)
C...
C...  COMMON AREA TO PROVIDE THE INPUT/OUTPUT UNIT NUMBERS TO OTHER
C...  SUBROUTINES
      COMMON/IO/       NI,        NO
C...
C...  ABSOLUTE DIMENSIONING OF THE ARRAYS REQUIRED BY LSODE.  ARRAY
C...  WORK IS SIZED BY THE FOLLOWING FORMULA FOR BANDED PROCESSING
C...  OF THE ODE JACOBIAN MATRIX VIA FINITE DIFFERENCES: 22+17*NEQN+
C...  (2*ML+MU)*NEQN.  FOR NEQN = 250, ML = MU = 3, 22+17*250+(2*3+3)*
C...  250 = 6600 (APPROXIMATELY).  IF FEWER THAN 250 ODES ARE TO BE
C...  INTEGRATED, THEN ML AND MU CAN BE LARGER FOR THE GIVEN SIZE OF
C...  WORK.  IF NEQN GT 250 AND/OR ML AND MU GT 3, WORK MUST BE DIMEN-
C...  SIONED TO A LARGER SIZE
      DIMENSION YV(250), RWORK(6600), IWORK(275)
C...
C...  EXTERNAL THE DERIVATIVE AND ODE JACOBIAN MATRIX ROUTINES CALLED BY
C...  LSODE
      EXTERNAL FCN, JAC
C...
C...  ARRAY FOR THE TITLE (FIRST LINE OF DATA), CHARACTERS  END OF RUNS
      CHARACTER TITLE(20)*4, ENDRUN(3)*4
C...
C...  VARIABLE FOR THE TYPE OF ERROR CRITERION
      CHARACTER*3 ABSREL
C...
C...  DEFINE THE CHARACTERS  END OF RUNS
      DATA ENDRUN/'END ','OF RU','NS  '/
C...
C...  DEFINE THE INPUT/OUTPUT UNIT NUMBERS
      NI=5
      NO=6
C...
C...  OPEN THE INPUT/OUTPUT FILES
      OPEN(NI,FILE='INPUT')
      OPEN(NO,FILE='OUTPUT')
C...
C...  INITIALIZE THE RUN COUNTER
      NORUN=0
C...
C...  BEGIN A RUN
1     NORUN=NORUN+1
C...
C...  INITIALIZE THE RUN TERMINATION VARIABLE
      NSTOP=0
C...
C...  READ THE FIRST LINE OF DATA
      READ(NI,1000,END=999)(TITLE(I),I=1,20)
C...
C...  TEST FOR  END OF RUNS  IN THE DATA
      DO 2 I=1,3
      IF(TITLE(I).NE.ENDRUN(I))GO TO 3
2     CONTINUE
C...
C...  AND END OF RUNS HAS BEEN READ, SO TERMINATE EXECUTION
999   STOP
C...
C...  READ THE SECOND LINE OF DATA
3     READ(NI,1001,END=999)T0,TF,TP
C...
C...  READ THE THIRD LINE OF DATA
      READ(NI,1002,END=999)NEQN,NMAX,INT,IERROR,ABSREL,ERROR
C...
C...  PRINT A DATA SUMMARY
      WRITE(NO,1003)NORUN,(TITLE(I),I=1,20),
     1                     T0,TF,TP,
     2                     NEQN,NMAX,INT,IERROR,ABSREL,ERROR
C...
C...  INITIALIZE TIME
      T=T0
C...
C...  SET THE INITIAL CONDITIONS
      CALL INITAL
C...
C...  PRINT THE INITIAL CONDITIONS
      CALL PRINT(NI,NO)
C...
C...  SET THE INITIAL CONDITIONS FOR SUBROUTINE LSODE
      DO 5 I=1,NEQN
      YV(I)=Y(I)
5     CONTINUE
C...
C...  SET THE PARAMETERS FOR SUBROUTINE LSODE
      TV=T0
      ITOL=1
      RTOL=1.0E-05
      ATOL=1.0E-05
      LRW=6600
      LIW=275
      IOPT=0
      ITASK=1
      ISTATE=1
C...
C...  NONSTIFF OPTION
      METH=1
      MITER=0
C...
C...  THE METHOD FLAG, MF, IS COMPUTED FROM METH AND MITER
      MF=10*METH+MITER
C...
C...  CALL SUBROUTINE LSODE TO COVER ONE PRINT INTERVAL
4     TOUT=TV+TP
      CALL LSODE(FCN,NEQN,YV,TV,TOUT,ITOL,RTOL,ATOL,ITASK,ISTATE,
     1           IOPT,RWORK,LRW,IWORK,LIW,JAC,MF)
C...
C...  PRINT THE SOLUTION
      T=TV
      DO 6 I=1,NEQN
      Y(I)=YV(I)
6     CONTINUE
      CALL PRINT(NI,NO)
C...
C...  TEST FOR AN ERROR CONDITION
      IF(ISTATE.LT.0)THEN
C...
C...     PRINT A MESSAGE INDICATING AN ERROR CONDITION
         WRITE(NO,1004)ISTATE
C...
C...     GO ON TO THE NEXT RUN
         GO TO 1
      END IF
C...
C...  CHECK FOR A RUN TERMINATION
      IF(NSTOP.NE.0)GO TO 1
C...
C...  CHECK FOR THE END OF THE RUN
      IF(TV.LT.(TF-0.5*TP))GO TO 4
C...
C...  THE CURRENT RUN IS COMPLETE, SO PRINT THE COMPUTATIONAL STAT-
C...  ISTICS FOR LSODE AND GO ON TO THE NEXT RUN
      WRITE(NO,8)RWORK(11),IWORK(14),IWORK(11),IWORK(12),IWORK(13)
8     FORMAT(1H ,//,' COMPUTATIONAL STATISTICS'                    ,//,
     1 ' LAST STEP SIZE                       ',              E10.3,//,
     2 ' LAST ORDER OF THE METHOD             ',                I10,//,
     3 ' TOTAL NUMBER OF STEPS TAKEN          ',                I10,//,
     4 ' NUMBER OF FUNCTION EVALUATIONS       ',                I10,//,
     5 ' NUMBER OF JACOBIAN EVALUATIONS       ',                I10,/)
      GO TO 1
C...
C...  *****************************************************************
C...
C...  FORMATS
C...
1000  FORMAT(20A4)
1001  FORMAT(3E10.0)
1002  FORMAT(4I5,2X,A3,E10.0)
1003  FORMAT(1H1,
     1 ' RUN NO. - ',I3,2X,20A4,//,
     2 ' INITIAL T - ',E10.3,//,
     3 '   FINAL T - ',E10.3,//,
     4 '   PRINT T - ',E10.3,//,
     5 ' NUMBER OF DIFFERENTIAL EQUATIONS - ',I3,//,
     6 ' PRINT INTERVAL/MINIMUM INTEGRATION INTERVAL - ',I5,//,
     7 ' INTEGRATION ALGORITHM - ',I2,' - LSODE ',//,
     8 ' INTEGRATION ERROR MESSAGES - ',I1,//,
     9 ' ERROR CRITERION - ',A3,//,
     A ' MAXIMUM INTEGRATION ERROR - ',E10.3,//,
     B 1H1)
1004  FORMAT(1H ,//,' ISTATE = ',I3,//,
     1 ' INDICATING AN INTEGRATION ERROR, SO THE CURRENT RUN'     ,/,
     2 ' IS TERMINATED.  PLEASE REFER TO THE DOCUMENTATION FOR'   ,/,
     3 ' SUBROUTINE',//,25X,'LSODE',//,
     4 ' FOR AN EXPLANATION OF THESE ERROR INDICATORS'            )
      END
      SUBROUTINE FCN(NEQN,TV,YV,YDOT)
C...
C...  SUBROUTINE FCN IS AN INTERFACE ROUTINE BETWEEN SUBROUTINES LSODE
C...  AND DERV
C...
C...  DSS/2 COMMON AREA
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/      Y(1)
     2      /F/      F(1)
C...
C...  VARIABLE DIMENSION THE DEPENDENT AND DERIVATIVE ARRAYS
      DIMENSION YV(NEQN), YDOT(NEQN)
C...
C...  TRANSFER THE INDEPENDENT VARIABLE, DEPENDENT VARIABLE VECTOR
C...  FOR USE IN SUBROUTINE DERV
      T=TV
      DO 1 I=1,NEQN
      Y(I)=YV(I)
1     CONTINUE
C...
C...  EVALUATE THE DERIVATIVE VECTOR
      CALL DERV
C...
C...  TRANSFER THE DERIVATIVE VECTOR FOR USE BY SUBROUTINE LSODE
      DO 2 I=1,NEQN
      YDOT(I)=F(I)
2     CONTINUE
      RETURN
      END
      SUBROUTINE INITAL
C...
C...  ONE-DIMENSIONAL BURGERS' EQUATION WITH DIRICHLET AND NEUMANN
C...  BOUNDARY CONDITIONS, ILLUSTRATING THE NUMERICAL METHOD OF LINES
C...  INTEGRATION OF ONE-DIMENSIONAL ELLIPTIC, HYPERBOLIC AND PARABOLIC
C...  PARTIAL DIFFERENTIAL EQUATIONS (PDES) - IMPLICIT (STIFF) TIME
C...  INTEGRATION BY LSODE
C...
C...  THIS PROBLEM ILLUSTRATES THE METHOD OF LINES PROGRAMMING OF A
C...  ONE-DIMENSIONAL HYPERBOLIC-PARABOLIC (CONVECTIVE-DIFFUSION)
C...  PARTIAL DIFFERENTIAL EQUATION (PDE), THE WELL-KNOWN BURGERS'
C...  EQUATION
C...
C...     U  = -U*U  + VIS*U                                     (1)
C...      T       X        XX
C...
C...  WHERE
C...
C...     U       DEPENDENT VARIABLE TO BE COMPUTED
C...
C...     T       INITIAL-VALUE INDEPENDENT VARIABLE (TYPICALLY TIME)
C...
C...     X       BOUNDARY-VALUE INDEPENDENT VARIABLE (TYPICALLY SPACE)
C...
C...     VIS     COEFFICIENT, TYPICALLY A VISCOSITY, WHICH CHANGES THE
C...             CHARACTER OF EQUATION (1)
C...
C...                VIS LARGE - EQUATION (1) IS STRONGLY PARABOLIC
C...
C...                VIS SMALL - EQUATION (1) IS STRONGLY HYPERBOLIC
C...
C...  A LETTER SUBSCRIPT DENOTES A PARTIAL DERIVATIVE, E.G., U  IS THE
C...                                                          T
C...  FIRST-ORDER PARTIAL DERIVATIVE OF U WITH RESPECT TO T.
C...
C...  EQUATION (1) IS A WELL-ESTABLISHED TEST PROBLEM FOR PDE SOFTWARE
C...  BECAUSE IT
C...
C...     (1)  HAS AN EXACT SOLUTION (A), E.G.,
C...
C...             U(X,T) = 1/(1 + EXP(X/(2*VIS) - T/(4*VIS)))    (2)
C...
C...           (A)  BENTON, E. R., AND G. W. PLATZMAN, A TABLE OF
C...           SOLUTIONS OF THE ONE-DIMENSIONAL BURGERS EQUATION,
C...           QUARTERLY OF APPLIED MATHEMATICS, JULY, 1972, PP
C...           195-212.
C...
C...     (2)  IS A STRINGENT TEST PROBLEM, PARTICULARLY FOR SMALL VIS,
C...          FOR WHICH THE SOLUTION EXHIBITS STEEP, MOVING FRONTS.
C...
C...  IN THE SUBSEQUENT PROGRAMMING OF EQUATION (1), THE INITIAL AND
C...  BOUNDARY CONDITIONS HAVE BEEN CHOSEN TO BE CONSISTENT WITH
C...  EQUATION (2).  ALSO, VIS = 1.0, WHICH GIVES EQUATION (1) A
C...  MIXED HYPERBOLIC-PARABOLIC CHARACTER, RESULTS IN A VERY SMOOTH
C...  SOLUTION FROM EQUATION (2), I.E., THIS CHOICE OF VIS WAS MADE
C...  TO FACILITATE THE CALCULATION OF THE NUMERICAL SOLUTION IN ORDER
C...  TO DEMONSTRATE VARIOUS COMPUTATIONAL AND PROGRAMMING PROCEDURES
C...  WITH A MODEST COMPUTING EFFORT.
C...
C...  EQUATION (1) IS INTEGRATED BY THE NUMERICAL METHOD OF LINES IN
C...  THE SUBSEQUENT PROGRAMMING FOR TWO TYPES OF BOUNDARY CONDITIONS
C...  AT X = 0 AND X = XL (IN THE SUBSEQUENT DISCUSSION, XL HAS THE
C...  NUMERICAL VALUE XL = 1)
C...
C...     (1)  DIRICHLET BOUNDARY CONDITIONS IN WHICH U(0,T) AND
C...          U(XL,T) ARE SPECIFIED
C...
C...     (2)  NEUMANN BOUNDARY CONDITIONS IN WHICH U (0,T) AND
C...          U (XL,T) ARE SPECIFIED                X
C...           X
C...
C...  ALSO, TWO APPROACHES TO THE CALCULATION OF THE DERIVATIVE U
C...                                                             XX
C...  (WHICH WILL SUBSEQUENTLY BE DESIGNATED WITH THE IN-LINE NOTATION
C...  UXX) IN EQUATION (1) ARE USED
C...
C...     (1)  STAGEWISE DIFFERENTIATION, I.E., UX IS CALCULATED FROM U
C...          AND THEN UXX IS CALCULATED FROM UX
C...
C...     (2)  DIRECT DIFFERENTIATION, I.E., UXX IS CALCULATED DIRECTLY
C...          FROM U
C...
C...  THUS, THERE ARE A TOTAL OF FOUR COMBINATIONS (2 TYPES OF BOUNDARY
C...  CONDITIONS X 2 TYPES OF UXX CALCULATIONS) IN SUBROUTINES DERV1,
C...  DERV2, DERV3 AND DERV4.  COMMENTS ARE GIVEN IN EACH OF THESE
C...  SUBROUTINES EXPLAINING THE PROGRAMMING IN DETAIL.
C...
C...  SINCE THE EXACT SOLUTION, EQUATION (2), IS AVAILABLE, THE ERROR
C...  IN THE NUMERICAL SOLUTION CAN BE COMPUTED.  IN PARTICULAR, THE
C...  ERROR IN U(X=XL/2,T=1.0) IS COMPUTED FOR 11, 21, 31, 41 AND 51
C...  GRID POINTS IN X IN THE NUMERICAL METHOD OF LINES SOLUTION.  THIS
C...  ERROR IS THEN PLOTTED VS THE GRID SPACING LOGARITHMICALLY AT THE
C...  END OF THE 20TH RUN (4 COMBINATIONS MENTIONED PREVIOUSLY X 5
C...  NUMBERS OF GRID POINTS FOR EACH COMBINATION).  THESE CALCULATIONS,
C...  AND THE ASSOCIATED PLOTTING, ARE EXPLAINED IN THE COMMENTS IN
C...  SUBROUTINE PRINT.
C...
C...  THE EXACT SOLUTION IN THIS CASE IS (WITH X = XL/2 = 0.5, T = 1)
C...
C...     U(0.5,1.0) = 1/(1 + EXP(0.5/(2*VIS) - 1/(4*VIS)))
C...
C...                = 1/(1 + EXP(0)) = 1/2 = 0.5
C...
C...  NOTE THAT THIS RESULT IS INDEPENDENT OF VIS.  THUS, VIS CAN BE
C...  DECREASED TO MAKE THE NUMERICAL SOLUTION MORE DIFFICULT TO
C...  COMPUTE, I.E., THE PROBLEM IS MORE HYPERBOLIC AND LESS PARABOLIC,
C...  YET THE NUMERICAL SOLUTION SHOULD REMAIN CLOSE TO 0.5 IF REASON-
C...  ABLE ACCURACY IS TO BE MAINTAINED.
C...
C...  IN ADDITION TO THE COMMENTS IN THE FOLLOWING CODING, THE READER
C...  CAN ALSO REFER TO THE COMMENTS IN THE SPATIAL DIFFERENTIATION
C...  ROUTINES, DSS004, DSS020 AND DSS044.  IN PARTICULAR, CENTERED
C...  APPROXIMATIONS IN SUBROUTINES DSS004 AND DSS044 ARE USED TO
C...  CALCULATE UXX IN EQUATION (1), I.E., CENTERED APPROXIMATIONS
C...  SHOULD BE USED IN PARABOLIC PROBLEMS, AND NONCENTERED (FIVE-
C...  POINT BIASED UPWIND) APPROXIMATIONS IN SUBROUTINE DSS020 ARE
C...  USED TO CALCULATE UX IN EQUATION (1), I.E., NONCENTERED
C...  APPROXIMATIONS SHOULD BE USED IN HYPERBOLIC PROBLEMS.  ALL
C...  OF THESE APPROXIMATIONS ARE DERIVED FROM THE TAYLOR SERIES
C...  AS EXPLAINED IN THE THREE SUBROUTINES.
C...
C...  TWO SPECIAL CASES OF THIS PROBLEM CAN BE CONSIDERED
C...
C...     (1)  VIS = 0
C...
C...     IN THIS CASE, EQUATION (1) REDUCES TO
C...
C...     U  = -U*U  = -(U**2) /2                                (3)
C...      T       X          X
C...
C...     EQUATION (3) HAS THE ANALYTICAL SOLUTION
C...
C...     U(X,T) = X/(1 + T)                                     (4)
C...
C...     THE USE OF EQUATIONS (3) AND (4) IN THE FOLLOWING PROGRAMMING
C...     REQUIRES SOME MODIFICATION OF THE PROGRAMMING.
C...
C...     (2)  BOUNDARY-VALUE ORDINARY DIFFERENTIAL EQUATION (ODE)
C...
C...     THE STEADY STATE FORM OF EQUATION (1) IS THE BOUNDARY-VALUE
C...     ORDINARY DIFFERENTIAL EQUATION
C...
C...     U   - U*U  = 0                                         (5)
C...      XX      X
C...
C...     (NOTE THAT U  = 0 IN EQUATION (1)), WHICH CAN ALSO BE CONSIDER-
C...                 T
C...     AS A ONE-DIMENSIONAL ELLIPTIC PDE (WITH ONE INDEPENDENT VARI-
C...     ABLE, X).
C...
C...     EQUATION (5) CAN BE SOLVED SUBJECT TO TWO BOUNDARY CONDITIONS
C...     BY ALLOWING THE SOLUTION OF EQUATION (1) TO PROCEED TO U  = 0.
C...                                                             T
C...     (AN EXACT SOLUTION CAN ALSO BE EASILY DERIVED).  IF THE BOUND-
C...     ARY CONDITIONS ARE SELECTED AS U(0,INF) = U(XL,INF) = 1, THE
C...     EXACT SOLUTION IS U(X,INF) = 1.  THIS SOLUTION CAN BE DEMON-
C...     STRATED BY ALLOWING THE NUMERICAL SOLUTION TO EQUATION (1) TO
C...     PROCEED TO T = INF, I.E., U  = 0.
C...                                T
C...
C...     THIS DISCUSSION SUGGESTS A GENERAL METHOD FOR SOLVING BOUNDARY-
C...     VALUE ODES, I.E., A PSEUDO TIME DERIVATIVE IS ADDED TO THE ODES
C...     AND THE RESULTING PDES ARE INTEGRATED TO STEADY STATE FOR WHICH
C...     THE TIME DERIVATIVES ESSENTIALLY GO TO ZERO.  THIS APPROACH HAS
C...     BEEN USED EFFECTIVELY IN THE SOLUTION OF SOME RELATIVELY COM-
C...     PLEX BOUNDARY-VALUE ODES (WHICH, AGAIN, CAN ALSO BE CONSIDERED
C...     ONE-DIMENSIONAL ELLIPTIC PDES).  THIS APPROACH IS ALSO TERMED
C...     THE METHOD OF FALSE TRANSIENTS.
C...
C...  FINALLY, THE VERIFICATION OF EQUATION (2) AS A SOLUTION TO EQUA-
C...  TION (1) FOLLOWS:
C...
C...  LET EX = EXP(X/(2*VIS) - T/(4*VIS)).  THEN EQUATION (2) CAN BE
C...  WRITTEN AS:
C...
C...     U(X,T) = 1/(1 + EX)
C...
C...  THE VARIOUS TERMS IN EQUATION (1) ARE:
C...
C...     U  = (-1/(1 + EX)**2)*EX*(-1/(4*VIS))
C...      T
C...
C...     U*U  = (1/(1 + EX))*(-1/(1 + EX)**2)*EX*(1/(2*VIS))
C...        X
C...
C...     -VIS*U   = -VIS*((-1/(1 + EX)**2)*EX*(1/(2*VIS))**2
C...           XX
C...
C...              + EX*(1/(2*VIS)*2/(1 + EX)**3)*EX*(1/(2*VIS)))
C...
C...  SUMMATION OF THESE TERMS GIVES:
C...
C...     0 = (1/(1 + EX)**2)*EX*(1/(4*VIS))*(1 + 1)
C...
C...       - (1/(1 + EX)**3)*EX*(1/(2*VIS))*(1 + EX)
C...
C...       = 0
C...
C...  WE NOW PROCEED TO THE NUMERICAL METHOD OF LINES SOLUTION OF EQUA-
C...  TION (1) SUBJECT TO DIRICHLET AND NEUMANN BOUNDARY CONDITIONS, AND
C...  AN INITIAL CONDITION, WHICH ARE CONSISTENT WITH THE EXACT SOLU-
C...  TION, EQUATION (2).
C...
C...  DSS/2 COMMON
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/     U(51)
     2      /F/    UT(51)
     3      /S/    UX(51),   UXX(51)
     4      /R/       VIS,        XL,     X(51)
     5      /I/         N,        IP
C...
C...  EQUATION PARAMETERS
      VIS=1.0
      XL =1.0E+00
C...
C...  NUMBER OF GRID POINTS
C...     DIRICHLET BOUNDARY CONDITIONS
         IF((NORUN- 1)*(NORUN- 6).EQ.0)N=11
         IF((NORUN- 2)*(NORUN- 7).EQ.0)N=21
         IF((NORUN- 3)*(NORUN- 8).EQ.0)N=31
         IF((NORUN- 4)*(NORUN- 9).EQ.0)N=41
         IF((NORUN- 5)*(NORUN-10).EQ.0)N=51
C...
C...     NEUMANN BOUNDARY CONDITIONS
         IF((NORUN-11)*(NORUN-16).EQ.0)N=11
         IF((NORUN-12)*(NORUN-17).EQ.0)N=21
         IF((NORUN-13)*(NORUN-18).EQ.0)N=31
         IF((NORUN-14)*(NORUN-19).EQ.0)N=41
         IF((NORUN-15)*(NORUN-20).EQ.0)N=51
C...
C...  INITIAL CONDITIONS (T = 0 IN EQUATION (2))
      DO 1 I=1,N
      X(I)=XL*FLOAT(I-1)/FLOAT(N-1)
      U(I)=UA(X(I),T,VIS)
1     CONTINUE
C...
C...  INITIAL DERIVATIVES
      CALL DERV
      IP=0
      RETURN
      END
      SUBROUTINE DERV
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/     U(51)
     2      /F/    UT(51)
     3      /S/    UX(51),   UXX(51)
     4      /R/       VIS,        XL,     X(51)
     5      /I/         N,        IP
C...
C...  DIRICHLET BOUNDARY CONDITIONS, STAGEWISE DIFFERENTIATION
      IF((NORUN.GE. 1).AND.(NORUN.LE. 5))CALL DERV1
C...
C...  DIRICHLET BOUNDARY CONDITIONS, DIRECT DIFFERENTIATION
      IF((NORUN.GT. 6).AND.(NORUN.LE.10))CALL DERV2
C...
C...  NEUMANN BOUNDARY CONDITIONS, STAGEWISE DIFFERENTIATION
      IF((NORUN.GE.11).AND.(NORUN.LE.15))CALL DERV3
C...
C...  NEUMANN BOUNDARY CONDITIONS, DIRECT DIFFERENTIATION
      IF((NORUN.GE.16).AND.(NORUN.LE.20))CALL DERV4
      RETURN
      END
      SUBROUTINE DERV1
C...
C...  DIRICHLET BOUNDARY CONDITIONS, STAGEWISE DIFFERENTIATION
C...
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/     U(51)
     2      /F/    UT(51)
     3      /S/    UX(51),   UXX(51)
     4      /R/       VIS,        XL,     X(51)
     5      /I/         N,        IP
C...
C...     X = 0 (X = 0 IN EQUATION (2))
         U(1)=UA(X(1),T,VIS)
C...
C...     X = XL (X = XL IN EQUATION (2))
         U(N)=UA(X(N),T,VIS)
C...
C...  SPATIAL DERIVATIVES
C...
C...     UX IN UXX (BY FIVE-POINT CENTERED APPROXIMATIONS)
         CALL DSS004(0.0E+00,XL,N,U,UX)
C...
C...     UXX (BY FIVE-POINT CENTERED APPROXIMATIONS)
         CALL DSS004(0.0E+00,XL,N,UX,UXX)
C...
C...     UX IN U*UX (BY FIVE-POINT BIASED UPWIND APPROXIMATIONS)
         CALL DSS020(0.0E+00,XL,N,U,UX,1.0E+00)
C...
C...  BURGERS' EQUATION
C...
C...     X = 0
         UT(1)=0.0E+00
C...
C...     0 LT X LT XL
         NM1=N-1
         DO 1 I=2,NM1
         UT(I)=-U(I)*UX(I)+VIS*UXX(I)
1        CONTINUE
C...
C...     X = XL
         UT(N)=0.0E+00
      RETURN
      END
      SUBROUTINE DERV2
C...
C...  DIRICHLET BOUNDARY CONDITIONS, DIRECT DIFFERENTIATION
C...
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/     U(51)
     2      /F/    UT(51)
     3      /S/    UX(51),   UXX(51)
     4      /R/       VIS,        XL,     X(51)
     5      /I/         N,        IP
C...
C...     X = 0 (X = 0 IN EQUATION (2))
         U(1)=UA(X(1),T,VIS)
C...
C...     X = XL (X = XL IN EQUATION (2))
         U(N)=UA(X(N),T,VIS)
C...
C...  SPATIAL DERIVATIVES
C...
C...     UXX (BY SECOND DERIVATIVE APPROXIMATIONS)
         CALL DSS044(0.0E+00,XL,N,U,UX,UXX,1,1)
C...
C...     UX IN U*UX (BY FIVE-POINT BIASED UPWIND APPROXIMATIONS)
         CALL DSS020(0.0E+00,XL,N,U,UX,1.0E+00)
C...
C...  BURGERS' EQUATION
C...
C...     X = 0
         UT(1)=0.0E+00
C...
C...     0 LT X LT XL
         NM1=N-1
         DO 1 I=2,NM1
         UT(I)=-U(I)*UX(I)+VIS*UXX(I)
1        CONTINUE
C...
C...     X = XL
         UT(N)=0.0E+00
      RETURN
      END
      SUBROUTINE DERV3
C...
C...  NEUMANN BOUNDARY CONDITIONS, STAGEWISE DIFFERENTIATION
C...
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/     U(51)
     2      /F/    UT(51)
     3      /S/    UX(51),   UXX(51)
     4      /R/       VIS,        XL,     X(51)
     5      /I/         N,        IP
C...
C...  SPATIAL DERIVATIVES
C...
C...     UX IN UXX (BY FIVE-POINT CENTERED APPROXIMATIONS)
         CALL DSS004(0.0E+00,XL,N,U,UX)
C...
C...     X = 0 (X = 0 IN EQUATION (2))
         UX(1)=DUA(X(1),T,VIS)
C...
C...     X = XL (X = XL IN EQUATION (2))
         UX(N)=DUA(X(N),T,VIS)
C...
C...     UXX (BY FIVE-POINT CENTERED APPROXIMATIONS)
         CALL DSS004(0.0E+00,XL,N,UX,UXX)
C...
C...     UX IN U*UX (BY FIVE-POINT BIASED UPWIND APPROXIMATIONS)
         CALL DSS020(0.0E+00,XL,N,U,UX,1.0E+00)
C...
C...     X = 0 (X = 0 IN EQUATION (2))
         UX(1)=DUA(X(1),T,VIS)
C...
C...     X = XL (X = XL IN EQUATION (2))
         UX(N)=DUA(X(N),T,VIS)
C...
C...  BURGERS' EQUATION
C...
C...     0 LE X LE XL
         DO 1 I=1,N
         UT(I)=-U(I)*UX(I)+VIS*UXX(I)
1        CONTINUE
      RETURN
      END
      SUBROUTINE DERV4
C...
C...  NEUMANN BOUNDARY CONDITIONS, DIRECT DIFFERENTIATION
C...
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/     U(51)
     2      /F/    UT(51)
     3      /S/    UX(51),   UXX(51)
     4      /R/       VIS,        XL,     X(51)
     5      /I/         N,        IP
C...
C...     X = 0 (X = 0 IN EQUATION (2))
         UX(1)=DUA(X(1),T,VIS)
C...
C...     X = XL (X = XL IN EQUATION (2))
         UX(N)=DUA(X(N),T,VIS)
C...
C...  SPATIAL DERIVATIVES
C...
C...     UXX (BY SECOND DERIVATIVE APPROXIMATIONS)
         CALL DSS044(0.0E+00,XL,N,U,UX,UXX,2,2)
C...
C...     UX IN U*UX (BY FIVE-POINT BIASED UPWIND APPROXIMATIONS)
         CALL DSS020(0.0E+00,XL,N,U,UX,1.0E+00)
C...
C...     X = 0 (X = 0 IN EQUATION (2))
         UX(1)=DUA(X(1),T,VIS)
C...
C...     X = XL (X = XL IN EQUATION (2))
         UX(N)=DUA(X(N),T,VIS)
C...
C...  BURGERS' EQUATION
C...
C...     0 LE X LE XL
         DO 1 I=1,N
         UT(I)=-U(I)*UX(I)+VIS*UXX(I)
1        CONTINUE
      RETURN
      END
      FUNCTION UA(X,T,VIS)
C...
C...  FUNCTION UA IMLEMENTS THE ANALYTICAL SOLUTION, EQUATION (2)
C...
      EX=EXP(X/(2.0E+00*VIS)-T/(4.0E+00*VIS))
      UA=1.0E+00/(1.0E+00+EX)
      RETURN
      END
      FUNCTION DUA(X,T,VIS)
C...
C...  FUNCTION DUA IMPLEMENTS THE DERIVATIVE OF THE ANALYTICAL SOLUTION,
C...  EQUATION (2), WITH RESPECT TO X
C...
      EX=EXP(X/(2.0E+00*VIS)-T/(4.0E+00*VIS))
      DUA=-1.0E+00*(1.0E+00+EX)**(-2)*EX*(1.0E+00/(2.0E+00*VIS))
      RETURN
      END
      SUBROUTINE PRINT(NI,NO)
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/     U(51)
     2      /F/    UT(51)
     3      /S/    UX(51),   UXX(51)
     4      /R/       VIS,        XL,     X(51)
     5      /I/         N,        IP
C...
C...  DIMENSION THE ARRAYS FOR PLOTTING
      DIMENSION DXP(5), EP1(2,5), EP2(2,5)
C...
C...  PRINT A HEADING FOR THE NUMERICAL SOLUTION
      IP=IP+1
      IF(IP.EQ.1)WRITE(NO,1)
1     FORMAT(11X,'T',7X,'U(XL/2,T)',6X,'U(XL/2,T)',8X,'ERROR',/,
     1              19X,'  (NUM)  ',6X,'  (ANAL) ')
C...
C...  COMPUTE THE ANALYTICAL SOLUTION AND THE ERROR IN THE NUMERICAL
C...  SOLUTION AT X = XL/2
      N2=N/2+1
      XL2=X(N2)
      UANAL=UA(XL2,T,VIS)
      ERROR=U(N2)-UANAL
C...
C...  PRINT THE NUMERICAL AND ANALYTICAL SOLUTIONS, AND THE ERROR
      WRITE(NO,2)T,U(N2),UANAL,ERROR
2     FORMAT(F12.2,2F15.6,E16.4)
C...
C...  STORE THE SOLUTION U(X=0.5,T=1.0)FOR PLOTTING
C...
C...     THE ERRORS FOR NORUN = 1 TO 5 (NPLOT = 1), AND NORUN = 6 TO
C...     10 (NPLOT = 2) ARE PLOTTED VS THE GRID SPACING ON THE SAME
C...     LOG-LOG PLOT (DIRICHLET BOUNDARY CONDITIONS)
         IF((T.GT.0.95E+00).AND.(T.LT.1.05E+00))THEN
C...
C...        NPLOT=1
            IF((NORUN.GE. 1).AND.(NORUN.LE. 5))THEN
               NPLOT=1
               DXP(NORUN)=ALOG10(XL/FLOAT(N-1))
               EP1(NPLOT,NORUN-0)=ALOG10(ABS(ERROR))
C...
C...        NPLOT=2
            ELSE IF((NORUN.GE. 6).AND.(NORUN.LE.10))THEN
               NPLOT=2
               EP1(NPLOT,NORUN-5)=ALOG10(ABS(ERROR))
            END IF
C...
C...     THE ERRORS FOR NORUN = 11 TO 15 (NPLOT = 1), AND NORUN = 16 TO
C...     10 (NPLOT = 2) ARE PLOTTED VS THE GRID SPACING ON THE SAME
C...     LOG-LOG PLOT (NEUMANN BOUNDARY CONDITIONS)
C...
C...        NPLOT = 1
            IF((NORUN.GE.11).AND.(NORUN.LE.15))THEN
               NPLOT=1
               EP2(NPLOT,NORUN-10)=ALOG10(ABS(ERROR))
C...
C...        NPLOT=2
            ELSE IF((NORUN.GE.16).AND.(NORUN.LE.20))THEN
               NPLOT=2
               EP2(NPLOT,NORUN-15)=ALOG10(ABS(ERROR))
            END IF
         END IF
C...
C...  PLOT THE ERROR VS GRID SPACING AT THE END OF FOUR SERIES OF FIVE
C...  RUNS
      IF((T.GT.1.95E+00).AND.(T.LT.2.05E+00).AND.(NORUN.EQ.20))THEN
C...
C...     DIRICHLET BC
         CALL TPLOTS(2,5,DXP,EP1)
C...
C...     PRINT A LABEL FOR THE PLOT
         WRITE(NO,11)
11       FORMAT(
     1 ' DIRICHLET BC, LOG(ERROR) VS LOG(DX)')
C...
C...     NEUMANN BC
         CALL TPLOTS(2,5,DXP,EP2)
C...
C...     PRINT A LABEL FOR THE PLOT
         WRITE(NO,12)
12       FORMAT(
     1 ' NEUMANN BC, LOG(ERROR) VS LOG(DX)')
      END IF
      RETURN
      END
ONE-D BURGERS' EQUATION, DIRICHLET BC, STAGEWISE DIFFERENTIATION, N = 11
0.        2.0       0.2
   11 1000    1    1  REL 0.001
ONE-D BURGERS' EQUATION, DIRICHLET BC, STAGEWISE DIFFERENTIATION, N = 21
0.        2.0       0.2
   21 1000    1    1  REL 0.001
ONE-D BURGERS' EQUATION, DIRICHLET BC, STAGEWISE DIFFERENTIATION, N = 31
0.        2.0       0.2
   31 1000    1    1  REL 0.001
ONE-D BURGERS' EQUATION, DIRICHLET BC, STAGEWISE DIFFERENTIATION, N = 41
0.        2.0       0.2
   41 1000    1    1  REL 0.001
ONE-D BURGERS' EQUATION, DIRICHLET BC, STAGEWISE DIFFERENTIATION, N = 51
0.        2.0       0.2
   51 1000    1    1  REL 0.001
ONE-D BURGERS' EQUATION, DIRICHLET BC, DIRECT DIFFERENTIATION, N = 11
0.        2.0       0.2
   11 1000    1    1  REL 0.001
ONE-D BURGERS' EQUATION, DIRICHLET BC, DIRECT DIFFERENTIATION, N = 21
0.        2.0       0.2
   21 1000    1    1  REL 0.001
ONE-D BURGERS' EQUATION, DIRICHLET BC, DIRECT DIFFERENTIATION, N = 31
0.        2.0       0.2
   31 1000    1    1  REL 0.001
ONE-D BURGERS' EQUATION, DIRICHLET BC, DIRECT DIFFERENTIATION, N = 41
0.        2.0       0.2
   41 1000    1    1  REL 0.001
ONE-D BURGERS' EQUATION, DIRICHLET BC, DIRECT DIFFERENTIATION, N = 51
0.        2.0       0.2
   51 1000    1    1  REL 0.001
ONE-D BURGERS' EQUATION, NEUMANN BC, STAGEWISE DIFFERENTIATION, N = 11
0.        2.0       0.2
   11 1000    1    1  REL 0.001
ONE-D BURGERS' EQUATION, NEUMANN BC, STAGEWISE DIFFERENTIATION, N = 21
0.        2.0       0.2
   21 1000    1    1  REL 0.001
ONE-D BURGERS' EQUATION, NEUMANN BC, STAGEWISE DIFFERENTIATION, N = 31
0.        2.0       0.2
   31 1000    1    1  REL 0.001
ONE-D BURGERS' EQUATION, NEUMANN BC, STAGEWISE DIFFERENTIATION, N = 41
0.        2.0       0.2
   41 1000    1    1  REL 0.001
ONE-D BURGERS' EQUATION, NEUMANN BC, STAGEWISE DIFFERENTIATION, N = 51
0.        2.0       0.2
   51 1000    1    1  REL 0.001
ONE-D BURGERS' EQUATION, NEUMANN BC, DIRECT DIFFERENTIATION, N = 11
0.        2.0       0.2
   11 1000    1    1  REL 0.001
ONE-D BURGERS' EQUATION, NEUMANN BC, DIRECT DIFFERENTIATION, N = 21
0.        2.0       0.2
   21 1000    1    1  REL 0.001
ONE-D BURGERS' EQUATION, NEUMANN BC, DIRECT DIFFERENTIATION, N = 31
0.        2.0       0.2
   31 1000    1    1  REL 0.001
ONE-D BURGERS' EQUATION, NEUMANN BC, DIRECT DIFFERENTIATION, N = 41
0.        2.0       0.2
   41 1000    1    1  REL 0.001
ONE-D BURGERS' EQUATION, NEUMANN BC, DIRECT DIFFERENTIATION, N = 51
0.        2.0       0.2
   51 1000    1    1  REL 0.001
END OF RUNS
*APP MATH37
      SUBROUTINE INITAL
C...
C...  TWO-DIMENSIONAL BURGERS' EQUATION WITH DIRICHLET AND NEUMANN
C...  BOUNDARY CONDITIONS, ILLUSTRATING THE NUMERICAL METHOD OF LINES
C...  INTEGRATION OF TWO-DIMENSIONAL ELLIPTIC, HYPERBOLIC AND PARABOLIC
C...  PARTIAL DIFFERENTIAL EQUATIONS (PDES)
C...
C...  THIS PROBLEM ILLUSTRATES THE METHOD OF LINES PROGRAMMING OF A
C...  TWO-DIMENSIONAL HYPERBOLIC-PARABOLIC (CONVECTIVE-DIFFUSION)
C...  PARTIAL DIFFERENTIAL EQUATION (PDE), THE WELL-KNOWN BURGERS'
C...  EQUATION
C...
C...     U  = -U*U  + VIS*U   - U*U  + VIS*U                   (1)
C...      T       X        XX      Y        YY
C...
C...  WHERE
C...
C...     U       DEPENDENT VARIABLE TO BE COMPUTED
C...
C...     T       INITIAL-VALUE INDEPENDENT VARIABLE (TYPICALLY TIME)
C...
C...     X,Y     BOUNDARY-VALUE INDEPENDENT VARIABLES (TYPICALLY SPACE)
C...
C...     VIS     COEFFICIENT, TYPICALLY A VISCOSITY, WHICH CHANGES THE
C...             CHARACTER OF EQUATION (1)
C...
C...                VIS LARGE - EQUATION (1) IS STRONGLY PARABOLIC
C...
C...                VIS SMALL - EQUATION (1) IS STRONGLY HYPERBOLIC
C...
C...  A LETTER SUBSCRIPT DENOTES A PARTIAL DERIVATIVE, E.G., U  IS THE
C...                                                          T
C...  FIRST-ORDER PARTIAL DERIVATIVE OF U WITH RESPECT TO T.
C...
C...  EQUATION (1) IS A WELL-ESTABLISHED TEST PROBLEM FOR PDE SOFTWARE
C...  BECAUSE IT
C...
C...     (1)  HAS AN EXACT SOLUTION, E.G.,
C...
C...          U(X,Y,T) =
C...                                                            (2)
C...          1/(1 + EXP(X/(2*VIS) + Y/(2*VIS) - 2*T/(4*VIS)))
C...
C...     (2)  IS A STRINGENT TEST PROBLEM, PARTICULARLY FOR SMALL VIS,
C...          FOR WHICH THE SOLUTION EXHIBITS STEEP, MOVING FRONTS.
C...
C...  IN THE SUBSEQUENT PROGRAMMING OF EQUATION (1), THE INITIAL AND
C...  BOUNDARY CONDITIONS HAVE BEEN CHOSEN TO BE CONSISTENT WITH
C...  EQUATION (2).  ALSO, VIS = 1.0, WHICH GIVES EQUATION (1) A
C...  MIXED HYPERBOLIC-PARABOLIC CHARACTER, RESULTS IN A VERY SMOOTH
C...  SOLUTION FROM EQUATION (2), I.E., THIS CHOICE OF VIS WAS MADE
C...  TO FACILITATE THE CALCULATION OF THE NUMERICAL SOLUTION IN ORDER
C...  TO DEMONSTRATE VARIOUS COMPUTATIONAL AND PROGRAMMING PROCEDURES
C...  WITH A MODEST COMPUTING EFFORT.
C...
C...  EQUATION (1) IS INTEGRATED BY THE NUMERICAL METHOD OF LINES IN
C...  THE SUBSEQUENT PROGRAMMING FOR TWO TYPES OF BOUNDARY CONDITIONS
C...  AT X = 0 AND X =XL, Y = 0 AND Y = YL (IN THE SUBSEQUENT DISCUSSION
C...  XL AND YL HAVE THE NUMERICAL VALUES XL = YL = 1)
C...
C...     (1)  DIRICHLET BOUNDARY CONDITIONS IN WHICH U(0,Y,T),
C...          U(X,0,T), U(XL,Y,T) AND U(X,YL,T) ARE SPECIFIED
C...
C...     (2)  NEUMANN BOUNDARY CONDITIONS IN WHICH U (0,Y,T),
C...                                                X
C...          U (X,YL,T), U (X,0,T) AND U (XL,Y,T) ARE SPECIFIED.
C...           X           Y             Y
C...
C...  IN THE SUBSEQUENT DISCUSSION, THE DERIVATIVES IN EQUATION (1)
C...  WILL BE DESIGNATED WITH IN-LINE NOTATION, E.G., U   WILL BE
C...                                                   XX
C...  DESIGNATED UXX.
C...
C...  SINCE THE EXACT SOLUTION, EQUATION (2), IS AVAILABLE, THE ERROR
C...  IN THE NUMERICAL SOLUTION CAN BE COMPUTED.  IN PARTICULAR, THE
C...  ERROR IN U(X=XL/2,Y=YL/2,T=1) IS COMPUTED FROM THE FOLLOWING
C...  APPLICATION OF EQUATION (2)
C...
C...  U(0.5,0.5,1) = 1/(1 + EXP(0.5/(2*VIS) +0.5/(2*VIS) - 2*1/(4*VIS)))
C...
C...                 = 1/(1 + EXP(0)) = 0.5
C...
C...  NOTE THAT THIS RESULT IS INDEPENDENT OF VIS.  THUS, VIS CAN BE
C...  DECREASED TO MAKE THE NUMERICAL SOLUTION MORE DIFFICULT TO
C...  COMPUTE, I.E., THE PROBLEM IS MORE HYPERBOLIC AND LESS PARABOLIC,
C...  YET THE NUMERICAL SOLUTION SHOULD REMAIN CLOSE TO 0.5 IF REASON-
C...  ABLE ACCURACY IS TO BE MAINTAINED.
C...
C...  IN ADDITION TO THE COMMENTS IN THE FOLLOWING CODING, THE READER
C...  CAN ALSO REFER TO THE COMMENTS IN THE SPATIAL DIFFERENTIATION
C...  SUBROUTINE, DSS034.  IN PARTICULAR, CENTERED APPROXIMATIONS IN
C...  SUBROUTINE DSS034 ARE USED TO CALCULATE UXX AND UYY IN EQUATION
C...  (1), I.E., CENTERED APPROXIMATIONS SHOULD BE USED IN PARABOLIC
C...  PROBLEMS, AND NONCENTERED (FIVE-POINT BIASED UPWIND) APPROXI-
C...  MATIONS IN SUBROUTINE DSS034 ARE USED TO CALCULATE UX AND UY IN
C...  EQUATION (1), I.E., NONCENTERED APPROXIMATIONS SHOULD BE USED
C...  IN HYPERBOLIC PROBLEMS.  ALL OF THESE APPROXIMATIONS ARE DERIVED
C...  FROM THE TAYLOR SERIES AS EXPLAINED IN DSS034, AND SUBORDINATE
C...  ROUTINES DSS004 AND DSS020.
C...
C...  TWO SPECIAL CASES OF THIS PROBLEM CAN BE CONSIDERED
C...
C...     (1)  VIS = 0
C...
C...     IN THIS CASE, EQUATION (1) REDUCES TO
C...
C...     U  = - U*U  - U*U  = - (U**2) /2 - (U**2) /2           (3)
C...      T        X      Y           X           Y
C...
C...     EQUATION (3) HAS THE ANALYTICAL SOLUTION
C...
C...     U(X,Y,T) = (X + Y)/(1 + 2*T)                           (4)
C...
C...     THE USE OF EQUATIONS (3) AND (4) IN THE FOLLOWING PROGRAMMING
C...     REQUIRES SOME MODIFICATION OF THE PROGRAMMING.
C...
C...     (2)  BOUNDARY-VALUE PARTIAL DIFFERENTIAL EQUATION (PDE)
C...
C...     THE STEADY STATE FORM OF EQUATION (1) IS THE BOUNDARY-VALUE
C...     PARTIAL DIFFERENTIAL EQUATION
C...
C...     U   - U*U  + U   - U*U  = 0                            (5)
C...      XX      X    YY      Y
C...
C...     (NOTE THAT U  = 0 IN EQUATION (1)), WHICH CAN ALSO BE CONSIDER-
C...                 T
C...     ED AS A TWO-DIMENSIONAL ELLIPTIC PDE (WITH INDEPENDENT VARI-
C...     ABLES X AND Y).  THUS, THE FOLLOWING PROGRAMMING ILLUSTRATES A
C...     METHOD FOR INTEGRATING ELLIPTIC PDES AS WELL AS HYPERBOLIC
C...     AND PARABOLIC PDES (BY ALLOWING THE SOLUTION OF EQUATION (1)
C...     TO PROCEED TO U  = 0, FOR WHICH EQUATION (2), WITH LARGE T,
C...                    T
C...     REDUCES TO:
C...
C...        U(X,Y,INF) = 1
C...
C...     THIS DISCUSSION SUGGESTS A GENERAL METHOD FOR SOLVING BOUNDARY-
C...     VALUE PDES, I.E., A PSEUDO TIME DERIVATIVE IS ADDED TO THE PDES
C...     AND THE RESULTING PDES ARE INTEGRATED TO STEADY STATE FOR WHICH
C...     THE TIME DERIVATIVES ESSENTIALLY GO TO ZERO.  THIS APPROACH HAS
C...     BEEN USED EFFECTIVELY IN THE SOLUTION OF SOME RELATIVELY COM-
C...     PLEX BOUNDARY-VALUE PDES.  THIS APPROACH IS ALSO TERMED THE
C...     METHOD OF FALSE TRANSIENTS.
C...
C...  FINALLY, THE VERIFICATION OF EQUATION (2) AS A SOLUTION TO EQUA-
C...  TION (1) FOLLOWS:
C...
C...  LET EX = EXP(X/(2*VIS) + Y/(2*VIS) - 2*T/(4*VIS)).  THEN EQUATION
C...  (2) CAN BE WRITTEN AS:
C...
C...     U(X,Y,T) = 1/(1 + EX)
C...
C...  THE VARIOUS TERMS IN EQUATION (1) ARE:
C...
C...     U  = (-1/(1 + EX)**2)*EX*(-2/(4*VIS))
C...      T
C...
C...     U*U  = (1/(1 + EX))*(-1/(1 + EX)**2)*EX*(1/(2*VIS))
C...        X
C...
C...     -VIS*U   = -VIS*((-1/(1 + EX)**2)*EX*(1/(2*VIS))**2
C...           XX
C...
C...              + EX*(1/(2*VIS)*2/(1 + EX)**3)*EX*(1/(2*VIS)))
C...
C...     U*U  = (1/(1 + EX))*(-1/(1 + EX)**2)*EX*(1/(2*VIS))
C...        Y
C...
C...     -VIS*U   = -VIS*((-1/(1 + EX)**2)*EX*(1/(2*VIS))**2
C...           YY
C...
C...              + EX*(1/(2*VIS)*2/(1 + EX)**3)*EX*(1/(2*VIS)))
C...
C...  SUMMATION OF THESE TERMS GIVES:
C...
C...     0 = (1/(1 + EX)**2)*EX*(1/(4*VIS))*(2 + 1 + 1)
C...
C...       - (1/(1 + EX)**3)*EX*(1/(2*VIS))*(1 + 1)*(1 + EX)
C...
C...       = 0
C...
C...  WE NOW PROCEED TO THE NUMERICAL METHOD OF LINES SOLUTION OF EQUA-
C...  TION (1) SUBJECT TO DIRICHLET AND NEUMANN BOUNDARY CONDITIONS, AND
C...  AN INITIAL CONDITION, WHICH ARE CONSISTENT WITH THE EXACT SOLU-
C...  TION, EQUATION (2).
C...
C...  DSS/2 COMMON
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/  U(11,11)
     2      /F/ UT(11,11)
     3      /S/ UX(11,11),UXX(11,11),
     4          UY(11,11),UYY(11,11)
     5      /R/        XL,        YL,
     6              X(11),     Y(11),
     7                VIS
     8      /I/        NX,        NY,
     9                 IP
C...
C...  EQUATION PARAMETERS
      VIS=1.0E+00
      XL=1.0E+00
      YL=1.0E+00
C...
C...  NUMBER OF GRID POINTS
      NX=11
      NY=11
C...
C...  INITIAL CONDITIONS (T = 0 IN EQUATION (2))
      DO 1 I=1,NX
      X(I)=XL*FLOAT(I-1)/FLOAT(NX-1)
      DO 1 J=1,NY
      Y(J)=YL*FLOAT(J-1)/FLOAT(NY-1)
      U(I,J)=UA(X(I),Y(J),T,VIS)
1     CONTINUE
C...
C...  INITIAL DERIVATIVES
      CALL DERV
      IP=0
      RETURN
      END
      SUBROUTINE DERV
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/  U(11,11)
     2      /F/ UT(11,11)
     3      /S/ UX(11,11),UXX(11,11),
     4          UY(11,11),UYY(11,11)
     5      /R/        XL,        YL,
     6              X(11),     Y(11),
     7                VIS
     8      /I/        NX,        NY,
     9                 IP
C...
C...  DIRICHLET BOUNDARY CONDITIONS WITH (1) UXX AND UYY CALCULATED BY
C...  CENTERED APPROXIMATIONS AND (2) UX AND UY CALCULATED BY BIASED
C...  UPWIND APPROXIMATIONS
      IF(NORUN.EQ.1)CALL DERV1
C...
C...  DIRICHLET BOUNDARY CONDITIONS WITH UXX, UYY, UX AND UY CALCULATED
C...  BY CENTERED APPROXIMATIONS
      IF(NORUN.EQ.2)CALL DERV2
C...
C...  NEUMANN BOUNDARY CONDITIONS WITH (1) UXX AND UYY CALCULATED BY
C...  CENTERED APPROXIMATIONS AND (2) UX AND UY CALCULATED BY BIASED
C...  UPWIND APPROXIMATIONS
      IF(NORUN.EQ.3)CALL DERV3
C...
C...  NEUMANN BOUNDARY CONDITIONS WITH UXX, UYY, UX AND UY CALCULATED
C...  BY CENTERED APPROXIMATIONS
      IF(NORUN.EQ.4)CALL DERV4
      RETURN
      END
      SUBROUTINE DERV1
C...
C...  DIRICHLET BOUNDARY CONDITIONS
C...
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/  U(11,11)
     2      /F/ UT(11,11)
     3      /S/ UX(11,11),UXX(11,11),
     4          UY(11,11),UYY(11,11)
     5      /R/        XL,        YL,
     6              X(11),     Y(11),
     7                VIS
     8      /I/        NX,        NY,
     9                 IP
C...
C...     X = 0, 0 LE Y LE YL (X = 0 IN EQUATION (2))
         DO 1 J=1,NY
         U(1,J)=UA(X(1),Y(J),T,VIS)
1        CONTINUE
C...
C...     X = XL, 0 LE Y LE YL (X = XL IN EQUATION (2))
         DO 2 J=1,NY
         U(NX,J)=UA(X(NX),Y(J),T,VIS)
2        CONTINUE
C...
C...     Y = 0, 0 LE X LE XL (Y = 0 IN EQUATION (2))
         DO 3 I=1,NX
         U(I,1)=UA(X(I),Y(1),T,VIS)
3        CONTINUE
C...
C...     Y = YL, 0 LE X LE XL (Y = YL IN EQUATION (2))
         DO 4 I=1,NX
         U(I,NY)=UA(X(I),Y(NY),T,VIS)
4        CONTINUE
C...
C...  SPATIAL DERIVATIVES
C...
C...     UX IN UXX (BY FIVE-POINT CENTERED APPROXIMATIONS)
         CALL DSS034(0.E+00,XL,NX,NY,1,U,UX,0.E+00)
C...
C...     UXX (BY FIVE-POINT CENTERED APPROXIMATIONS)
         CALL DSS034(0.E+00,XL,NX,NY,1,UX,UXX,0.E+00)
C...
C...     UX IN U*UX (BY FIVE-POINT BIASED UPWIND APPROXIMATIONS)
         CALL DSS034(0.E+00,XL,NX,NY,1,U,UX,1.0E+00)
C...
C...     UY IN UYY (BY FIVE-POINT CENTERED APPROXIMATIONS)
         CALL DSS034(0.E+00,YL,NX,NY,2,U,UY,0.E+00)
C...
C...     UYY (BY FIVE-POINT CENTERED APPROXIMATIONS)
         CALL DSS034(0.E+00,YL,NX,NY,2,UY,UYY,0.E+00)
C...
C...     UY IN U*UY (BY FIVE-POINT BIASED UPWIND APPROXIMATIONS)
         CALL DSS034(0.E+00,YL,NX,NY,2,U,UY,1.0E+00)
C...
C...  BURGERS' EQUATION
C...
         DO 10 I=1,NX
         DO 10 J=1,NY
         UT(I,J)=-U(I,J)*UX(I,J)+VIS*UXX(I,J)
     1           -U(I,J)*UY(I,J)+VIS*UYY(I,J)
10       CONTINUE
      RETURN
      END
      SUBROUTINE DERV2
C...
C...  DIRICHLET BOUNDARY CONDITIONS
C...
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/  U(11,11)
     2      /F/ UT(11,11)
     3      /S/ UX(11,11),UXX(11,11),
     4          UY(11,11),UYY(11,11)
     5      /R/        XL,        YL,
     6              X(11),     Y(11),
     7                VIS
     8      /I/        NX,        NY,
     9                 IP
C...
C...     X = 0, 0 LE Y LE YL (X = 0 IN EQUATION (2))
         DO 1 J=1,NY
         U(1,J)=UA(X(1),Y(J),T,VIS)
1        CONTINUE
C...
C...     X = XL, 0 LE Y LE YL (X = XL IN EQUATION (2))
         DO 2 J=1,NY
         U(NX,J)=UA(X(NX),Y(J),T,VIS)
2        CONTINUE
C...
C...     Y = 0, 0 LE X LE XL (Y = 0 IN EQUATION (2))
         DO 3 I=1,NX
         U(I,1)=UA(X(I),Y(1),T,VIS)
3        CONTINUE
C...
C...     Y = YL, 0 LE X LE XL (Y = YL IN EQUATION (2))
         DO 4 I=1,NX
         U(I,NY)=UA(X(I),Y(NY),T,VIS)
4        CONTINUE
C...
C...  SPATIAL DERIVATIVES
C...
C...     UX (BY FIVE-POINT CENTERED APPROXIMATIONS)
         CALL DSS034(0.E+00,XL,NX,NY,1,U,UX,0.E+00)
C...
C...     UXX (BY FIVE-POINT CENTERED APPROXIMATIONS)
         CALL DSS034(0.E+00,XL,NX,NY,1,UX,UXX,0.E+00)
C...
C...     UY (BY FIVE-POINT CENTERED APPROXIMATIONS)
         CALL DSS034(0.E+00,YL,NX,NY,2,U,UY,0.E+00)
C...
C...     UYY (BY FIVE-POINT CENTERED APPROXIMATIONS)
         CALL DSS034(0.E+00,YL,NX,NY,2,UY,UYY,0.E+00)
C...
C...  BURGERS' EQUATION
C...
         DO 10 I=1,NX
         DO 10 J=1,NY
         UT(I,J)=-U(I,J)*UX(I,J)+VIS*UXX(I,J)
     1           -U(I,J)*UY(I,J)+VIS*UYY(I,J)
10       CONTINUE
      RETURN
      END
      SUBROUTINE DERV3
C...
C...  NEUMANN BOUNDARY CONDITIONS
C...
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/  U(11,11)
     2      /F/ UT(11,11)
     3      /S/ UX(11,11),UXX(11,11),
     4          UY(11,11),UYY(11,11)
     5      /R/        XL,        YL,
     6              X(11),     Y(11),
     7                VIS
     8      /I/        NX,        NY,
     9                 IP
C...
C...  SPATIAL DERIVATIVES
C...
C...     UX IN UXX (BY FIVE-POINT CENTERED APPROXIMATIONS)
         CALL DSS034(0.E+00,XL,NX,NY,1,U,UX,0.E+00)
C...
C...     X = 0, 0 LE Y LE YL (X = 0 IN EQUATION (2))
         DO 1 J=1,NY
         UX(1,J)=DUA(X(1),Y(J),T,VIS)
1        CONTINUE
C...
C...     X = XL, 0 LE Y LE YL (X = XL IN EQUATION (2))
         DO 2 J=1,NY
         UX(NX,J)=DUA(X(NX),Y(J),T,VIS)
2        CONTINUE
C...
C...     UXX (BY FIVE-POINT CENTERED APPROXIMATIONS)
         CALL DSS034(0.E+00,XL,NX,NY,1,UX,UXX,0.E+00)
C...
C...     UX IN U*UX (BY FIVE-POINT BIASED UPWIND APPROXIMATIONS)
         CALL DSS034(0.E+00,XL,NX,NY,1,U,UX,1.0E+00)
C...
C...     X = 0, 0 LE Y LE YL (X = 0 IN EQUATION (2))
         DO 3 J=1,NY
         UX(1,J)=DUA(X(1),Y(J),T,VIS)
3        CONTINUE
C...
C...     X = XL, 0 LE Y LE YL (X = XL IN EQUATION (2))
         DO 4 J=1,NY
         UX(NX,J)=DUA(X(NX),Y(J),T,VIS)
4        CONTINUE
C...
C...     UY IN UYY (BY FIVE-POINT CENTERED APPROXIMATIONS)
         CALL DSS034(0.E+00,YL,NX,NY,2,U,UY,0.E+00)
C...
C...     Y = 0, 0 LE X LE XL (Y = 0 IN EQUATION (2))
         DO 5 I=1,NX
         UY(I,1)=DUA(X(I),Y(1),T,VIS)
5        CONTINUE
C...
C...     Y = YL, 0 LE X LE XL (Y = YL IN EQUATION (2))
         DO 6 I=1,NX
         UY(I,NY)=DUA(X(I),Y(NY),T,VIS)
6        CONTINUE
C...
C...     UYY (BY FIVE-POINT CENTERED APPROXIMATIONS)
         CALL DSS034(0.E+00,YL,NX,NY,2,UY,UYY,0.E+00)
C...
C...     UY IN U*UY (BY FIVE-POINT BIASED UPWIND APPROXIMATIONS)
         CALL DSS034(0.E+00,YL,NX,NY,2,U,UY,1.0E+00)
C...
C...     Y = 0, 0 LE X LE XL (Y = 0 IN EQUATION (2))
         DO 7 I=1,NX
         UY(I,1)=DUA(X(I),Y(1),T,VIS)
7        CONTINUE
C...
C...     Y = YL, 0 LE X LE XL (Y = YL IN EQUATION (2))
         DO 8 I=1,NX
         UY(I,NY)=DUA(X(I),Y(NY),T,VIS)
8        CONTINUE
C...
C...  BURGERS' EQUATION
C...
         DO 10 I=1,NX
         DO 10 J=1,NY
         UT(I,J)=-U(I,J)*UX(I,J)+VIS*UXX(I,J)
     1           -U(I,J)*UY(I,J)+VIS*UYY(I,J)
10       CONTINUE
      RETURN
      END
      SUBROUTINE DERV4
C...
C...  NEUMANN BOUNDARY CONDITIONS
C...
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/  U(11,11)
     2      /F/ UT(11,11)
     3      /S/ UX(11,11),UXX(11,11),
     4          UY(11,11),UYY(11,11)
     5      /R/        XL,        YL,
     6              X(11),     Y(11),
     7                VIS
     8      /I/        NX,        NY,
     9                 IP
C...
C...  SPATIAL DERIVATIVES
C...
C...     UX BY FIVE-POINT CENTERED APPROXIMATIONS
         CALL DSS034(0.E+00,XL,NX,NY,1,U,UX,0.E+00)
C...
C...     X = 0, 0 LE Y LE YL (X = 0 IN EQUATION (2))
         DO 1 J=1,NY
         UX(1,J)=DUA(X(1),Y(J),T,VIS)
1        CONTINUE
C...
C...     X = XL, 0 LE Y LE YL (X = XL IN EQUATION (2))
         DO 2 J=1,NY
         UX(NX,J)=DUA(X(NX),Y(J),T,VIS)
2        CONTINUE
C...
C...     UXX BY FIVE-POINT CENTERED APPROXIMATIONS
         CALL DSS034(0.E+00,XL,NX,NY,1,UX,UXX,0.E+00)
C...
C...     UY BY FIVE-POINT CENTERED APPROXIMATIONS
         CALL DSS034(0.E+00,YL,NX,NY,2,U,UY,0.E+00)
C...
C...     Y = 0, 0 LE X LE XL (Y = 0 IN EQUATION (2))
         DO 5 I=1,NX
         UY(I,1)=DUA(X(I),Y(1),T,VIS)
5        CONTINUE
C...
C...     Y = YL, 0 LE X LE XL (Y = YL IN EQUATION (2))
         DO 6 I=1,NX
         UY(I,NY)=DUA(X(I),Y(NY),T,VIS)
6        CONTINUE
C...
C...     UYY BY FIVE-POINT CENTERED APPROXIMATIONS
         CALL DSS034(0.E+00,YL,NX,NY,2,UY,UYY,0.E+00)
C...
C...  BURGERS' EQUATION
C...
         DO 10 I=1,NX
         DO 10 J=1,NY
         UT(I,J)=-U(I,J)*UX(I,J)+VIS*UXX(I,J)
     1           -U(I,J)*UY(I,J)+VIS*UYY(I,J)
10       CONTINUE
      RETURN
      END
      FUNCTION UA(X,Y,T,VIS)
C...
C...  FUNCTION UA IMLEMENTS THE ANALYTICAL SOLUTION, EQUATION (2)
C...
      EX=EXP(X/(2.0E+00*VIS)+Y/(2.0E+00*VIS)-T/(2.0E+00*VIS))
      UA=1.0E+00/(1.0E+00+EX)
      RETURN
      END
      FUNCTION DUA(X,Y,T,VIS)
C...
C...  FUNCTION DUA IMPLEMENTS THE DERIVATIVE OF THE ANALYTICAL SOLUTION,
C...  EQUATION (2), WITH RESPECT TO X AND Y
C...
      EX=EXP(X/(2.0E+00*VIS)+Y/(2.0E+00*VIS)-T/(2.0E+00*VIS))
      DUA=-1.0E+00*(1.0E+00+EX)**(-2)*EX*(1.0E+00/(2.0E+00*VIS))
      RETURN
      END
      SUBROUTINE PRINT(NI,NO)
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/  U(11,11)
     2      /F/ UT(11,11)
     3      /S/ UX(11,11),UXX(11,11),
     4          UY(11,11),UYY(11,11)
     5      /R/        XL,        YL,
     6              X(11),     Y(11),
     7                VIS
     8      /I/        NX,        NY,
     9                 IP
C...
C...  PRINT A HEADING FOR THE NUMERICAL SOLUTION
      IP=IP+1
      IF(IP.EQ.1)WRITE(NO,1)
1     FORMAT(11X,'T',5X,'U(XL/2,YL/2,T)',
     1               3X,'U(XL/2,YL/2,T)',5X,'ERROR',/,
     2              20X,'  (NUM)  ',7X,'  (ANAL) ')
C...
C...  COMPUTE THE ANALYTICAL SOLUTION AND THE ERROR IN THE NUMERICAL
C...  SOLUTION AT X = XL/2, Y = YL/2
      NX2=NX/2+1
      NY2=NY/2+1
      XL2=X(NX2)
      YL2=Y(NY2)
      UANAL=UA(XL2,YL2,T,VIS)
      ERROR=U(NX2,NY2)-UANAL
C...
C...  PRINT THE NUMERICAL AND ANALYTICAL SOLUTIONS, AND THE ERROR
      WRITE(NO,2)T,U(NX2,NY2),UANAL,ERROR
2     FORMAT(F12.2,2F16.6,E16.4)
      RETURN
      END
TWO-D BURGERS' EQUATION, DIRICHLET BC
0.        2.0       0.2
  121 1000    1    1  REL 0.001
TWO-D BURGERS' EQUATION, DIRICHLET BC
0.        2.0       0.2
  121 1000    1    1  REL 0.001
TWO-D BURGERS' EQUATION, NEUMANN BC
0.        2.0       0.2
  121 1000    1    1  REL 0.001
TWO-D BURGERS' EQUATION, NEUMANN BC
0.        2.0       0.2
  121 1000    1    1  REL 0.001
END OF RUNS
*APP MATH38
      SUBROUTINE INITAL
C...
C...  THREE-DIMENSIONAL BURGERS' EQUATION WITH DIRICHLET AND NEUMANN
C...  BOUNDARY CONDITIONS, ILLUSTRATING THE NUMERICAL METHOD OF LINES
C...  INTEGRATION OF THREE-DIMENSIONAL ELLIPTIC, HYPERBOLIC AND PARA-
C...  BOLIC PARTIAL DIFFERENTIAL EQUATIONS (PDES)
C...
C...  THIS PROBLEM ILLUSTRATES THE METHOD OF LINES PROGRAMMING OF A
C...  THREE-DIMENSIONAL HYPERBOLIC-PARABOLIC (CONVECTIVE-DIFFUSION)
C...  PARTIAL DIFFERENTIAL EQUATION (PDE), THE WELL-KNOWN BURGERS'
C...  EQUATION
C...
C...     U  = -U*U  + VIS*U   - U*U  + VIS*U                   (1)
C...      T       X        XX      Y        YY
C...
C...  WHERE
C...
C...     U       DEPENDENT VARIABLE TO BE COMPUTED
C...
C...     T       INITIAL-VALUE INDEPENDENT VARIABLE (TYPICALLY TIME)
C...
C...     X,Y,Z   BOUNDARY-VALUE INDEPENDENT VARIABLES (TYPICALLY SPACE)
C...
C...     VIS     COEFFICIENT, TYPICALLY A VISCOSITY, WHICH CHANGES THE
C...             CHARACTER OF EQUATION (1)
C...
C...                VIS LARGE - EQUATION (1) IS STRONGLY PARABOLIC
C...
C...                VIS SMALL - EQUATION (1) IS STRONGLY HYPERBOLIC
C...
C...  A LETTER SUBSCRIPT DENOTES A PARTIAL DERIVATIVE, E.G., U  IS THE
C...                                                          T
C...  FIRST-ORDER PARTIAL DERIVATIVE OF U WITH RESPECT TO T.
C...
C...  EQUATION (1) IS A WELL-ESTABLISHED TEST PROBLEM FOR PDE SOFTWARE
C...  BECAUSE IT
C...
C...     (1)  HAS AN EXACT SOLUTION, E.G.,
C...
C...          U(X,Y,T) =
C...
C...          1/(1 + EXP(X/(2*VIS) + Y/(2*VIS) + Z/(2*VIS)      (2)
C...
C...               - 3*T/(4*VIS)))
C...
C...     (2)  IS A STRINGENT TEST PROBLEM, PARTICULARLY FOR SMALL VIS,
C...          FOR WHICH THE SOLUTION EXHIBITS STEEP, MOVING FRONTS.
C...
C...  IN THE SUBSEQUENT PROGRAMMING OF EQUATION (1), THE INITIAL AND
C...  BOUNDARY CONDITIONS HAVE BEEN CHOSEN TO BE CONSISTENT WITH
C...  EQUATION (2).  ALSO, VIS = 1.0, WHICH GIVES EQUATION (1) A
C...  MIXED HYPERBOLIC-PARABOLIC CHARACTER, RESULTS IN A VERY SMOOTH
C...  SOLUTION FROM EQUATION (2), I.E., THIS CHOICE OF VIS WAS MADE
C...  TO FACILITATE THE CALCULATION OF THE NUMERICAL SOLUTION IN ORDER
C...  TO DEMONSTRATE VARIOUS COMPUTATIONAL AND PROGRAMMING PROCEDURES
C...  WITH A MODEST COMPUTING EFFORT.
C...
C...  EQUATION (1) IS INTEGRATED BY THE NUMERICAL METHOD OF LINES IN
C...  THE SUBSEQUENT PROGRAMMING FOR TWO TYPES OF BOUNDARY CONDITIONS
C...  AT (1) X = AND X = XL, (2) Y = 0 AND Y = YL AND (3) Z = 0 AND
C...  Z = ZL (IN THE SUBSEQUENT DISCUSSION, XL, YL AND ZL HAVE THE
C...  NUMERICAL VALUES XL = YL = ZL = 1)
C...
C...     (1)  DIRICHLET BOUNDARY CONDITIONS IN WHICH U(0,Y,Z,T),
C...          U(XL,Y,Z,T), U(X,0,Z,T), U(X,YL,Z,T), U(X,Y,0,T) AND
C...          U(X,Y,ZL,T) ARE SPECIFIED
C...
C...     (2)  NEUMANN BOUNDARY CONDITIONS IN WHICH U (0,Y,Z,T),
C...                                                X
C...          U (XL,Y,Z,T), U (X,0,Z,T), U (X,YL,Z,T), U (X,Y,0,T)
C...           X             Y            Y             Z
C...          AND U (X,Y,ZL,T) ARE SPECIFIED
C...               Z
C...
C...  IN THE SUBSEQUENT DISCUSSION, THE DERIVATIVES IN EQUATION (1)
C...  WILL BE DESIGNATED WITH IN-LINE NOTATION, E.G., U   WILL BE
C...                                                   XX
C...  DESIGNATED UXX.
C...
C...  SINCE THE EXACT SOLUTION, EQUATION (2), IS AVAILABLE, THE ERROR
C...  IN THE NUMERICAL SOLUTION CAN BE COMPUTED.  IN PARTICULAR, THE
C...  ERROR IN U(X=XL/2,Y=YL/2,Z=ZL/2,T=1) IS COMPUTED FROM THE FOLLOW-
C...  ING APPLICATION OF EQUATION (2)
C...
C...  U(0.5,0.5,0.5,1) = 1/(1 + EXP(0.5/(2*VIS) + 0.5/(2*VIS)
C...
C...                              + 0.5/(2*VIS) - 3*1/(4*VIS)))
C...
C...                   = 1/(1 + EXP(0)) = 0.5
C...
C...  NOTE THAT THIS RESULT IS INDEPENDENT OF VIS.  THUS, VIS CAN BE
C...  DECREASED TO MAKE THE NUMERICAL SOLUTION MORE DIFFICULT TO
C...  COMPUTE, I.E., THE PROBLEM IS MORE HYPERBOLIC AND LESS PARABOLIC,
C...  YET THE NUMERICAL SOLUTION SHOULD REMAIN CLOSE TO 0.5 IF REASON-
C...  ABLE ACCURACY IS TO BE MAINTAINED.
C...
C...  IN ADDITION TO THE COMMENTS IN THE FOLLOWING CODING, THE READER
C...  CAN ALSO REFER TO THE COMMENTS IN THE SPATIAL DIFFERENTIATION
C...  SUBROUTINE, DSS036.  IN PARTICULAR, CENTERED APPROXIMATIONS IN
C...  SUBROUTINE DSS036 ARE USED TO CALCULATE UXX AND UYY IN EQUATION
C...  (1), I.E., CENTERED APPROXIMATIONS SHOULD BE USED IN PARABOLIC
C...  PROBLEMS, AND NONCENTERED (FIVE-POINT BIASED UPWIND) APPROXI-
C...  MATIONS IN SUBROUTINE DSS036 ARE USED TO CALCULATE UX AND UY IN
C...  EQUATION (1), I.E., NONCENTERED APPROXIMATIONS SHOULD BE USED
C...  IN HYPERBOLIC PROBLEMS.  ALL OF THESE APPROXIMATIONS ARE DERIVED
C...  FROM THE TAYLOR SERIES AS EXPLAINED IN DSS036, AND SUBORDINATE
C...  ROUTINES DSS004 AND DSS020.
C...
C...  TWO SPECIAL CASES OF THIS PROBLEM CAN BE CONSIDERED
C...
C...     (1)  VIS = 0
C...
C...     IN THIS CASE, EQUATION (1) REDUCES TO
C...
C...     U  = - U*U  - U*U  - U*U
C...      T        X      Y      Z
C...                                                            (3)
C...          - (U**2) /2 - (U**2) /2 - (U**2) /2
C...                  X           Y           Z
C...
C...     EQUATION (3) HAS THE ANALYTICAL SOLUTION
C...
C...     U(X,Y,T) = (X + Y + Z)/(1 + 3*T)                       (4)
C...
C...     THE USE OF EQUATIONS (3) AND (4) IN THE FOLLOWING PROGRAMMING
C...     REQUIRES SOME MODIFICATION OF THE PROGRAMMING.
C...
C...     (2)  BOUNDARY-VALUE PARTIAL DIFFERENTIAL EQUATION (PDE)
C...
C...     THE STEADY STATE FORM OF EQUATION (1) IS THE BOUNDARY-VALUE
C...     PARTIAL DIFFERENTIAL EQUATION
C...
C...     U   - U*U  + U   - U*U  + U   - U*U  = 0               (5)
C...      XX      X    YY      Y    ZZ      Z
C...
C...     (NOTE THAT U  = 0 IN EQUATION (1)), WHICH CAN ALSO BE CONSIDER-
C...                 T
C...     ED AS A THREE-DIMENSIONAL ELLIPTIC PDE (WITH INDEPENDENT VARI-
C...     ABLES X AND Y).  THUS, THE FOLLOWING PROGRAMMING ILLUSTRATES A
C...     METHOD FOR INTEGRATING ELLIPTIC PDES AS WELL AS HYPERBOLIC
C...     AND PARABOLIC PDES (BY ALLOWING THE SOLUTION OF EQUATION (1)
C...     TO PROCEED TO U  = 0, FOR WHICH EQUATION (2), WITH LARGE T,
C...                    T
C...     REDUCES TO:
C...
C...        U(X,Y,Z,INF) = 1
C...
C...     THIS DISCUSSION SUGGESTS A GENERAL METHOD FOR SOLVING BOUNDARY-
C...     VALUE PDES, I.E., A PSEUDO TIME DERIVATIVE IS ADDED TO THE PDES
C...     AND THE RESULTING PDES ARE INTEGRATED TO STEADY STATE FOR WHICH
C...     THE TIME DERIVATIVES ESSENTIALLY GO TO ZERO.  THIS APPROACH HAS
C...     BEEN USED EFFECTIVELY IN THE SOLUTION OF SOME RELATIVELY COM-
C...     PLEX BOUNDARY-VALUE PDES.  THIS APPROACH IS ALSO TERMED THE
C...     METHOD OF FALSE TRANSIENTS.
C...
C...  FINALLY, THE VERIFICATION OF EQUATION (2) AS A SOLUTION TO EQUA-
C...  TION (1) FOLLOWS:
C...
C...  LET EX = EXP(X/(2*VIS) + Y/(2*VIS) + Z/(2*VIS) - 3*T/(4*VIS)).
C...  THEN EQUATION (2) CAN BE WRITTEN AS:
C...
C...     U(X,Y,Z,T) = 1/(1 + EX)
C...
C...  THE VARIOUS TERMS IN EQUATION (1) ARE:
C...
C...     U  = (-1/(1 + EX)**2)*EX*(-3/(4*VIS))
C...      T
C...
C...     U*U  = (1/(1 + EX))*(-1/(1 + EX)**2)*EX*(1/(2*VIS))
C...        X
C...
C...     -VIS*U   = -VIS*((-1/(1 + EX)**2)*EX*(1/(2*VIS))**2
C...           XX
C...
C...              + EX*(1/(2*VIS)*2/(1 + EX)**3)*EX*(1/(2*VIS)))
C...
C...     U*U  = (1/(1 + EX))*(-1/(1 + EX)**2)*EX*(1/(2*VIS))
C...        Y
C...
C...     -VIS*U   = -VIS*((-1/(1 + EX)**2)*EX*(1/(2*VIS))**2
C...           YY
C...
C...              + EX*(1/(2*VIS)*2/(1 + EX)**3)*EX*(1/(2*VIS)))
C...
C...     U*U  = (1/(1 + EX))*(-1/(1 + EX)**2)*EX*(1/(2*VIS))
C...        Z
C...
C...     -VIS*U   = -VIS*((-1/(1 + EX)**2)*EX*(1/(2*VIS))**2
C...           ZZ
C...
C...  SUMMATION OF THESE TERMS GIVES:
C...
C...     0 = (1/(1 + EX)**2)*EX*(1/(4*VIS))*(3 + 1 + 1 + 1)
C...
C...       - (1/(1 + EX)**3)*EX*(1/(2*VIS))*(1 + 1 + 1)*(1 + EX)
C...
C...       = 0
C...
C...  WE NOW PROCEED TO THE NUMERICAL METHOD OF LINES SOLUTION OF EQUA-
C...  TION (1) SUBJECT TO DIRICHLET AND NEUMANN BOUNDARY CONDITIONS, AND
C...  AN INITIAL CONDITION, WHICH ARE CONSISTENT WITH THE EXACT SOLU-
C...  TION, EQUATION (2).
C...
C...  DSS/2 COMMON
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/  U(6,6,6)
     2      /F/ UT(6,6,6)
     3      /S/ UX(6,6,6), UY(6,6,6), UZ(6,6,6),
     4         UXX(6,6,6),UYY(6,6,6),UZZ(6,6,6)
     5      /R/        XL,        YL,        ZL,
     6               X(6),      Y(6),      Z(6),
     7                VIS
     8      /I/        NX,        NY,        NZ,
     9                 IP
C...
C...  EQUATION PARAMETERS
      VIS=1.0E+00
      XL=1.0E+00
      YL=1.0E+00
      ZL=1.0E+00
C...
C...  NUMBER OF GRID POINTS
      NX=6
      NY=6
      NZ=6
C...
C...  INITIAL CONDITIONS (T = 0 IN EQUATION (2))
      DO 1 I=1,NX
      X(I)=XL*FLOAT(I-1)/FLOAT(NX-1)
      DO 1 J=1,NY
      Y(J)=YL*FLOAT(J-1)/FLOAT(NY-1)
      DO 1 K=1,NZ
      Z(K)=ZL*FLOAT(K-1)/FLOAT(NZ-1)
      U(I,J,K)=UA(X(I),Y(J),Z(K),T,VIS)
1     CONTINUE
C...
C...  INITIAL DERIVATIVES
      CALL DERV
      IP=0
      RETURN
      END
      SUBROUTINE DERV
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/  U(6,6,6)
     2      /F/ UT(6,6,6)
     3      /S/ UX(6,6,6), UY(6,6,6), UZ(6,6,6),
     4         UXX(6,6,6),UYY(6,6,6),UZZ(6,6,6)
     5      /R/        XL,        YL,        ZL,
     6               X(6),      Y(6),      Z(6),
     7                VIS
     8      /I/        NX,        NY,        NZ,
     9                 IP
C...
C...  DIRICHLET BOUNDARY CONDITIONS WITH (1) UXX, UYY AND UZZ CALCULA-
C...  TED BY CENTERED APPROXIMATIONS AND (2) UX, UY AND UZ CALCULATED
C...  BY BIASED UPWIND APPROXIMATIONS
      IF(NORUN.EQ.1)CALL DERV1
C...
C...  DIRICHLET BOUNDARY CONDITIONS WITH UXX, UYY, UZZ, UX, UY AND UZ
C...  CALCULATED BY CENTERED APPROXIMATIONS
      IF(NORUN.EQ.2)CALL DERV2
C...
C...  NEUMANN BOUNDARY CONDITIONS WITH (1) UXX, UYY AND UZZ CALCULA-
C...  TED BY CENTERED APPROXIMATIONS AND (2) UX, UY AND UZ CALCULATED
C...  BY BIASED UPWIND APPROXIMATIONS
      IF(NORUN.EQ.3)CALL DERV3
C...
C...  NEUMANN BOUNDARY CONDITIONS WITH UXX, UYY, UZZ, UX, UY AND UZ
C...  CALCULATED BY CENTERED APPROXIMATIONS
      IF(NORUN.EQ.4)CALL DERV4
      RETURN
      END
      SUBROUTINE DERV1
C...
C...  DIRICHLET BOUNDARY CONDITIONS
C...
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/  U(6,6,6)
     2      /F/ UT(6,6,6)
     3      /S/ UX(6,6,6), UY(6,6,6), UZ(6,6,6),
     4         UXX(6,6,6),UYY(6,6,6),UZZ(6,6,6)
     5      /R/        XL,        YL,        ZL,
     6               X(6),      Y(6),      Z(6),
     7                VIS
     8      /I/        NX,        NY,        NZ,
     9                 IP
C...
C...     X = 0, 0 LE Y LE YL, 0 LE Z LE ZL (X = 0 IN EQUATION (2))
         DO 1 J=1,NY
         DO 1 K=1,NZ
         U(1,J,K)=UA(X(1),Y(J),Z(K),T,VIS)
1        CONTINUE
C...
C...     X = XL, 0 LE Y LE YL, 0 LE Z LE ZL (X = XL IN EQUATION (2))
         DO 2 J=1,NY
         DO 2 K=1,NZ
         U(NX,J,K)=UA(X(NX),Y(J),Z(K),T,VIS)
2        CONTINUE
C...
C...     Y = 0, 0 LE X LE XL, 0 LE Z LE ZL (Y = 0 IN EQUATION (2))
         DO 3 I=1,NX
         DO 3 K=1,NZ
         U(I,1,K)=UA(X(I),Y(1),Z(K),T,VIS)
3        CONTINUE
C...
C...     Y = YL, 0 LE X LE XL, 0 LE Z LE ZL (Y = YL IN EQUATION (2))
         DO 4 I=1,NX
         DO 4 K=1,NZ
         U(I,NY,K)=UA(X(I),Y(NY),Z(K),T,VIS)
4        CONTINUE
C...
C...     Z = 0, 0 LE X LE XL, 0 LE Y LE YL (Z = 0 IN EQUATION (2))
         DO 5 I=1,NX
         DO 5 J=1,NY
         U(I,J,1)=UA(X(I),Y(J),Z(1),T,VIS)
5        CONTINUE
C...
C...     Z = ZL, 0 LE X LE XL, 0 LE Y LE YL (Z = ZL EQUATION (2))
         DO 6 I=1,NX
         DO 6 J=1,NY
         U(I,J,NZ)=UA(X(I),Y(J),Z(NZ),T,VIS)
6        CONTINUE
C...
C...  SPATIAL DERIVATIVES
C...
C...     UX IN UXX (BY FIVE-POINT CENTERED APPROXIMATIONS)
         CALL DSS036(0.E+00,XL,NX,NY,NZ,1,U,UX,0.E+00)
C...
C...     UXX (BY FIVE-POINT CENTERED APPROXIMATIONS)
         CALL DSS036(0.E+00,XL,NX,NY,NZ,1,UX,UXX,0.E+00)
C...
C...     UX IN U*UX (BY FIVE-POINT BIASED UPWIND APPROXIMATIONS)
         CALL DSS036(0.E+00,XL,NX,NY,NZ,1,U,UX,1.0E+00)
C...
C...     UY IN UYY (BY FIVE-POINT CENTERED APPROXIMATIONS)
         CALL DSS036(0.E+00,YL,NX,NY,NZ,2,U,UY,0.E+00)
C...
C...     UYY (BY FIVE-POINT CENTERED APPROXIMATIONS)
         CALL DSS036(0.E+00,YL,NX,NY,NZ,2,UY,UYY,0.E+00)
C...
C...     UY IN U*UY (BY FIVE-POINT BIASED UPWIND APPROXIMATIONS)
         CALL DSS036(0.E+00,YL,NX,NY,NZ,2,U,UY,1.0E+00)
C...
C...     UZ IN UZZ (BY FIVE-POINT CENTERED APPROXIMATIONS)
         CALL DSS036(0.E+00,ZL,NX,NY,NZ,3,U,UZ,0.E+00)
C...
C...     UZZ (BY FIVE-POINT CENTERED APPROXIMATIONS)
         CALL DSS036(0.E+00,ZL,NX,NY,NZ,3,UZ,UZZ,0.E+00)
C...
C...     UZ IN U*UZ (BY FIVE-POINT BIASED UPWIND APPROXIMATIONS)
         CALL DSS036(0.E+00,ZL,NX,NY,NZ,3,U,UZ,1.0E+00)
C...
C...  BURGERS' EQUATION
C...
         DO 10 I=1,NX
         DO 10 J=1,NY
         DO 10 K=1,NZ
         UT(I,J,K)=-U(I,J,K)*UX(I,J,K)+VIS*UXX(I,J,K)
     1             -U(I,J,K)*UY(I,J,K)+VIS*UYY(I,J,K)
     2             -U(I,J,K)*UZ(I,J,K)+VIS*UZZ(I,J,K)
10       CONTINUE
      RETURN
      END
      SUBROUTINE DERV2
C...
C...  DIRICHLET BOUNDARY CONDITIONS
C...
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/  U(6,6,6)
     2      /F/ UT(6,6,6)
     3      /S/ UX(6,6,6), UY(6,6,6), UZ(6,6,6),
     4         UXX(6,6,6),UYY(6,6,6),UZZ(6,6,6)
     5      /R/        XL,        YL,        ZL,
     6               X(6),      Y(6),      Z(6),
     7                VIS
     8      /I/        NX,        NY,        NZ,
     9                 IP
C...
C...     X = 0, 0 LE Y LE YL, 0 LE Z LE ZL (X = 0 IN EQUATION (2))
         DO 1 J=1,NY
         DO 1 K=1,NZ
         U(1,J,K)=UA(X(1),Y(J),Z(K),T,VIS)
1        CONTINUE
C...
C...     X = XL, 0 LE Y LE YL, 0 LE Z LE ZL (X = XL IN EQUATION (2))
         DO 2 J=1,NY
         DO 2 K=1,NZ
         U(NX,J,K)=UA(X(NX),Y(J),Z(K),T,VIS)
2        CONTINUE
C...
C...     Y = 0, 0 LE X LE XL, 0 LE Z LE ZL (Y = 0 IN EQUATION (2))
         DO 3 I=1,NX
         DO 3 K=1,NZ
         U(I,1,K)=UA(X(I),Y(1),Z(K),T,VIS)
3        CONTINUE
C...
C...     Y = YL, 0 LE X LE XL, 0 LE Z LE ZL (Y = YL IN EQUATION (2))
         DO 4 I=1,NX
         DO 4 K=1,NZ
         U(I,NY,K)=UA(X(I),Y(NY),Z(K),T,VIS)
4        CONTINUE
C...
C...     Z = 0, 0 LE X LE XL, 0 LE Y LE YL (Z = 0 IN EQUATION (2))
         DO 5 I=1,NX
         DO 5 J=1,NY
         U(I,J,1)=UA(X(I),Y(J),Z(1),T,VIS)
5        CONTINUE
C...
C...     Z = ZL, 0 LE X LE XL, 0 LE Y LE YL (Z = ZL EQUATION (2))
         DO 6 I=1,NX
         DO 6 J=1,NY
         U(I,J,NZ)=UA(X(I),Y(J),Z(NZ),T,VIS)
6        CONTINUE
C...
C...  SPATIAL DERIVATIVES
C...
C...     UX BY FIVE-POINT CENTERED APPROXIMATIONS
         CALL DSS036(0.E+00,XL,NX,NY,NZ,1,U,UX,0.E+00)
C...
C...     UXX BY FIVE-POINT CENTERED APPROXIMATIONS
         CALL DSS036(0.E+00,XL,NX,NY,NZ,1,UX,UXX,0.E+00)
C...
C...     UY BY FIVE-POINT CENTERED APPROXIMATIONS
         CALL DSS036(0.E+00,YL,NX,NY,NZ,2,U,UY,0.E+00)
C...
C...     UYY BY FIVE-POINT CENTERED APPROXIMATIONS
         CALL DSS036(0.E+00,YL,NX,NY,NZ,2,UY,UYY,0.E+00)
C...
C...     UZ BY FIVE-POINT CENTERED APPROXIMATIONS
         CALL DSS036(0.E+00,ZL,NX,NY,NZ,3,U,UZ,0.E+00)
C...
C...     UZZ BY FIVE-POINT CENTERED APPROXIMATIONS
         CALL DSS036(0.E+00,ZL,NX,NY,NZ,3,UZ,UZZ,0.E+00)
C...
C...  BURGERS' EQUATION
C...
         DO 10 I=1,NX
         DO 10 J=1,NY
         DO 10 K=1,NZ
         UT(I,J,K)=-U(I,J,K)*UX(I,J,K)+VIS*UXX(I,J,K)
     1             -U(I,J,K)*UY(I,J,K)+VIS*UYY(I,J,K)
     2             -U(I,J,K)*UZ(I,J,K)+VIS*UZZ(I,J,K)
10       CONTINUE
      RETURN
      END
      SUBROUTINE DERV3
C...
C...  NEUMANN BOUNDARY CONDITIONS
C...
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/  U(6,6,6)
     2      /F/ UT(6,6,6)
     3      /S/ UX(6,6,6), UY(6,6,6), UZ(6,6,6),
     4         UXX(6,6,6),UYY(6,6,6),UZZ(6,6,6)
     5      /R/        XL,        YL,        ZL,
     6               X(6),      Y(6),      Z(6),
     7                VIS
     8      /I/        NX,        NY,        NZ,
     9                 IP
C...
C...  SPATIAL DERIVATIVES
C...
C...     UX IN UXX (BY FIVE-POINT CENTERED APPROXIMATIONS)
         CALL DSS036(0.E+00,XL,NX,NY,NZ,1,U,UX,0.E+00)
C...
C...     X = 0, 0 LE Y LE YL, 0 LE Z LE ZL (X = 0 IN EQUATION (2))
         DO 1 J=1,NY
         DO 1 K=1,NZ
         UX(1,J,K)=DUA(X(1),Y(J),Z(K),T,VIS)
1        CONTINUE
C...
C...     X = XL, 0 LE Y LE YL, 0 LE Z LE ZL (X = XL IN EQUATION (2))
         DO 2 J=1,NY
         DO 2 K=1,NZ
         UX(NX,J,K)=DUA(X(NX),Y(J),Z(K),T,VIS)
2        CONTINUE
C...
C...     UXX (BY FIVE-POINT CENTERED APPROXIMATIONS)
         CALL DSS036(0.E+00,XL,NX,NY,NZ,1,UX,UXX,0.E+00)
C...
C...     UX IN U*UX (BY FIVE-POINT BIASED UPWIND APPROXIMATIONS)
         CALL DSS036(0.E+00,XL,NX,NY,NZ,1,U,UX,1.0E+00)
C...
C...     X = 0, 0 LE Y LE YL, 0 LE Z LE ZL (X = 0 IN EQUATION (2))
         DO 7 J=1,NY
         DO 7 K=1,NZ
         UX(1,J,K)=DUA(X(1),Y(J),Z(K),T,VIS)
7        CONTINUE
C...
C...     X = XL, 0 LE Y LE YL, 0 LE Z LE ZL (X = XL IN EQUATION (2))
         DO 8 J=1,NY
         DO 8 K=1,NZ
         UX(NX,J,K)=DUA(X(NX),Y(J),Z(K),T,VIS)
8        CONTINUE
C...
C...     UY IN UYY (BY FIVE-POINT CENTERED APPROXIMATIONS)
         CALL DSS036(0.E+00,YL,NX,NY,NZ,2,U,UY,0.E+00)
C...
C...     Y = 0, 0 LE X LE XL, 0 LE Z LE ZL (Y = 0 IN EQUATION (2))
         DO 3 I=1,NX
         DO 3 K=1,NZ
         UY(I,1,K)=DUA(X(I),Y(1),Z(K),T,VIS)
3        CONTINUE
C...
C...     Y = YL, 0 LE X LE XL, 0 LE Z LE ZL (Y = YL IN EQUATION (2))
         DO 4 I=1,NX
         DO 4 K=1,NZ
         UY(I,NY,K)=DUA(X(I),Y(NY),Z(K),T,VIS)
4        CONTINUE
C...
C...     UYY (BY FIVE-POINT CENTERED APPROXIMATIONS)
         CALL DSS036(0.E+00,YL,NX,NY,NZ,2,UY,UYY,0.E+00)
C...
C...     UY IN U*UY (BY FIVE-POINT BIASED UPWIND APPROXIMATIONS)
         CALL DSS036(0.E+00,YL,NX,NY,NZ,2,U,UY,1.0E+00)
C...
C...     Y = 0, 0 LE X LE XL, 0 LE Z LE ZL (Y = 0 IN EQUATION (2))
         DO 9 I=1,NX
         DO 9 K=1,NZ
         UY(I,1,K)=DUA(X(I),Y(1),Z(K),T,VIS)
9        CONTINUE
C...
C...     Y = YL, 0 LE X LE XL, 0 LE Z LE ZL (Y = YL IN EQUATION (2))
         DO 10 I=1,NX
         DO 10 K=1,NZ
         UY(I,NY,K)=DUA(X(I),Y(NY),Z(K),T,VIS)
10       CONTINUE
C...
C...     UZ IN UZZ (BY FIVE-POINT CENTERED APPROXIMATIONS)
         CALL DSS036(0.E+00,ZL,NX,NY,NZ,3,U,UZ,0.E+00)
C...
C...     Z = 0, 0 LE X LE XL, 0 LE Y LE YL (Z = 0 IN EQUATION (2))
         DO 5 I=1,NX
         DO 5 J=1,NY
         UZ(I,J,1)=DUA(X(I),Y(J),Z(1),T,VIS)
5        CONTINUE
C...
C...     Z = ZL, 0 LE X LE XL, 0 LE Y LE YL (Z = ZL EQUATION (2))
         DO 6 I=1,NX
         DO 6 J=1,NY
         UZ(I,J,NZ)=DUA(X(I),Y(J),Z(NZ),T,VIS)
6        CONTINUE
C...
C...     UZZ (BY FIVE-POINT CENTERED APPROXIMATIONS)
         CALL DSS036(0.E+00,ZL,NX,NY,NZ,3,UZ,UZZ,0.E+00)
C...
C...     UZ IN U*UZ (BY FIVE-POINT BIASED UPWIND APPROXIMATIONS)
         CALL DSS036(0.E+00,ZL,NX,NY,NZ,3,U,UZ,1.0E+00)
C...
C...     Z = 0, 0 LE X LE XL, 0 LE Y LE YL (Z = 0 IN EQUATION (2))
         DO 11 I=1,NX
         DO 11 J=1,NY
         UZ(I,J,1)=DUA(X(I),Y(J),Z(1),T,VIS)
11       CONTINUE
C...
C...     Z = ZL, 0 LE X LE XL, 0 LE Y LE YL (Z = ZL EQUATION (2))
         DO 12 I=1,NX
         DO 12 J=1,NY
         UZ(I,J,NZ)=DUA(X(I),Y(J),Z(NZ),T,VIS)
12       CONTINUE
C...
C...  BURGERS' EQUATION
C...
         DO 13 I=1,NX
         DO 13 J=1,NY
         DO 13 K=1,NZ
         UT(I,J,K)=-U(I,J,K)*UX(I,J,K)+VIS*UXX(I,J,K)
     1             -U(I,J,K)*UY(I,J,K)+VIS*UYY(I,J,K)
     2             -U(I,J,K)*UZ(I,J,K)+VIS*UZZ(I,J,K)
13       CONTINUE
      RETURN
      END
      SUBROUTINE DERV4
C...
C...  NEUMANN BOUNDARY CONDITIONS
C...
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/  U(6,6,6)
     2      /F/ UT(6,6,6)
     3      /S/ UX(6,6,6), UY(6,6,6), UZ(6,6,6),
     4         UXX(6,6,6),UYY(6,6,6),UZZ(6,6,6)
     5      /R/        XL,        YL,        ZL,
     6               X(6),      Y(6),      Z(6),
     7                VIS
     8      /I/        NX,        NY,        NZ,
     9                 IP
C...
C...  SPATIAL DERIVATIVES
C...
C...     UX BY FIVE-POINT CENTERED APPRXOXIMATIONS
         CALL DSS036(0.E+00,XL,NX,NY,NZ,1,U,UX,0.E+00)
C...
C...     X = 0, 0 LE Y LE YL, 0 LE Z LE ZL (X = 0 IN EQUATION (2))
         DO 1 J=1,NY
         DO 1 K=1,NZ
         UX(1,J,K)=DUA(X(1),Y(J),Z(K),T,VIS)
1        CONTINUE
C...
C...     X = XL, 0 LE Y LE YL, 0 LE Z LE ZL (X = XL IN EQUATION (2))
         DO 2 J=1,NY
         DO 2 K=1,NZ
         UX(NX,J,K)=DUA(X(NX),Y(J),Z(K),T,VIS)
2        CONTINUE
C...
C...     UXX BY FIVE-POINT CENTERED APPROXIMATIONS
         CALL DSS036(0.E+00,XL,NX,NY,NZ,1,UX,UXX,0.E+00)
C...
C...     UY BY FIVE-POINT CENTERED APPROXIMATIONS
         CALL DSS036(0.E+00,YL,NX,NY,NZ,2,U,UY,0.E+00)
C...
C...     Y = 0, 0 LE X LE XL, 0 LE Z LE ZL (Y = 0 IN EQUATION (2))
         DO 3 I=1,NX
         DO 3 K=1,NZ
         UY(I,1,K)=DUA(X(I),Y(1),Z(K),T,VIS)
3        CONTINUE
C...
C...     Y = YL, 0 LE X LE XL, 0 LE Z LE ZL (Y = YL IN EQUATION (2))
         DO 4 I=1,NX
         DO 4 K=1,NZ
         UY(I,NY,K)=DUA(X(I),Y(NY),Z(K),T,VIS)
4        CONTINUE
C...
C...     UYY BY FIVE-POINT CENTERED APPROXIMATIONS
         CALL DSS036(0.E+00,YL,NX,NY,NZ,2,UY,UYY,0.E+00)
C...
C...     UZ BY FIVE-POINT CENTERED APPRXIMATIONS
         CALL DSS036(0.E+00,ZL,NX,NY,NZ,3,U,UZ,0.E+00)
C...
C...     Z = 0, 0 LE X LE XL, 0 LE Y LE YL (Z = 0 IN EQUATION (2))
         DO 5 I=1,NX
         DO 5 J=1,NY
         UZ(I,J,1)=DUA(X(I),Y(J),Z(1),T,VIS)
5        CONTINUE
C...
C...     Z = ZL, 0 LE X LE XL, 0 LE Y LE YL (Z = ZL EQUATION (2))
         DO 6 I=1,NX
         DO 6 J=1,NY
         UZ(I,J,NZ)=DUA(X(I),Y(J),Z(NZ),T,VIS)
6        CONTINUE
C...
C...     UZZ BY FIVE-POINT APPROXIMATIONS
         CALL DSS036(0.E+00,ZL,NX,NY,NZ,3,UZ,UZZ,0.E+00)
C...
C...  BURGERS' EQUATION
C...
         DO 10 I=1,NX
         DO 10 J=1,NY
         DO 10 K=1,NZ
         UT(I,J,K)=-U(I,J,K)*UX(I,J,K)+VIS*UXX(I,J,K)
     1             -U(I,J,K)*UY(I,J,K)+VIS*UYY(I,J,K)
     2             -U(I,J,K)*UZ(I,J,K)+VIS*UZZ(I,J,K)
10       CONTINUE
      RETURN
      END
      FUNCTION UA(X,Y,Z,T,VIS)
C...
C...  FUNCTION UA IMPLEMENTS THE ANALYTICAL SOLUTION, EQUATION (2)
C...
      EX=EXP(X/(2.0E+00*VIS)
     1      +Y/(2.0E+00*VIS)
     2      +Z/(2.0E+00*VIS)
     3      -3.0E+00*T/(4.0E+00*VIS))
      UA=1.0E+00/(1.0E+00+EX)
      RETURN
      END
      FUNCTION DUA(X,Y,Z,T,VIS)
C...
C...  FUNCTION DUA IMPLEMENTS THE DERIVATIVE OF THE ANALYTICAL SOLUTION,
C...  EQUATION (2), WITH RESPECT TO X, Y AND Z
C...
      EX=EXP(X/(2.0E+00*VIS)
     1      +Y/(2.0E+00*VIS)
     2      +Z/(2.0E+00*VIS)
     3      -3.0E+00*T/(4.0E+00*VIS))
      DUA=-1.0E+00*(1.0E+00+EX)**(-2)*EX*(1.0E+00/(2.0E+00*VIS))
      RETURN
      END
      SUBROUTINE PRINT(NI,NO)
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/  U(6,6,6)
     2      /F/ UT(6,6,6)
     3      /S/ UX(6,6,6), UY(6,6,6), UZ(6,6,6),
     4         UXX(6,6,6),UYY(6,6,6),UZZ(6,6,6)
     5      /R/        XL,        YL,        ZL,
     6               X(6),      Y(6),      Z(6),
     7                VIS
     8      /I/        NX,        NY,        NZ,
     9                 IP
C...
C...  PRINT A HEADING FOR THE NUMERICAL SOLUTION
      IP=IP+1
      IF(IP.EQ.1)WRITE(NO,1)
1     FORMAT(11X,'T',9X,'U(0.6,0.6,0.6,T)',
     1               5X,'U(0.6,0.6,0.6,T)',5X,'ERROR',/,
     2              25X,'  (NUM)  ',12X,'  (ANAL) ')
C...
C...  COMPUTE THE ANALYTICAL SOLUTION AND THE ERROR IN THE NUMERICAL
C...  SOLUTION.  NOTE THAT FOR AN EVEN NUMBER OF POINTS, E.G., 6, THE
C...  MID POINTS X = XL/2, Y = YL/2, Z = ZL/2 ARE NOT AVAILABLE.
C...  THEREFORE, THE POINTS X = 0.6*XL, Y = 0.6*YL, Z = 0.6*ZL ARE
C...  USED FOR WHICH THE EXACT SOLUTION WITH T = 1.2 IS:
C...
C...  U(0.6,0.6,0.6,1.2) =
C...
C...     = 1/(1 + EXP(0.6/(2*VIS) + 0.6/(2*VIS) + 0.6/(2*VIS)
C...
C...     - 3*1.2/(4*VIS)) = 1/(1 + EXP(0)) = 0.5
C...
      NX2=NX/2+1
      NY2=NY/2+1
      NZ2=NZ/2+1
      XL2=X(NX2)
      YL2=Y(NY2)
      ZL2=Z(NZ2)
      UANAL=UA(XL2,YL2,ZL2,T,VIS)
      ERROR=U(NX2,NY2,NZ2)-UANAL
C...
C...  PRINT THE NUMERICAL AND ANALYTICAL SOLUTIONS, AND THE ERROR
      WRITE(NO,2)T,U(NX2,NY2,NZ2),UANAL,ERROR
2     FORMAT(F12.2,2F21.6,E16.4)
      RETURN
      END
THREE-D BURGERS' EQUATION, DIRICHLET BC
0.        2.0       0.2
  216 1000    1    1  REL 0.001
THREE-D BURGERS' EQUATION, DIRICHLET BC
0.        2.0       0.2
  216 1000    1    1  REL 0.001
THREE-D BURGERS' EQUATION, NEUMANN BC
0.        2.0       0.2
  216 1000    1    1  REL 0.001
THREE-D BURGERS' EQUATION, NEUMANN BC
0.        2.0       0.2
  216 1000    1    1  REL 0.001
END OF RUNS
*APP MATH39
      SUBROUTINE INITAL
C...
C...  COMPARISON OF THE ANALYTICAL AND NUMERICAL SOLUTIONS FOR A
C...  FIRST-ORDER AND SECOND-ORDER ODE SYSTEM
C...
C...  CONSIDER THE FOLLOWING FIRST-ORDER AND SECOND-ORDER ORDINARY
C...  DIFFERENTIAL EQUATION (ODE) SYSTEMS
C...
C...     FIRST-ORDER SYSTEM (ONE ODE)
C...
C...     DY/DT + Y = 1, Y(0) = 0                                 (1)
C...
C...     SECOND-ORDER SYSTEM (TWO ODES)
C...
C...     DY1/DT + Y1 = 1, Y1(0) = 0                              (2)
C...
C...     DY2/DT + Y2 = Y1, Y2(0) = 0                             (3)
C...
C...  SOLUTIONS TO EQUATIONS (1) TO (3) CAN EASILY BE DERIVED BY THE
C...  LAPLACE TRANSFORM,  IF WE TAKE THE LAPLACE TRANSFORM OF EQUATION
C...  EQUATION (1)
C...
C...     S*Y - 0 + Y = 1/S
C...
C...  OR SOLVING FOR Y,
C...
C...     Y = 1/(S*(S + 1)) = 1/S - 1/(S + 1))
C...
C...  THE LAST FORM FOR Y FOLLOWS FROM A PARTIAL FRACTIONS EXPANSION.
C...
C...  SINCE THE INVERSE TRANSFORMS OF 1/S AND 1/(S + 1) ARE 1 AND
C...  EXP(-T), RESPECTIVELY, THE SOLUTION TO EQUATION (1) IS
C...
C...     Y(T) = 1 - EXP(-T)
C...
C...  WHICH CAN EASILY BE VERIFIED AS THE SOLUTION TO EQUATION (1).
C...
C...  SIMILARLY, THE LAPLACE TRANSFORMS OF EQUATIONS (2) AND (3) ARE
C...
C...     S*Y1 - 0 + Y1 = 1/S
C...
C...     S*Y2 - 0 + Y2 = Y1
C...
C...  OR COMBINING ALGEBRAICALLY (WHICH IS A MAJOR ADVANTAGE OF THE
C...  LAPLACE TRANSFORM, I.E., ALGEBRA REPLACES INTEGRATION IN SOLVING
C...  ODES)
C...
C...     Y2 = 1/(S*(S + 1)**2) = 1/S - 1/(S + 1) - 1/(S + 1)**2
C...
C...  WHICH AGAIN FOLLOWS FROM A PARTIAL FRACTIONS EXPANSION.  USING
C...  THE FOLLOWING TABLE OF TRANSFORMS, WE CAN PERFORM AN INVERSION
C...  OF Y2
C...                   F(T)                       F(S)
C...
C...                    1                          1/S
C...
C...                    T                        1/S**2
C...
C...                 EXP(A*T)                  1/(S - A)
C...
C...               F(T)*EXP(A*T)                F(S - A)
C...
C...  THUS
C...
C...     Y2(T) = 1 - EXP(-T) - T*EXP(-T)
C...
C...  Y1(T) IS THE SAME AS Y(T) FROM EQUATION (1).
C...
C...  THESE EXACT SOLUTIONS ARE PROGRAMMED IN SUBROUTINE PRINT FOR
C...  COMPARISON WITH THE NUMERICAL SOLUTIONS.
C...
      COMMON/T/      T,  NSTOP,  NORUN
      IF(NORUN.EQ.1)CALL INTAL1
      IF(NORUN.EQ.2)CALL INTAL2
      RETURN
      END
      SUBROUTINE INTAL1
      COMMON/T/      T,  NSTOP,  NORUN
     1      /Y/      Y
     2      /F/   DYDT
      Y=0.
      RETURN
      END
      SUBROUTINE INTAL2
      COMMON/T/      T,  NSTOP,  NORUN
     1      /Y/   Y(2)
     2      /F/DYDT(2)
      Y(1)=0.
      Y(2)=0.
      RETURN
      END
      SUBROUTINE DERV
      COMMON/T/      T,  NSTOP,  NORUN
      IF(NORUN.EQ.1)CALL DERV1
      IF(NORUN.EQ.2)CALL DERV2
      RETURN
      END
      SUBROUTINE DERV1
      COMMON/T/      T,  NSTOP,  NORUN
     1      /Y/      Y
     2      /F/   DYDT
      DYDT=1.0-Y
      RETURN
      END
      SUBROUTINE DERV2
      COMMON/T/      T,  NSTOP,  NORUN
     1      /Y/   Y(2)
     2      /F/DYDT(2)
      DYDT(1)= 1.0-Y(1)
      DYDT(2)=Y(1)-Y(2)
      RETURN
      END
      SUBROUTINE PRINT(NI,NO)
      COMMON/T/      T,  NSTOP,  NORUN
      IF(NORUN.EQ.1)CALL PRINT1(NI,NO)
      IF(NORUN.EQ.2)CALL PRINT2(NI,NO)
      RETURN
      END
      SUBROUTINE PRINT1(NI,NO)
      COMMON/T/      T,  NSTOP,  NORUN
     1      /Y/      Y
     2      /F/   DYDT
C...
C...  PRINT A HEADING FOR THE SOLUTION
      IF(T.EQ.0.)THEN
         WRITE(NO,1)
1        FORMAT(9X,'T',11X,'Y',10X,'YA',10X,'YD')
      END IF
C...
C...  COMPUTE THE ANALYTICAL SOLUTION
      YA=1.0-EXP(-T)
C...
C...  PRINT THE NUMERICAL AND ANALYTICAL SOLUTIONS, AND THEIR
C...  DIFFERENCE
      YD=Y-YA
      WRITE(NO,2)T,Y,YA,YD
2     FORMAT(F10.1,2F12.5,F12.7)
      RETURN
      END
      SUBROUTINE PRINT2(NI,NO)
      COMMON/T/      T,  NSTOP,  NORUN
     1      /Y/   Y(2)
     2      /F/DYDT(2)
C...
C...  PRINT A HEADING FOR THE SOLUTION
      IF(T.EQ.0.)THEN
         WRITE(NO,1)
1        FORMAT(9X,'T',10X,'Y2',9X,'Y2A',9X,'Y2D')
      END IF
C...
C...  COMPUTE THE ANALYTICAL SOLUTION
      EX=EXP(-T)
      Y2A=1.0-EX-T*EX
C...
C...  PRINT THE NUMERICAL AND ANALYTICAL SOLUTIONS, AND THEIR
C...  DIFFERENCE
      Y2D=Y(2)-Y2A
      WRITE(NO,2)T,Y(2),Y2A,Y2D
2     FORMAT(F10.2,2F12.5,F12.7)
      RETURN
      END
ONE ODE
0.        10.0      1.0
    1 1000    1    1  ABS 0.0001
TWO ODES
0.        10.0      1.0
    2 1000    1    1  ABS 0.0001
END OF RUNS
*APP MATH40
      SUBROUTINE INITAL
C...
C...  A PARABOLIC PARTIAL DIFFERENTIAL EQUATION WITH INCONSISTENT
C...  INITIAL AND BOUNDARY CONDITIONS
C...
C...  CONSIDER THE LINEAR, PARABOLIC PARTIAL DIFFERENTIAL EQUATION (PDE)
C...  I.E., FOURIER'S SECOND LAW
C...
C...     U  = U                                                 (1)
C...      T    XX
C...
C...  THE BOUNDARY CONDITIONS FOR EQUATION (1) ARE TAKEN AS
C...
C...     U(0,T) = 0, U (XL,T) = 0                            (2)(3)
C...                  X
C...
C...  AND THE INITIAL CONDITION AS
C...
C...     U(X,0) = 1                                             (4)
C...
C...  NOTE THAT BOUNDARY CONDITION (2) AND INITIAL CONDITION (4) ARE
C...  INCONSISTENT, I.E., U(0,0) IS AMBIGUOUS.  FORTUNATELY, DISCON-
C...  TINUITIES OF THIS TYPE (FROM U(X,0) = 1 TO U(0,T) = 0 AT X = T
C...  = 0) ARE GENERALLY DAMPED BY PARABOLIC PDES AND HAVE LITTE EFFECT
C...  AFTER T = 0.  THIS IS NOT TRUE FOR HYPERBOLIC PDES, HOWEVER,
C...  WHICH TEND TO PROPAGATE DISCONTINUITIES.
C...
C...  NUMERICAL AND ANALYTICAL SOLUTIONS TO EQUATIONS (1) TO (4) ARE
C...  COMPUTED AND COMPARED IN THE FOLLOWING CODING.  IN THIS CASE,
C...  THE NUMERICAL SOLUTION MAY BE MORE ACCURATE BECAUSE OF THE SLOW
C...  CONVERGENCE OF THE INFINITE SERIES IN THE ANALYTICAL SOLUTION
C...  (THE FOURIER COEFFICIENTS ARE PROPORTIONAL TO 1/N WHERE N IS THE
C...  SUMMATION INDEX BECAUSE OF THE DISCONTINUITY) AND THE GIBBS
C...  PHENOMENON NEAR X = 0.
C...
C...  THE ANALYTICAL SOLUTION TO EQUATIONS (1) TO (4) CAN BE DERIVED
C...  BY CLASSICAL FOURIER SERIES ANALYSIS.  A SOLUTION WHICH SATISFIES
C...  THE PDE, EQUATION (1), AND THE TWO BOUNDARY CONDITIONS, EQUATIONS
C...  (2) AND (3), IS OBTAINED BY STRAIGHTFORWARD SEPARATION OF VARI-
C...  ABLE AS
C...
C...              INF
C...     U(X,T) = SUM CN*EXP(-(EN**2)*T)*SIN(EN*X)              (5)
C...               1
C...
C...  WHERE THE EIGENVALUES ARE EN = (N - 1/2)*PI/XL, N = 1, 2,...
C...  APPLICATION OF THE INITIAL CONDITION, EQUATION (4), TO EQUATION
C...  (5) REQUIRES FOR THE FOURIER EXPANSION OF 1
C...
C...         INF
C...     1 = SUM CN*SIN(EN*X)                                   (6)
C...          1
C...
C...  MULTIPLICATION OF BOTH SIDES OF EQUATION (6) BY SIN(EM*X), AND
C...  INTEGRATION FROM X = 0 TO X = XL, KEEPING IN MIND THE ORTHOGON-
C...  ALITY OF THE SINE FUNCTIONS (SO THAT ONLY THE CASE N = M NEED BE
C...  CONSIDERED)
C...
C...      XL                      XL    2
C...     INT 1*SIN(EN*X)*DX = CN*INT SIN (EN*X)*DX              (7)
C...      0                       0
C...
C...  THE LHS INTEGRAL OF EQUATION (7) IS EASILY EVALUATED AS 1/EN.
C...  THE RHS INTEGRAL OF EQUATION (7) IS EASILY EVALUATED BY THE
C...  WELL KNOW TRIGONOMETRIC IDENTITY
C...
C...        2
C...     SIN (EN*X)  = (1/2)*(1 - COS (2*EN*X))
C...
C...  THUS
C...
C...      XL    2                   XL
C...     INT SIN (EN*X)*DX = (1/2) INT (1 - COS(2*EN*X))*DX
C...      1                         1
C...
C...                                      XL
C...                                       .
C...     = (1/2)*(X - 1/(2*EN)*SIN(2*EN*X)).
C...                                       .
C...                                       0
C...
C...     = (1/2)*(XL - 1/(2*EN)*SIN(2*(N - 1/2)*PI)) = (1/2)*XL
C...
C...
C...  THEREFORE, THE FOURIER COEFFICIENTS ARE
C...
C...     CN=2/(EN*XL)                                           (8)
C...
C...  EQUATIONS (5) AND (8) ARE THE ANALYTICAL SOLUTION.
C...
      COMMON/T/      T,  NSTOP,  NORUN
     1      /Y/  U(11)
     2      /F/ UT(11)
     3      /S/ UX(11),UXX(11)
     4      /C/     XL,      N,  NTYPE,     IP
C...
C...  SELECT TYPE OF SPATIAL DIFFERENTIATION
C...
C...     NTYPE = 1, STAGEWISE DIFFERENTIATION (IN SUBROUTINE DERV1)
C...
C...     NTYPE = 2, DIRECT DIFFERENTIATION (IN SUBROUTINE DERV2)
C...
      IF(NORUN.EQ.1)NTYPE=1
      IF(NORUN.EQ.2)NTYPE=2
C...
C...  NUMBER OF GRID POINTS
      N=11
C...
C...  TOTAL LENGTH
      XL=1.0
C...
C...  INITIAL CONDITION
      DO 1 I=1,N
      U(I)=1.0
1     CONTINUE
      RETURN
      END
      SUBROUTINE DERV
      COMMON/T/      T,  NSTOP,  NORUN
     1      /Y/  U(11)
     2      /F/ UT(11)
     3      /S/ UX(11),UXX(11)
     4      /C/     XL,      N,  NTYPE,     IP
C...
C...  STAGEWISE DIFFERENTIATION
      IF(NTYPE.EQ.1)CALL DERV1
C...
C...  DIRECT DIFFERENTIATION
      IF(NTYPE.EQ.2)CALL DERV2
      RETURN
      END
      SUBROUTINE DERV1
      COMMON/T/      T,  NSTOP,  NORUN
     1      /Y/  U(11)
     2      /F/ UT(11)
     3      /S/ UX(11),UXX(11)
     4      /C/     XL,      N,  NTYPE,     IP
C...
C...  BOUNDARY CONDITION AT X = 0
      U(1)=0.
C...
C...  UX
      CALL DSS004(0.,XL,N,U,UX)
C...
C...  BOUNDARY CONDITION AT X = XL
      UX(N)=0.
C...
C...  UXX
      CALL DSS004(0.,XL,N,UX,UXX)
C...
C...  PDE
      DO 1 I=1,N
      UT(I)=UXX(I)
1     CONTINUE
      RETURN
      END
      SUBROUTINE DERV2
      COMMON/T/      T,  NSTOP,  NORUN
     1      /Y/  U(11)
     2      /F/ UT(11)
     3      /S/ UX(11),UXX(11)
     4      /C/     XL,      N,  NTYPE,     IP
C...
C...  BOUNDARY CONDITION AT X = 0
      NL=1
      U(1)=0.
C...
C...  BOUNDARY CONDITION AT X = XL
      NU=2
      UX(N)=0.
C...
C...  UXX
      CALL DSS044(0.,XL,N,U,UX,UXX,NL,NU)
C...
C...  PDE
      DO 1 I=1,N
      UT(I)=UXX(I)
1     CONTINUE
      RETURN
      END
      FUNCTION UANAL(X,T,XL)
C...
C...  SUM 200 TERMS IN EQUATION (5)
      SUM=0.
      DO 1 N=1,200
C...
C...  EIGENVALUES
      EN=(FLOAT(N)-0.5)*3.1415927/XL
C...
C...  FOURIER COEFFICIENTS
      CN=2.0/(EN*XL)
C...
C...  ARGUMENT OF THE EXPONENTIAL IN EQUATION (5)
      ARG=-(EN**2)*T
C...
C...  BRANCH TO AVOID AN UNDERFLOW OF THE EXPONENTIAL FUNCTION
      IF(ARG.LT.-200.0)THEN
         EX=0.
      ELSE
         EX=EXP(ARG)
      END IF
C...
C...  NEXT TERM IN THE SERIES OF EQUATION (5)
      TERM=CN*EX*SIN(EN*X)
C...
C...  SUM THE SERIES IN EQUATION (5)
      SUM=SUM+TERM
1     CONTINUE
C...
C...  200 TERMS HAVE BEEN SUMMED AS THE ANALYTICAL SOLUTION
      UANAL=SUM
      RETURN
      END
      SUBROUTINE PRINT(NI,NO)
      COMMON/T/      T,  NSTOP,  NORUN
     1      /Y/  U(11)
     2      /F/ UT(11)
     3      /S/ UX(11),UXX(11)
     4      /C/     XL,      N,  NTYPE,     IP
      DIMENSION  XA(6),  UA(6)
C...
C...  COMPUTE THE ANALYTICAL SOLUTION AT X = 0, 0.2*XL, 0.4*XL, 0.8*XL,
C...  XL
      XA(1)=0.
      XA(2)=0.2*XL
      XA(3)=0.4*XL
      XA(4)=0.6*XL
      XA(5)=0.8*XL
      XA(6)=XL
      DO 1 I=1,6
      UA(I)=UANAL(XA(I),T,XL)
1     CONTINUE
C...
C...  PRINT THE NUMERICAL AND ANALYTICAL SOLUTIONS AT X = 0, 0.2*XL,
C...  0.4*XL, 0.6*XL, 0.8*XL, XL
      IF(T.EQ.0.)WRITE(NO,4)
4     FORMAT(10X,'T',8X,'X=0',3X,'X=0.2*XL',3X,'X=0.4*XL',
     1                        3X,'X=0.6*XL',3X,'X=0.8*XL',
     2                        7X,'X=XL')
      WRITE(NO,2)T,(U(I),I=1,N,2)
2     FORMAT(F11.2,/,'  NUMERICAL',6F11.4)
      WRITE(NO,3)(UA(I),I=1,6)
3     FORMAT(' ANALYTICAL',6F11.4,//)
      RETURN
      END
PARABOLIC PDE WITH INCONSISTENT IC AND BC
0.        1.0       0.1
   11 1000    1    1  REL 0.001
PARABOLIC PDE WITH INCONSISTENT IC AND BC
0.        1.0       0.1
   11 1000    1    1  REL 0.001
END OF RUNS
*APP MATH41
      SUBROUTINE INITAL
C...
C...  NUMERICAL INTEGRATION OF A PARTIAL DIFFERENTIAL EQUATION OVER
C...  A SEMI-INFINITE DOMAIN
C...
C...  CONSIDER THE LINEAR, PARABOLIC PARTIAL DIFFERENTIAL EQUATION (PDE)
C...  I.E., FOURIER'S SECOND LAW
C...
C...     U  = U                                                 (1)
C...      T    XX
C...
C...  THE BOUNDARY CONDITIONS FOR EQUATION (1) ARE TAKEN AS
C...
C...     U(0,T) = 0, U (INF,T) = 0                            (2)(3)
C...                  X
C...
C...  AND THE INITIAL CONDITION AS
C...
C...     U(X,0) = 1                                             (4)
C...
C...  NOTE THAT BOUNDARY CONDITION (2) AND INITIAL CONDITION (4) ARE
C...  INCONSISTENT, I.E., U(0,0) IS AMBIGUOUS.  FORTUNATELY, DISCON-
C...  TINUITIES OF THIS TYPE (FROM U(X,0) = 1 TO U(0,T) = 0 AT X = T
C...  = 0) ARE GENERALLY DAMPED BY PARABOLIC PDES AND HAVE LITTE EFFECT
C...  AFTER T = 0.  THIS IS NOT TRUE FOR HYPERBOLIC PDES, HOWEVER,
C...  WHICH TEND TO PROPAGATE DISCONTINUITIES.
C...
C...  NUMERICAL AND ANALYTICAL SOLUTIONS TO EQUATIONS (1) TO (4) ARE
C...  COMPARED IN THE FOLLOWING CODING.  SOME DIFFERENCE BETWEEN THE
C...  TWO SOLUTIONS IS TO BE EXPECTED SINCE THE NUMERICAL SOLUTION
C...  CANNOT BE COMPUTED OVER THE SEMI-INFINITE DOMAIN, 0 LE X LE INF,
C...  WITHOUT A MORE SOPHISTICATED PROCEDURE THAN IS USED IN THE
C...  FOLLOWING CODING.
C...
C...  THE ANALYTICAL SOLUTION IS EASILY DERIVED, E.G., BY LAPLACE
C...  TRANSFORMS, AND IS THE WELL KNOW ERROR FUNCTION, ERF,
C...
C...     U(X,T) = ERF(X/(2*(T**0.5)))                           (5)
C...
      COMMON/T/      T,  NSTOP,  NORUN
     1      /Y/  U(21)
     2      /F/ UT(21)
     3      /S/ UX(21),UXX(21)
     4      /C/     XL,      N,  NTYPE,     IP
C...
C...  SELECT TYPE OF SPATIAL DIFFERENTIATION
C...
C...     NTYPE = 1, STAGEWISE DIFFERENTIATION (IN SUBROUTINE DERV1)
C...
C...     NTYPE = 2, DIRECT DIFFERENTIATION (IN SUBROUTINE DERV2)
C...
      IF(NORUN.EQ.1)NTYPE=1
      IF(NORUN.EQ.2)NTYPE=2
C...
C...  NUMBER OF GRID POINTS
      N=21
C...
C...  TO APPROXIMATE THE SEMI-INFINITE DOMAIN, THE TOTAL LENGTH IN THE
C...  NUMERICAL SOLUTION WILL BE TAKEN AS XL = 10, AND THE SOLUTION
C...  WILL BE CONSIDERED AT X = 2 (WHICH MAKES THE ARGUMENT OF THE
C...  ERROR FUNCTION SOLUTION, Z = X/(2*T**0.5) = 1/T**0.5)
      XL=10.
C...
C...  INITIAL CONDITION
      DO 1 I=1,N
      U(I)=1.0
1     CONTINUE
      RETURN
      END
      SUBROUTINE DERV
      COMMON/T/      T,  NSTOP,  NORUN
     1      /Y/  U(21)
     2      /F/ UT(21)
     3      /S/ UX(21),UXX(21)
     4      /C/     XL,      N,  NTYPE,     IP
C...
C...  STAGEWISE DIFFERENTIATION
      IF(NTYPE.EQ.1)CALL DERV1
C...
C...  DIRECT DIFFERENTIATION
      IF(NTYPE.EQ.2)CALL DERV2
      RETURN
      END
      SUBROUTINE DERV1
      COMMON/T/      T,  NSTOP,  NORUN
     1      /Y/  U(21)
     2      /F/ UT(21)
     3      /S/ UX(21),UXX(21)
     4      /C/     XL,      N,  NTYPE,     IP
C...
C...  BOUNDARY CONDITION AT X = 0
      U(1)=0.
C...
C...  UX
      CALL DSS004(0.,XL,N,U,UX)
C...
C...  BOUNDARY CONDITION AT X = XL
      UX(N)=0.
C...
C...  UXX
      CALL DSS004(0.,XL,N,UX,UXX)
C...
C...  PDE
      DO 1 I=1,N
      UT(I)=UXX(I)
1     CONTINUE
      RETURN
      END
      SUBROUTINE DERV2
      COMMON/T/      T,  NSTOP,  NORUN
     1      /Y/  U(21)
     2      /F/ UT(21)
     3      /S/ UX(21),UXX(21)
     4      /C/     XL,      N,  NTYPE,     IP
C...
C...  BOUNDARY CONDITION AT X = 0
      NL=1
      U(1)=0.
C...
C...  BOUNDARY CONDITION AT X = XL
      NU=2
      UX(N)=0.
C...
C...  UXX
      CALL DSS044(0.,XL,N,U,UX,UXX,NL,NU)
C...
C...  PDE
      DO 1 I=1,N
      UT(I)=UXX(I)
1     CONTINUE
      RETURN
      END
      FUNCTION UANAL(Z)
C...
C...  FUNCTION UANAL SETS THE ANALYTICAL SOLUTION, ERF(Z), FOR
C...  Z = 0.2, 0.25, 0.5, 1.0, 1.25 AND Z GE 2.5
      IF((Z.GT.0.195).AND.(Z.LT.0.205))UANAL=0.22270
      IF((Z.GT.0.245).AND.(Z.LT.0.255))UANAL=0.27632
      IF((Z.GT.0.495).AND.(Z.LT.0.505))UANAL=0.52049
      IF((Z.GT.0.995).AND.(Z.LT.1.005))UANAL=0.84270
      IF((Z.GT.1.245).AND.(Z.LT.1.255))UANAL=0.92290
      IF (Z.GT.2.445)UANAL=1.0
      RETURN
      END
      SUBROUTINE PRINT(NI,NO)
      COMMON/T/      T,  NSTOP,  NORUN
     1      /Y/  U(21)
     2      /F/ UT(21)
     3      /S/ UX(21),UXX(21)
     4      /C/     XL,      N,  NTYPE,     IP
C...
C...  COMPUTE THE ANALYTICAL SOLUTION ACCORDING TO THE FOLLOWING
C...  TABLE (Z = X/(2*(T**0.5)))
C...
C...     X = 2      T = 1      T = 4     T = 16     T = 25
C...
C...       Z          1         0.5       0.25       0.2
C...
C...    ERF(Z)     0.84270    0.52049   0.27632    0.22270
C...
C...    X = 10      T = 1      T = 4     T = 16     T = 25
C...
C...       Z          5         2.5       1.25        1
C...
C...    ERF(Z)     1.00000    1.00000   0.92290    0.84270
C...
C...  THESE VALUES OF THE ANALYTICAL SOLUTION WERE TAKEN FROM THE
C...  HANDBOOK OF MATHEMATICAL FUNCTIONS, M. ABRAMOWITZ AND I. A.
C...  STEGUN (EDS), NATIONAL BUREAU OF STANDARDS APPLIED MATHEMATICS
C...  SERIES NO. 55, PP 310-311.  THEY ARE SET NUMERICALLY IN
C...  FUNCTION UANAL.
      IF(((T.GT.0.995).AND.(T.LT.1.005)).OR.
     1   ((T.GT.3.995).AND.(T.LT.4.004)).OR.
     2   ((T.GT.15.95).AND.(T.LT.16.05)).OR.
     3   ((T.GT.24.95).AND.(T.LT.25.05)))THEN
         Z2 =1.0/SQRT(T)
         Z10=5.0/SQRT(T)
         UA2 =UANAL (Z2)
         UA10=UANAL(Z10)
C...
C...  PRINT THE NUMERICAL AND ANALYTICAL SOLUTIONS AT X = 2 AND X = 10
      IF((T.GT.0.995).AND.(T.LT.1.005))WRITE(NO,4)
4     FORMAT(10X,'T',5X, 'U(2,T)',4X, 'UA(2,T)',
     1               4X,'U(10,T)',3X,'UA(10,T)')
      WRITE(NO,2)T,U(5),UA2,U(21),UA10
2     FORMAT(F11.1,4F11.5)
      END IF
      RETURN
      END
PARABOLIC PDE OVER A SEMI-INFINITE SPATIAL INTERVAL
0.        25.0      1.0
   21 1000    1    1  REL 0.001
PARABOLIC PDE OVER A SEMI-INFINITE SPATIAL INTERVAL
0.        25.0      1.0
   21 1000    1    1  REL 0.001
END OF RUNS
*APP MATH42
      SUBROUTINE INITAL
C...
C...  AN INTRODUCTION TO FINITE INTEGRAL TRANSFORMS
C...
C...  THE FOLLOWING DEVELOPMENT ILLUSTRATES THE DERIVATION OF A FINITE
C...  INTEGRAL TRANSFORM IN TERMS OF AN APPLICATION.  THE INTENT IS TO
C...  DEMONSTRATE HOW THESE TRANSFORMS CAN BE DEVELOPED AND USED IN
C...  THE SOLUTION OF PARTIAL DIFFERENTIAL EQUATIONS.
C...
C...  CONSIDER THE LINEAR, PARABOLIC PARTIAL DIFFERENTIAL EQUATION (PDE)
C...  I.E., FOURIER'S SECOND LAW
C...
C...     U  = U                                                 (1)
C...      T    XX
C...
C...  THE BOUNDARY CONDITIONS FOR EQUATION (1) ARE TAKEN AS
C...
C...     U(0,T) = 0, U (XL,T) = 0                            (2)(3)
C...                  X
C...
C...  AND THE INITIAL CONDITION AS
C...
C...     U(X,0) = 1                                             (4)
C...
C...  NOTE THAT BOUNDARY CONDITION (2) AND INITIAL CONDITION (4) ARE
C...  INCONSISTENT, I.E., U(0,0) IS AMBIGUOUS.  FORTUNATELY, DISCON-
C...  TINUITIES OF THIS TYPE (FROM U(X,0) = 1 TO U(0,T) = 0 AT X = T
C...  = 0) ARE GENERALLY DAMPED BY PARABOLIC PDES AND HAVE LITTE EFFECT
C...  AFTER T = 0.  THIS IS NOT TRUE FOR HYPERBOLIC PDES, HOWEVER,
C...  WHICH TEND TO PROPAGATE DISCONTINUITIES.
C...
C...  NUMERICAL AND ANALYTICAL SOLUTIONS TO EQUATIONS (1) TO (4) ARE
C...  COMPUTED AND COMPARED IN THE FOLLOWING CODING.  IN THIS CASE,
C...  THE NUMERICAL SOLUTION MAY BE MORE ACCURATE BECAUSE OF THE SLOW
C...  CONVERGENCE OF THE INFINITE SERIES IN THE ANALYTICAL SOLUTION
C...  (THE FOURIER COEFFICIENTS ARE PROPORTIONAL TO 1/N WHERE N IS THE
C...  SUMMATION INDEX BECAUSE OF THE DISCONTINUITY) AND THE GIBBS
C...  PHENOMENON NEAR X = 0.
C...
C...  THE ANALYTICAL SOLUTION TO EQUATIONS (1) TO (4) CAN BE DERIVED
C...  BY CLASSICAL FOURIER SERIES ANALYSIS.  A SOLUTION WHICH SATISFIES
C...  THE PDE, EQUATION (1), AND THE TWO BOUNDARY CONDITIONS, EQUATIONS
C...  (2) AND (3), IS OBTAINED BY STRAIGHTFORWARD SEPARATION OF VARI-
C...  ABLE AS
C...
C...              INF
C...     U(X,T) = SUM CN*EXP(-(EN**2)*T)*SIN(EN*X)              (5)
C...               1
C...
C...  WHERE THE EIGENVALUES ARE EN = (N - 1/2)*PI/XL, N = 1, 2,...
C...  APPLICATION OF THE INITIAL CONDITION, EQUATION (4), TO EQUATION
C...  (5) REQUIRES FOR THE FOURIER EXPANSION OF 1
C...
C...         INF
C...     1 = SUM CN*SIN(EN*X)                                   (6)
C...          1
C...
C...  MULTIPLICATION OF BOTH SIDES OF EQUATION (6) BY SIN(EM*X), AND
C...  INTEGRATION FROM X = 0 TO X = XL, KEEPING IN MIND THE ORTHOGON-
C...  ALITY OF THE SINE FUNCTIONS (SO THAT ONLY THE CASE N = M NEED BE
C...  CONSIDERED)
C...
C...      XL                      XL    2
C...     INT 1*SIN(EN*X)*DX = CN*INT SIN (EN*X)*DX              (7)
C...      0                       0
C...
C...  THE LHS INTEGRAL OF EQUATION (7) IS EASILY EVALUATED AS 1/EN.
C...  THE RHS INTEGRAL OF EQUATION (7) IS EASILY EVALUATED BY THE
C...  WELL KNOW TRIGONOMETRIC IDENTITY
C...
C...        2
C...     SIN (EN*X)  = (1/2)*(1 - COS (2*EN*X))
C...
C...  THUS
C...
C...      XL    2                   XL
C...     INT SIN (EN*X)*DX = (1/2) INT (1 - COS(2*EN*X))*DX
C...      1                         1
C...
C...                                      XL
C...                                       .
C...     = (1/2)*(X - 1/(2*EN)*SIN(2*EN*X)).
C...                                       .
C...                                       0
C...
C...     = (1/2)*(XL - 1/(2*EN)*SIN(2*(N - 1/2)*PI)) = (1/2)*XL
C...
C...
C...  THEREFORE, THE FOURIER COEFFICIENTS ARE
C...
C...     CN=2/(EN*XL)                                           (8)
C...
C...  EQUATIONS (5) AND (8) ARE THE ANALYTICAL SOLUTION.
C...
C...  AN ALTERNATIVE APPROACH TO THIS CONVENTIONAL SEPARATIONS OF
C...  SERIES SOLUTION IS TO DEFINE A FINITE INTEGRAL TRANSFORM, G(EN),
C...  OF A FUNCTION F(X)
C...
C...              XL
C...     G(EN) = INT F(X)*SIN(EN*X)*DX                          (9)
C...              0
C...
C...     WITH THE INVERSE TRANSFORM
C...
C...                   INF
C...     F(X) = (2/XL) SUM G(EN)*SIN(EN*X)                     (10)
C...                   N=1
C...
C...  WHERE, AGAIN, EN = PI*(N - 1/2)/XL, N = 1, 2,...
C...
C...  USING THE DEFINITION OF THE TRANSFORM, EQUATION (9), THE
C...  FOLLOWING TRANSFORM PAIRS CAN BE DERIVED
C...
C...           F(X)                     G(EN)
C...
C...          A*F(X)                   A*G(EN)
C...
C...    A*F1(X) + B*F2(X)        A*G1(EN) + B*G2(EN)
C...
C...            1                       1/EN
C...
C...          F''(X)              (-1**(N+1))*F'(XL)
C...
C...                                 + EN*F(0)
C...
C...                              - (EN**2)*G(EN)
C...
C...  THE TRANSFORM OF F''(X), WHICH IS CENTRAL TO THE SOLUTION OF
C...  SECOND-ORDER PDES, IS OBTAINED IN THE FOLLOWING WAY
C...
C...              XL
C...     G(EN) = INT F''(X)*SIN(EN*X)*DX
C...              0
C...
C...                           XL
C...                            .       XL
C...           = F'(X)*SIN(EN*X). - EN INT F'(X)*COS(EN*X)*DX
C...                            .       0
C...                            0
C...
C...           = (-1**(N+1))*F'(XL)
C...
C...                               XL
C...                               .            XL
C...           - EN*(F(X)*COS(EN*X). + (EN**2) INT F(X)*SIN(EN*X)DX
C...                               .            0
C...                               0
C...
C...            = (-1**(N+1))*F'(XL) + EN*F(0) - (EN**2)*G(EN)
C...
C...  THIS RESULT SUGGESTS THAT TRANSFORM PAIRS (9) AND (10) CAN BE
C...  USED IN THE SOLUTION OF SECOND-ORDER PDES WITH A DIRICHLET
C...  BOUNDARY CONDITION AT X = 0 (DUE TO THE TERM EN*F(0)) AND A
C...  NEUMANN BOUNDARY CONDITION AT X = XL (DUE TO THE TERM (-1**(N+1)
C...  *F'(XL)).
C...
C...  SPECIFICALLY, FOR THE PROBLEM DEFINED BY EQUATIONS (1) TO (4),
C...  IF A FINITE INTEGRAL TRANSFORM OF U(X,T) WITH RESPECT TO X IS
C...  DEFINED AS V(EN,T), EQUATIONS (1) TO (4) TRANSFORM TO
C...
C...     V  = (EN**2)*V                                         (11)
C...      T
C...
C...     V(EN,0) = 1/EN                                         (12)
C...
C...  THE SOLUTION TO EQUATIONS (11) AND (12) IS EASILY OBTAINED AS
C...
C...     V(EN,T) = (1/EN)*EXP(-(EN**2)*T)
C...
C...  WHICH, WHEN SUBSTITUTED IN THE INVERSION FORMULAS, EQUATION (10),
C...  GIVES THE PREVIOUS SEPARATION OF VARIABLES SOLUTION, EQUATIONS
C...  (5) AND (8)
C...
C...                     INF
C...     U(X,T) = (2/XL) SUM (1/EN)*EXP(-(EN**2)*T)*SIN(EN*X)   (13)
C...                      1
C...
C...  THE PRECEDING DISCUSSION OF THE FINITE INTEGRAL TRANSFORM
C...  SUGGESTS A GENERALIZATION LEADING TO FOUR TRANSFORMS, TWO FOR
C...  THE SINE KERNEL FUNCTION SIN(EN*X), WITH EN = PI*N/XL OR
C...  EN = PI*(N - 1/2)/XL, AND TWO FOR THE COSINE KERNEL FUNCTION
C...  COS(EN*X), WITH EN = PI*N/XL OR EN = PI*(N - 1/2)/XL.
C...
C...  FOR THE SINE FUNCTION, THE TRANSFORM OF THE SECOND DERIVATIVE
C...  OF A FUNCTION F(X) IS
C...
C...     INT F''(X)*SIN(EN*X)*DX =
C...
C...                    XL
C...                    .       XL
C...     F'(X)*SIN(EN*X). - EN INT F'(X)*COS(EN*X)*DX
C...                    .       0
C...                    0
C...
C...     = F'(XL)*SIN(EN*XL)
C...
C...                         XL
C...                         .       XL
C...     - EN*(F(X)*COS(EN*X). + EN INT F(X)*SIN(EN*X)*DX)
C...                         .       0
C...                         0
C...
C...     = F'(XL)*SIN(EN*XL) - EN*F(XL)*COS(EN*XL) + EN*F(0)
C...
C...     - (EN**2)*G(EN)
C...
C...  FOR EN = PI*N/XL, THIS RESULT REDUCES TO
C...
C...     -EN*F(XL)*(-1**N) + EN*F(0) - (EN**2)*G(EN)            (14)
C...
C...  WHILE FOR EN = PI*(N - 1/2)/XL, WE OBTAIN THE PREVIOUS RESULT
C...
C...     F'(XL)*(-1**(N+1)) + EN*F(0) - (EN**2)*G(EN)           (15)
C...
C...  SIMILARLY, FOR THE COSINE FUNCTION
C...
C...      XL
C...     INT F''(X)*COS(EN*X)*DX =
C...      0
C...
C...                    XL
C...                    .       XL
C...     F'(X)*COS(EN*X). + EN INT F'(X)*SIN(EN*X)*DX
C...                    .       0
C...                    0
C...
C...     = F'(XL)*COS(EN*XL) - F'(0)
C...
C...                         XL
C...                         .       XL
C...     + EN*(F(X)*SIN(EN*X). - EN INT F(X)*COS(EN*X)*DX)
C...                         .       0
C...                         0
C...
C...     = F'(XL)*COS(EN*XL) - F'(0)
C...
C...     + EN*F(XL)*SIN(EN*XL) - (EN**2)*G(EN)
C...
C...  FOR EN = PI*N/XL, THIS RESULT REDUCES TO
C...
C...     F'(XL)*(-1**N) - F'(0)  - (EN**2)*G(EN)                (16)
C...
C...  WHILE FOR EN = PI*(N - 1/2)/XL,
C...
C...     - F'(0) + EN*F(XL)*(-1**N) - (EN**2)*G(EN)             (17)
C...
C...  THE FOUR TRANSFORMS CAN BE SUMMARIZED AS
C...
C...
C...             F(X)                       G(EN)
C...
C...     INT F(X)*SIN(EN*X)*DX     (2/XL) SUM G(EN)*SIN(EN*X)
C...
C...        EN = PI*N/XL
C...
C...            F''(X)           - EN*F(XL)*(-1**N) + EN*F(0)
C...
C...                                  - (EN**2)*G(EN)
C...
C...        USE WITH DIRICHLET BC AT X = 0 AND DIRICHLET BC AT X = XL
C...
C...
C...     EN = PI*(N - 1/2)/XL
C...
C...            F''(X)           F'(XL)*(-1**(N+1)) + EN*F(0)
C...
C...                                  - (EN**2)*G(EN)
C...
C...        USE WITH DIRICHLET BC AT X = 0 AND NEUMANN BC AT X = XL
C...
C...
C...      XL
C...     INT F(X)*COS(EN*X)*DX     (2/XL) SUM G(EN)*COS(EN*X)
C...      0
C...
C...        EN = PI*N/XL
C...
C...              F''(X)           F'(XL)*(-1**N) - F'(0)
C...
C...                                  - (EN**2)*G(EN)
C...
C...       USE WITH NEUMANN BC AT X = 0 AND NEUMANN BC AT X = XL
C...
C...
C...     EN = PI*(N - 1/2)/XL
C...
C...            F''(X)           - F'(0) + EN*F(XL)*(-1**N)
C...
C...                                  - (EN**2)*G(EN)
C...
C...        USE WITH NEUMANN BC AT X = 0 AND DIRICHLET BC AT X = XL
C...
C...
C...  OF COURSE, MANY OTHER FINITE INTEGRAL TRANSFORMS ARE POSSIBLE
C...  THROUGH THE USE OF VARIOUS ORTHOGONAL FUNCTIONS, E.G., THE
C...  SO-CALLED 'HANKEL TRANSFORMS' BASED ON BESSEL FUNCTIONS.  THE
C...  PRINCIPAL ADVANTAGES OF FINITE TRANSFORMS ARE
C...
C...     (1)  THEY SYSTEMATIZE THE SEPARATION OF VARIABLES SOLUTION
C...          OF LINEAR PARTIAL DIFFERENTIAL EQUATIONS.
C...
C...     (2)  THE INVERSION OF THE TRANSFORM IS PARTICULAR EASY (THE
C...          DESCRIPTION 'FINITE (INTEGRAL) TRANSFORM' REFERS TO
C...          INVERSION WHICH REQUIRES ONLY A SUBSTITUTION INTO AN
C...          INFINITE SERIES, RATHER THAN THE EVALUATION OF AN
C...          INVERSION INTEGRAL, E.G., A FOURIER OR LAPLACE TRANS-
C...          FORM).
C...
C...  GENERALLY THOUGH, FINITE INTEGRAL TRANSFORMS ARE LIMITED TO
C...  PROBLEMS FOR WHICH SEPARATION OF VARIABLES CAN BE APPLIED,
C...  I.E., THEY CANNOT GO BEYOND WHAT CAN BE ACCOMPLISHED WITH THE
C...  SEPARATION OF VARIABLES.
C...
C...  THE FOLLOWING CODING IMPLEMENTS A NUMERICAL METHOD OF LINES
C...  SOLUTION TO EQUATIONS (1) TO (4), WHICH IS COMPARED WITH THE
C...  ANALYTICAL SOLUTION, EQUATIONS (5) AND (8) (OR EQUATION (13)).
C...
      COMMON/T/      T,  NSTOP,  NORUN
     1      /Y/  U(11)
     2      /F/ UT(11)
     3      /S/ UX(11),UXX(11)
     4      /C/     XL,      N,  NTYPE,     IP
C...
C...  SELECT TYPE OF SPATIAL DIFFERENTIATION
C...
C...     NTYPE = 1, STAGEWISE DIFFERENTIATION (IN SUBROUTINE DERV1)
C...
C...     NTYPE = 2, DIRECT DIFFERENTIATION (IN SUBROUTINE DERV2)
C...
      IF(NORUN.EQ.1)NTYPE=1
      IF(NORUN.EQ.2)NTYPE=2
C...
C...  NUMBER OF GRID POINTS
      N=11
C...
C...  TOTAL LENGTH
      XL=1.0
C...
C...  INITIAL CONDITION
      DO 1 I=1,N
      U(I)=1.0
1     CONTINUE
      RETURN
      END
      SUBROUTINE DERV
      COMMON/T/      T,  NSTOP,  NORUN
     1      /Y/  U(11)
     2      /F/ UT(11)
     3      /S/ UX(11),UXX(11)
     4      /C/     XL,      N,  NTYPE,     IP
C...
C...  STAGEWISE DIFFERENTIATION
      IF(NTYPE.EQ.1)CALL DERV1
C...
C...  DIRECT DIFFERENTIATION
      IF(NTYPE.EQ.2)CALL DERV2
      RETURN
      END
      SUBROUTINE DERV1
      COMMON/T/      T,  NSTOP,  NORUN
     1      /Y/  U(11)
     2      /F/ UT(11)
     3      /S/ UX(11),UXX(11)
     4      /C/     XL,      N,  NTYPE,     IP
C...
C...  BOUNDARY CONDITION AT X = 0
      U(1)=0.
C...
C...  UX
      CALL DSS004(0.,XL,N,U,UX)
C...
C...  BOUNDARY CONDITION AT X = XL
      UX(N)=0.
C...
C...  UXX
      CALL DSS004(0.,XL,N,UX,UXX)
C...
C...  PDE
      DO 1 I=1,N
      UT(I)=UXX(I)
1     CONTINUE
      RETURN
      END
      SUBROUTINE DERV2
      COMMON/T/      T,  NSTOP,  NORUN
     1      /Y/  U(11)
     2      /F/ UT(11)
     3      /S/ UX(11),UXX(11)
     4      /C/     XL,      N,  NTYPE,     IP
C...
C...  BOUNDARY CONDITION AT X = 0
      NL=1
      U(1)=0.
C...
C...  BOUNDARY CONDITION AT X = XL
      NU=2
      UX(N)=0.
C...
C...  UXX
      CALL DSS044(0.,XL,N,U,UX,UXX,NL,NU)
C...
C...  PDE
      DO 1 I=1,N
      UT(I)=UXX(I)
1     CONTINUE
      RETURN
      END
      FUNCTION UANAL(X,T,XL)
C...
C...  SUM 200 TERMS IN EQUATION (5)
      SUM=0.
      DO 1 N=1,200
C...
C...  EIGENVALUES
      EN=(FLOAT(N)-0.5)*3.1415927/XL
C...
C...  FOURIER COEFFICIENTS
      CN=2.0/(EN*XL)
C...
C...  ARGUMENT OF THE EXPONENTIAL IN EQUATION (5)
      ARG=-(EN**2)*T
C...
C...  BRANCH TO AVOID AN UNDERFLOW OF THE EXPONENTIAL FUNCTION
      IF(ARG.LT.-200.0)THEN
         EX=0.
      ELSE
         EX=EXP(ARG)
      END IF
C...
C...  NEXT TERM IN THE SERIES OF EQUATION (5)
      TERM=CN*EX*SIN(EN*X)
C...
C...  SUM THE SERIES IN EQUATION (5)
      SUM=SUM+TERM
1     CONTINUE
C...
C...  200 TERMS HAVE BEEN SUMMED AS THE ANALYTICAL SOLUTION
      UANAL=SUM
      RETURN
      END
      SUBROUTINE PRINT(NI,NO)
      COMMON/T/      T,  NSTOP,  NORUN
     1      /Y/  U(11)
     2      /F/ UT(11)
     3      /S/ UX(11),UXX(11)
     4      /C/     XL,      N,  NTYPE,     IP
      DIMENSION  XA(6),  UA(6)
C...
C...  COMPUTE THE ANALYTICAL SOLUTION AT X = 0, 0.2*XL, 0.4*XL, 0.8*XL,
C...  XL
      XA(1)=0.
      XA(2)=0.2*XL
      XA(3)=0.4*XL
      XA(4)=0.6*XL
      XA(5)=0.8*XL
      XA(6)=XL
      DO 1 I=1,6
      UA(I)=UANAL(XA(I),T,XL)
1     CONTINUE
C...
C...  PRINT THE NUMERICAL AND ANALYTICAL SOLUTIONS AT X = 0, 0.2*XL,
C...  0.4*XL, 0.6*XL, 0.8*XL, XL
      IF(T.EQ.0.)WRITE(NO,4)
4     FORMAT(10X,'T',8X,'X=0',3X,'X=0.2*XL',3X,'X=0.4*XL',
     1                       3X,'X=0.6*XL',3X,'X=0.8*XL',
     2                       7X,'X=XL')
      WRITE(NO,2)T,(U(I),I=1,N,2)
2     FORMAT(F11.2,/,'  NUMERICAL',6F11.4)
      WRITE(NO,3)(UA(I),I=1,6)
3     FORMAT(' ANALYTICAL',6F11.4,//)
      RETURN
      END
PARABOLIC PDE WITH INCONSISTENT IC AND BC
0.        1.0       0.1
   11 1000    1    1  REL 0.001
PARABOLIC PDE WITH INCONSISTENT IC AND BC
0.        1.0       0.1
   11 1000    1    1  REL 0.001
END OF RUNS
*APP MATH43
      PROGRAM LSODET
C...
C...  AN INTERFACE BETWEEN DSS/2 APPLICATIONS AND INTEGRATOR LSODE
C...
C...  THE FOLLOWING PROGRAM CALLS A DSS/2 APPLICATION, DEFINED AS THE
C...  USER-SUPPLIED SUBROUTINES INITAL, DERV AND PRINT, PLUS DATA.
C...  THE SYSTEM OF ODES PROGRAMMED IN SUBROUTINE DERV IS INTEGRATED
C...  BY LSODE (THE BASIC SOLVER IN ODEPACK, A LIBRARY OF INTEGRATORS
C...  DEVELOPED BY ALAN C. HINDMARSH, LAWRENCE LIVERMORE NATIONAL LAB-
C...  ORATORY).
C...
C...  THE MODEL INITIAL CONDITIONS ARE SET IN SUBROUTINE INITAL, AND
C...  THE MODEL DERIVATIVES ARE PROGRAMMED IN SUBROUTINE DERV.  THE
C...  NUMERICAL SOLUTION IS PRINTED AND PLOTTED IN SUBROUTINE PRINT.
C...
C...  TYPE ALL REAL VARIABLES AS DOUBLE PRECISION
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C...
C...  SUBROUTINES INITAL, DERV AND PRINT.  THE FOLLOWING CODING IS FOR
C...  250 ORDINARY DIFFERENTIAL EQUATIONS (ODES).  IF MORE ODES ARE TO
C...  BE INTEGRATED, ALL OF THE 250*S SHOULD BE CHANGED TO THE REQUIRED
C...  NUMBER
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/    Y(250)
     2      /F/    F(250)
C...
C...  COMMON AREA TO PROVIDE THE INPUT/OUTPUT UNIT NUMBERS TO OTHER
C...  SUBROUTINES
      COMMON/IO/       NI,        NO
C...
C...  ABSOLUTE DIMENSIONING OF THE ARRAYS REQUIRED BY LSODE.  ARRAY
C...  WORK IS SIZED BY THE FOLLOWING FORMULA FOR BANDED PROCESSING
C...  OF THE ODE JACOBIAN MATRIX VIA FINITE DIFFERENCES: 22+17*NEQN+
C...  (2*ML+MU)*NEQN.  FOR NEQN = 250, ML = MU = 3, 22+17*250+(2*3+3)*
C...  250 = 6600 (APPROXIMATELY).  IF FEWER THAN 250 ODES ARE TO BE
C...  INTEGRATED, THEN ML AND MU CAN BE LARGER FOR THE GIVEN SIZE OF
C...  WORK.  IF NEQN GT 250 AND/OR ML AND MU GT 3, WORK MUST BE DIMEN-
C...  SIONED TO A LARGER SIZE
      DIMENSION YV(250), RWORK(6600), IWORK(275)
C...
C...  EXTERNAL THE DERIVATIVE AND ODE JACOBIAN MATRIX ROUTINES CALLED BY
C...  LSODE
      EXTERNAL FCN, JAC
C...
C...  ARRAY FOR THE TITLE (FIRST LINE OF DATA), CHARACTERS  END OF RUNS
      CHARACTER TITLE(20)*4, ENDRUN(3)*4
C...
C...  VARIABLE FOR THE TYPE OF ERROR CRITERION
      CHARACTER*3 ABSREL
C...
C...  DEFINE THE CHARACTERS  END OF RUNS
      DATA ENDRUN/'END ','OF RU','NS  '/
C...
C...  DEFINE THE INPUT/OUTPUT UNIT NUMBERS
      NI=5
      NO=6
C...
C...  OPEN THE INPUT/OUTPUT FILES
      OPEN(NI,FILE='INPUT')
      OPEN(NO,FILE='OUTPUT')
C...
C...  INITIALIZE THE RUN COUNTER
      NORUN=0
C...
C...  BEGIN A RUN
1     NORUN=NORUN+1
C...
C...  INITIALIZE THE RUN TERMINATION VARIABLE
      NSTOP=0
C...
C...  READ THE FIRST LINE OF DATA
      READ(NI,1000,END=999)(TITLE(I),I=1,20)
C...
C...  TEST FOR  END OF RUNS  IN THE DATA
      DO 2 I=1,3
      IF(TITLE(I).NE.ENDRUN(I))GO TO 3
2     CONTINUE
C...
C...  AN END OF RUNS HAS BEEN READ, SO TERMINATE EXECUTION
999   STOP
C...
C...  READ THE SECOND LINE OF DATA
3     READ(NI,1001,END=999)T0,TF,TP
C...
C...  READ THE THIRD LINE OF DATA
      READ(NI,1002,END=999)NEQN,NMAX,INT,IERROR,ABSREL,ERROR
C...
C...  PRINT A DATA SUMMARY
      WRITE(NO,1003)NORUN,(TITLE(I),I=1,20),
     1                     T0,TF,TP,
     2                     NEQN,NMAX,INT,IERROR,ABSREL,ERROR
C...
C...  INITIALIZE TIME
      T=T0
C...
C...  SET THE INITIAL CONDITIONS
      CALL INITAL
C...
C...  PRINT THE INITIAL CONDITIONS
      CALL PRINT(NI,NO)
C...
C...  SET THE INITIAL CONDITIONS FOR SUBROUTINE LSODE
      DO 5 I=1,NEQN
      YV(I)=Y(I)
5     CONTINUE
C...
C...  SET THE PARAMETERS FOR SUBROUTINE LSODE
      TV=T0
      ITOL=1
      RTOL=ERROR
      ATOL=1.0D-10
      LRW=6600
      LIW=275
      IOPT=0
      ITASK=1
      ISTATE=1
C...
C...  SEVERAL LSODE OPTIONS, AS SELECTED BY THE RUN NUMBER NORUN, ARE
C...  PROGRAMMED HERE. THE TERMINOLOGY IS
C...
C...     IMPLICIT ADAMS METHOD FOR NONSTIFF PROBLEMS
C...
C...     METHOD BASED ON BACKWARD DIFFERENTIATION FORMULAS (BDF) FOR
C...     STIFF PROBLEMS
C...
C...  EACH OF THESE METHODS (NONSTIFF AND STIFF) GENERATES NONLINEAR
C...  ALGEBRAIC EQUATIONS DURING THE NUMERICAL INTEGRATION WHICH ARE
C...  SOLVED BY ONE OF THE FOLLOWING METHODS
C...
C...     FUNCTIONAL ITERATION (A PICARD ITERATION)
C...
C...     CHORD ITERATION, ESSENTIALLY NEWTON*S METHOD, WITH THE ODE
C...     JACOBIAN MATRIX PARTIAL DERIVATIVES APPROXIMATED BY FINITE
C...     DIFFERENCES.  A FULL, BANDED OR DIAGONAL MATRIX MAY BE USED.
C...     THE BANDED AND DIAGONAL FORMS TYPICALLY ARE APPROXIMATIONS TO
C...     THE FULL MATRIX, I.E., CONTAIN A SUBSET OF THE ELEMENTS OF THE
C...     FULL MATRIX.
C...
C...  SINCE A STIFF ODE PROBLEM IS BEING INTEGRATED, THE STIFF OPTION
C...  WITH INTERNALLY GENERATED JACOBIAN MATRIX IS SELECTED
      NORUN=6
C...
C...     (1)  NORUN = 1
C...
C...          IMPLICIT ADAMS METHOD, FUNCTIONAL ITERATION
              IF(NORUN.EQ.1)THEN
              METH=1
              MITER=0
C...
C...     (2)  NORUN = 2
C...
C...          IMPLICIT ADAMS METHOD, CHORD ITERATION WITH AN INTERNALLY
C...          GENERATED (DIFFERENCE QUOTIENT) FULL JACOBIAN
              ELSE IF(NORUN.EQ.2)THEN
              METH=1
              MITER=2
C...
C...     (3)  NORUN = 3
C...
C...          IMPLICIT ADAMS METHOD, CHORD ITERATION WITH AN INTERNALLY
C...          GENERATED (DIFFERENCE QUOTIENT) DIAGONAL JACOBIAN APPROXI-
C...          TION
              ELSE IF(NORUN.EQ.3)THEN
              METH=1
              MITER=3
C...
C...     (4)  NORUN = 4
C...
C...          IMPLICIT ADAMS METHOD, CHORD ITERATION WITH AN INTERNALLY
C...          GENERATED (DIFFERENCE QUOTIENT) BANDED JACOBIAN
              ELSE IF(NORUN.EQ.4)THEN
              METH=1
              MITER=5
              IWORK(1)=1
              IWORK(2)=1
C...
C...     (5)  NORUN = 5
C...
C...          IMPLICIT BDF METHOD, FUNCTIONAL ITERATION
              ELSE IF(NORUN.EQ.5)THEN
              METH=2
              MITER=0
C...
C...     (6)  NORUN = 6
C...
C...          IMPLICIT BDF METHOD, CHORD ITERATION WITH AN INTERNALLY
C...          GENERATED (DIFFERENCE QUOTIENT) FULL JACOBIAN
              ELSE IF(NORUN.EQ.6)THEN
              METH=2
              MITER=2
C...
C...     (7)  NORUN = 7
C...
C...          IMPLICIT BDF METHOD, CHORD ITERATION WITH AN INTERNALLY
C...          GENERATED (DIFFERENCE QUOTIENT) DIAGONAL JACOBIAN APPROXI-
C...          TION
              ELSE IF(NORUN.EQ.7)THEN
              METH=2
              MITER=3
C...
C...     (8)  NORUN = 8
C...
C...          IMPLICIT BDF METHOD, CHORD ITERATION WITH AN INTERNALLY
C...          GENERATED (DIFFERENCE QUOTIENT) BANDED JACOBIAN
              ELSE IF(NORUN.EQ.8)THEN
              METH=2
              MITER=5
              IWORK(1)=1
              IWORK(2)=1
      END IF
C...
C...  THE METHOD FLAG, MF, IS COMPUTED FROM METH AND MITER
      MF=10*METH+MITER
C...
C...  INITIATE THE INTEGRATION
      TOUT=TV+TP
C...
C...  CALL SUBROUTINE LSODE TO COVER ONE PRINT INTERVAL
4     CALL LSODE(FCN,NEQN,YV,TV,TOUT,ITOL,RTOL,ATOL,ITASK,ISTATE,
     1           IOPT,RWORK,LRW,IWORK,LIW,JAC,MF)
C...
C...  PRINT THE SOLUTION
      T=TV
      DO 6 I=1,NEQN
      Y(I)=YV(I)
6     CONTINUE
      CALL PRINT(NI,NO)
C...
C...  TEST FOR AN ERROR CONDITION
      IF(ISTATE.LT.0)THEN
C...
C...     PRINT A MESSAGE INDICATING AN ERROR CONDITION
         WRITE(NO,1004)ISTATE
C...
C...     GO ON TO THE NEXT RUN
         GO TO 1
      END IF
C...
C...  CHECK FOR A RUN TERMINATION
      IF(NSTOP.NE.0)GO TO 1
C...
C...  THE INTEGRATION HAS PROCEEDED SATISFACTORILY, SO PREPARE FOR THE
C...  NEXT INTERVAL IN T.  NOTE THAT THE FOLLOWING CALCULATION OF THE
C...  OUTPUT TIME, TOUT, PRODUCES THREE OUTPUT POINTS FOR EACH DECADE
C...  IN T
      TOUT=TV*(1.0D+01)**(1.0D+00/3.0D+00)
C...
C...  CHECK FOR THE END OF THE RUN
      IF(TV.LT.(TF-0.5D+00*TP))GO TO 4
C...
C...  THE CURRENT RUN IS COMPLETE, SO PRINT THE COMPUTATIONAL STAT-
C...  ISTICS FOR LSODE AND GO ON TO THE NEXT RUN
      WRITE(NO,8)RWORK(11),IWORK(14),IWORK(11),IWORK(12),IWORK(13)
8     FORMAT(1H ,//,' COMPUTATIONAL STATISTICS'                    ,//,
     1 ' LAST STEP SIZE                       ',              D10.3,//,
     2 ' LAST ORDER OF THE METHOD             ',                I10,//,
     3 ' TOTAL NUMBER OF STEPS TAKEN          ',                I10,//,
     4 ' NUMBER OF FUNCTION EVALUATIONS       ',                I10,//,
     5 ' NUMBER OF JACOBIAN EVALUATIONS       ',                I10,/)
      GO TO 1
C...
C...  *****************************************************************
C...
C...  FORMATS
C...
1000  FORMAT(20A4)
1001  FORMAT(3D10.0)
1002  FORMAT(4I5,2X,A3,D10.0)
1003  FORMAT(1H1,
     1 ' RUN NO. - ',I3,2X,20A4,//,
     2 ' INITIAL T - ',D10.3,//,
     3 '   FINAL T - ',D10.3,//,
     4 '   PRINT T - ',D10.3,//,
     5 ' NUMBER OF DIFFERENTIAL EQUATIONS - ',I3,//,
     6 ' PRINT INTERVAL/MINIMUM INTEGRATION INTERVAL - ',I5,//,
     7 ' INTEGRATION ALGORITHM - ',I2,' - LSODE ',//,
     8 ' INTEGRATION ERROR MESSAGES - ',I1,//,
     9 ' ERROR CRITERION - ',A3,//,
     A ' MAXIMUM INTEGRATION ERROR - ',D10.3,//,
     B 1H1)
1004  FORMAT(1H ,//,' ISTATE = ',I3,//,
     1 ' INDICATING AN INTEGRATION ERROR, SO THE CURRENT RUN'     ,/,
     2 ' IS TERMINATED.  PLEASE REFER TO THE DOCUMENTATION FOR'   ,/,
     3 ' SUBROUTINE',//,25X,'LSODE',//,
     4 ' FOR AN EXPLANATION OF THESE ERROR INDICATORS'            )
      END
      SUBROUTINE FCN(NEQN,TV,YV,YDOT)
C...
C...  SUBROUTINE FCN IS AN INTERFACE ROUTINE BETWEEN SUBROUTINES LSODE
C...  AND DERV
C...
C...  DSS/2 COMMON AREA
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/      Y(1)
     2      /F/      F(1)
C...
C...  VARIABLE DIMENSION THE DEPENDENT AND DERIVATIVE ARRAYS
      DIMENSION YV(NEQN), YDOT(NEQN)
C...
C...  TRANSFER THE INDEPENDENT VARIABLE, DEPENDENT VARIABLE VECTOR
C...  FOR USE IN SUBROUTINE DERV
      T=TV
      DO 1 I=1,NEQN
      Y(I)=YV(I)
1     CONTINUE
C...
C...  EVALUATE THE DERIVATIVE VECTOR
      CALL DERV
C...
C...  TRANSFER THE DERIVATIVE VECTOR FOR USE BY SUBROUTINE LSODE
      DO 2 I=1,NEQN
      YDOT(I)=F(I)
2     CONTINUE
      RETURN
      END
      SUBROUTINE INITAL
C...
C...  LSODE SOLUTION OF TWO LINEAR ODES WITH A STIFFNESS RATIO OF 1E+06
C...  - PRINTING OF THE NUMERICAL AND EXACT SOLUTIONS
C...
C...  THE TWO SIMULTANEOUS, LINEAR, CONSTANT COEFFICIENT ORDINARY
C...  DIFFERENTIAL EQUATIONS
C...
C...     DY1/DT = A11*Y1 + A12*Y2                                    (1)
C...
C...     DY2/DT = A21*Y1 + A22*Y2                                    (2)
C...
C...  ARE INTEGRATED SUBJECT TO THE INITIAL CONDITIONS
C...
C...     Y1(0) = 0, Y2(0) = 2                                     (3)(4)
C...
C...  THE ANALYTICAL SOLUTION TO EQUATIONS (1) TO (4) CAN EASILY BE
C...  DERIVED.  FOR EXAMPLE, IF Y1(T) AND Y2(T) ARE ASSUMED TO BE
C...
C...     Y1 = C1*EXP(L*T), Y2 = C2*EXP(L*T)
C...
C...  SUBSTITUTION IN EQUATIONS (1) AND (2) GIVES
C...
C...     L*C1*EXP(L*T) = A11*C1*EXP(L*T) + A12*C2*EXP(L*T)           (5)
C...
C...     L*C2*EXP(L*T) = A21*C1*EXP(L*T) + A22*C2*EX(L*T)            (6)
C...
C...  THE EXPONENTIAL EXP(L*T) CANCELS FROM EQUATIONS (5) AND (6), AND
C...  THE FOLLOWING HOMOGENEOUS LINEAR ALGEBRAIC EQUATIONS FOR C1 AND C2
C...  RESULT
C...
C...     (A11 - L)*C1 +       A12*C2 = 0                             (7)
C...
C...           A21*C1 + (A22 - L)*C2 = 0                             (8)
C...
C...  EQUATIONS (7) AND (8) CONSTITUTE THE CLASSICAL, SECOND-ORDER,
C...  LINEAR ALGERAIC EIGENVALUE PROBLEM WHICH CAN BE SOLVED FOR THE
C...  VALUES OF L THAT DO NOT GIVE THE TRIVIAL SOLUTION C1 = 0, C2 = 0.
C...  THIS WILL BE DONE BY SETTING THE DETERMINANT OF THE COEFFICIENT
C...  MATRIX EQUAL TO ZERO (OTHER ALGORITHMS FOR CALCULATING THE EIGEN-
C...  VALUES, L1 AND L2, ARE AVAILABLE)
C...
C...     (A11 - L)*(A22 - L) - A12*A21 = 0                           (9)
C...
C...  OR
C...
C...     L**2 - (A11 + A22)*L + (A11*A22 - A12*A21) = 0             (10)
C...
C...  SOLUTION BY THE QUADRATIC EQUATION GIVES THE TWO EIGENVALUES, L1
C...  AND L2.  SINCE EQUATIONS (1) AND (2) ARE LINEAR, THE GENERAL
C...  SOLUTION CONSISTS OF A LINEAR COMBINATION OF THE TWO EXPONENTIALS
C...  EXP(L1*T) AND EXP(L2*T), I.E.,
C...
C...     Y1 = C11*EXP(L1*T) + C12*EXP(L2*T)                         (11)
C...
C...     Y2 = C21*EXP(L1*T) + C22*EXP(L2*T)                         (12)
C...
C...  WHERE C11, C12, C21 AND C22 ARE CONSTANTS TO BE DETERMINED (NOTE
C...  THAT (C11,C21) IS THE EIGENVECTOR FOR EIGENVALUE L1, AND (C12,C22)
C...  IS THE EIGENVECTOR FOR L2).  APPLYING INITIAL CONDITIONS (3) AND
C...  (4), PLUS EITHER EQUATION (7) OR (8) FOR L1 AND L2, GIVES THE
C...  RESULT
C...
C...     Y1 = -EXP(L1*T) + EXP(L2*T)                                (13)
C...
C...     Y2 =  EXP(L1*T) + EXP(L2*T)                                (14)
C...
C...  FOR THE SPECIAL CASE A11 = A22 = -A, A12 = A21 = B, L1 = -(A + B),
C...  L2 = -(A - B).  THE FOLLOWING PARTICULAR VALUES OF A AND B ILLUS-
C...  TRATE VARYING DEGREES OF STIFFNESS
C...
C...     CASE 1   A = 50.5        L1 = -100        L1/L2 = 100
C...              B = 49.5        L2 =   -1        (NONSTIFF)
C...
C...     CASE 2   A = 500.5       L1 = -1000       L1/L2 = 1000
C...              B = 499.5       L2 =    -1    (MODERATELY STIFF)
C...
C...     CASE 3   A = 500000.5    L1 = -1000000    L1/L2 = 1000000
C...              B = 499999.5    L2 =       -1     (VERY STIFF)
C...
C...  THE THIRD CASE PROVIDES A STRINGENT TEST OF A NUMERICAL INTEGRATOR
C...  FOR STIFF DIFFERENTIAL EQUATIONS.  FOR EXAMPLE, IF AN EXPLICIT
C...  INTEGRATOR IS USED IN CASE THREE, THE MAXIMUM STEP SIZE DETERMINED
C...  BY THE STABILITY OF THE CALCULATION WILL BE GIVEN APPROXIMATELY BY
C...
C...      ABS(HMAX*L1) LT 2
C...
C...  AND WITH L1 = -1000000, HMAX LT 2/1000000 = 0.000002.  SINCE THE
C...  TIME FOR THE PROBLEM IS DETERMINED BY L2, THROUGH THE EXPONENTIAL
C...  EXP(L2*T) IN EQUATIONS (13) AND (14), THE NUMERICAL SOLUTION
C...  MUST BE COMPUTED APPROXIMATELY OVER THE INTERVAL O LE T LE 10.
C...  THUS, TO COMPUTE THE SOLUTION TO T = 10, 10/0.000002 = 5,000,000
C...  STEPS IN T WILL BE REQUIRED BY THE EXPLICIT INTEGRATOR.  AN
C...  IMPLICIT INTEGRATOR, HOWEVER, WHICH IS NOT LIMITED BY STABILITY
C...  SHOULD PRODUCE A SOLUTION OVER THE INTERVAL 0 LE T LE 10 WITH AT
C...  MOST A FEW HUNDRED STEPS (THE NUMBER OF STEPS  WILL BE DETERMINED
C...  BY THE REQUIRED ACCURACY AND NOT BY THE STABILITY OF THE CALCU-
C...  LATION).  THIS VASTLY IMPROVED EFFICIENCY OF IMPLICIT INTEGRATORS
C...  FOR THIS STIFF PROBLEM IS DEMONSTRATED BY THE FOLLOWING CODING
C...
C...  BECAUSE OF THE STIFFNESS OF THIS PROBLEM, DOUBLE PRECISION CAL-
C...  CULATIONS ARE ADVISED
      DOUBLE PRECISION
     1              T,
     2             Y1,    Y2,
     3          DY1DT, DY2DT,
     4              A,     B
      COMMON/T/     T, NSTOP, NORUN
     1      /Y/    Y1,    Y2
     2      /F/ DY1DT, DY2DT
     3      /C/     A,     B
C...
C...  INITIAL CONDITIONS, EQUATIONS (3) AND (4)
      Y1=0.D+00
      Y2=2.D+00
C...
C...  THE FOLLOWING CONSTANTS IN THE ORDINARY DIFFERENTIAL EQUATIONS
C...  (ODES) CORRESPOND TO A STIFFNESS RATIO OF ONE MILLION (CASE 3
C...  ABOVE)
      A=500000.5D+00
      B=499999.5D+00
      RETURN
      END
      SUBROUTINE DERV
      DOUBLE PRECISION
     1              T,
     2             Y1,    Y2,
     3          DY1DT, DY2DT,
     4              A,     B
      COMMON/T/     T, NSTOP, NORUN
     1      /Y/    Y1,    Y2
     2      /F/ DY1DT, DY2DT
     3      /C/     A,     B
C...
C...  ODES, EQUATIONS (1) AND (2)
      DY1DT = -A*Y1 + B*Y2
      DY2DT =  B*Y1 - A*Y2
      RETURN
      END
      SUBROUTINE PRINT(NI,NO)
      DOUBLE PRECISION
     1              T,
     2             Y1,    Y2,
     3          DY1DT, DY2DT,
     4              A,     B,   AMB,  EXP1,  EXP2,   Y1E,   Y2E,
     5            Y1D,   Y2D
      COMMON/T/     T, NSTOP, NORUN
     1      /Y/    Y1,    Y2
     2      /F/ DY1DT, DY2DT
     3      /C/     A,     B
C...
C...  PRINT A HEADING FOR THE SOLUTION
      IF(T.EQ.0.D+00)WRITE(NO,2)
2     FORMAT(1H ,//,9X,1HT,
     1 13X,2HY1,12X,3HY1E,12X,3HY1D,/,
     2 23X,2HY2,12X,3HY2E,12X,3HY2D)
C...
C...  EVALUATE THE EXACT (ANALYTICAL) SOLUTION, EQUATIONS (11) AND (12)
C...  WITH L1 = -(A + B), L2 = -(A - B), FOR COMPARISON WITH THE NUMERI-
C...  CAL SOLUTION
      AMB=A-B
      IF(AMB.EQ.0.D+00)AMB=1.D+00
      EXP1=DEXP(-AMB*T)
      EXP2=0.D+00
      IF(((A+B)*T).LT.50.D+00)EXP2=DEXP(-(A+B)*T)
      Y1E=EXP1-EXP2
      Y2E=EXP1+EXP2
C...
C...  COMPUTE THE DIFFERENCES BETWEEN THE NUMERICAL AND EXACT SOLUTIONS
      Y1D=Y1-Y1E
      Y2D=Y2-Y2E
C...
C...  PRINT THE INDEPENDENT VARIABLE, NUMERICAL AND EXACT SOLUTIONS, AND
C...  THE DIFFERENCES BETWEEN THE TWO SOLUTIONS
      WRITE(NO,1)T,Y1,Y1E,Y1D,Y2,Y2E,Y2D
1     FORMAT(1H ,/,D10.3,3D15.4,/,10X,3D15.4)
      RETURN
      END
LAPIDUS, ET AL, NUM METH DIFF SYS, P107
    0.D+00    1.D+01    1.D-09
    2 1000    2    1  REL 0.00001
END OF RUNS
*APP MATH44
      PROGRAM LSODET
C...
C...  AN INTERFACE BETWEEN DSS/2 APPLICATIONS AND INTEGRATOR LSODE
C...
C...  THE FOLLOWING PROGRAM CALLS A DSS/2 APPLICATION, DEFINED AS THE
C...  USER-SUPPLIED SUBROUTINES INITAL, DERV AND PRINT, PLUS DATA.
C...  THE SYSTEM OF ODES PROGRAMMED IN SUBROUTINE DERV IS INTEGRATED
C...  BY LSODE (THE BASIC SOLVER IN ODEPACK, A LIBRARY OF INTEGRATORS
C...  DEVELOPED BY ALAN C. HINDMARSH, LAWRENCE LIVERMORE NATIONAL LAB-
C...  ORATORY).
C...
C...  THE MODEL INITIAL CONDITIONS ARE SET IN SUBROUTINE INITAL, AND
C...  THE MODEL DERIVATIVES ARE PROGRAMMED IN SUBROUTINE DERV.  THE
C...  NUMERICAL SOLUTION IS PRINTED AND PLOTTED IN SUBROUTINE PRINT.
C...
C...  TYPE ALL REAL VARIABLES AS DOUBLE PRECISION
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C...
C...  SUBROUTINES INITAL, DERV AND PRINT.  THE FOLLOWING CODING IS FOR
C...  250 ORDINARY DIFFERENTIAL EQUATIONS (ODES).  IF MORE ODES ARE TO
C...  BE INTEGRATED, ALL OF THE 250*S SHOULD BE CHANGED TO THE REQUIRED
C...  NUMBER
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/    Y(250)
     2      /F/    F(250)
C...
C...  COMMON AREA TO PROVIDE THE INPUT/OUTPUT UNIT NUMBERS TO OTHER
C...  SUBROUTINES
      COMMON/IO/       NI,        NO
C...
C...  ABSOLUTE DIMENSIONING OF THE ARRAYS REQUIRED BY LSODE.  ARRAY
C...  WORK IS SIZED BY THE FOLLOWING FORMULA FOR BANDED PROCESSING
C...  OF THE ODE JACOBIAN MATRIX VIA FINITE DIFFERENCES: 22+17*NEQN+
C...  (2*ML+MU)*NEQN.  FOR NEQN = 250, ML = MU = 3, 22+17*250+(2*3+3)*
C...  250 = 6600 (APPROXIMATELY).  IF FEWER THAN 250 ODES ARE TO BE
C...  INTEGRATED, THEN ML AND MU CAN BE LARGER FOR THE GIVEN SIZE OF
C...  WORK.  IF NEQN GT 250 AND/OR ML AND MU GT 3, WORK MUST BE DIMEN-
C...  SIONED TO A LARGER SIZE
      DIMENSION YV(250), RWORK(6600), IWORK(275)
C...
C...  EXTERNAL THE DERIVATIVE AND ODE JACOBIAN MATRIX ROUTINES CALLED BY
C...  LSODE
      EXTERNAL FCN, JAC
C...
C...  ARRAY FOR THE TITLE (FIRST LINE OF DATA), CHARACTERS  END OF RUNS
      CHARACTER TITLE(20)*4, ENDRUN(3)*4
C...
C...  VARIABLE FOR THE TYPE OF ERROR CRITERION
      CHARACTER*3 ABSREL
C...
C...  DEFINE THE CHARACTERS  END OF RUNS
      DATA ENDRUN/'END ','OF RU','NS  '/
C...
C...  DEFINE THE INPUT/OUTPUT UNIT NUMBERS
      NI=5
      NO=6
C...
C...  OPEN THE INPUT/OUTPUT UNIT NUMBERS
      OPEN(NI,FILE='INPUT')
      OPEN(NO,FILE='OUTPUT')
C...
C...  INITIALIZE THE RUN COUNTER
      NORUN=0
C...
C...  BEGIN A RUN
1     NORUN=NORUN+1
C...
C...  INITIALIZE THE RUN TERMINATION VARIABLE
      NSTOP=0
C...
C...  READ THE FIRST LINE OF DATA
      READ(NI,1000,END=999)(TITLE(I),I=1,20)
C...
C...  TEST FOR  END OF RUNS  IN THE DATA
      DO 2 I=1,3
      IF(TITLE(I).NE.ENDRUN(I))GO TO 3
2     CONTINUE
C...
C...  AN END OF RUNS HAS BEEN READ, SO TERMINATE EXECUTION
999   STOP
C...
C...  READ THE SECOND LINE OF DATA
3     READ(NI,1001,END=999)T0,TF,TP
C...
C...  READ THE THIRD LINE OF DATA
      READ(NI,1002,END=999)NEQN,NMAX,INT,IERROR,ABSREL,ERROR
C...
C...  PRINT A DATA SUMMARY
      WRITE(NO,1003)NORUN,(TITLE(I),I=1,20),
     1                     T0,TF,TP,
     2                     NEQN,NMAX,INT,IERROR,ABSREL,ERROR
C...
C...  INITIALIZE TIME
      T=T0
C...
C...  SET THE INITIAL CONDITIONS
      CALL INITAL
C...
C...  PRINT THE INITIAL CONDITIONS
      CALL PRINT(NI,NO)
C...
C...  SET THE INITIAL CONDITIONS FOR SUBROUTINE LSODE
      DO 5 I=1,NEQN
      YV(I)=Y(I)
5     CONTINUE
C...
C...  SET THE PARAMETERS FOR SUBROUTINE LSODE
      TV=T0
      ITOL=1
      RTOL=ERROR
      ATOL=1.0D-10
      LRW=6600
      LIW=275
      IOPT=0
      ITASK=1
      ISTATE=1
C...
C...  SEVERAL LSODE OPTIONS, AS SELECTED BY THE RUN NUMBER NORUN, ARE
C...  PROGRAMMED HERE. THE TERMINOLOGY IS
C...
C...     IMPLICIT ADAMS METHOD FOR NONSTIFF PROBLEMS
C...
C...     METHOD BASED ON BACKWARD DIFFERENTIATION FORMULAS (BDF) FOR
C...     STIFF PROBLEMS
C...
C...  EACH OF THESE METHODS (NONSTIFF AND STIFF) GENERATES NONLINEAR
C...  ALGEBRAIC EQUATIONS DURING THE NUMERICAL INTEGRATION WHICH ARE
C...  SOLVED BY ONE OF THE FOLLOWING METHODS
C...
C...     FUNCTIONAL ITERATION (A PICARD ITERATION)
C...
C...     CHORD ITERATION, ESSENTIALLY NEWTON*S METHOD, WITH THE ODE
C...     JACOBIAN MATRIX PARTIAL DERIVATIVES APPROXIMATED BY FINITE
C...     DIFFERENCES.  A FULL, BANDED OR DIAGONAL MATRIX MAY BE USED.
C...     THE BANDED AND DIAGONAL FORMS TYPICALLY ARE APPROXIMATIONS TO
C...     THE FULL MATRIX, I.E., CONTAIN A SUBSET OF THE ELEMENTS OF THE
C...     FULL MATRIX.
C...
C...  SINCE A STIFF ODE PROBLEM IS BEING INTEGRATED, THE STIFF OPTION
C...  WITH INTERNALLY GENERATED JACOBIAN MATRIX IS SELECTED
      NORUN=6
C...
C...     (1)  NORUN = 1
C...
C...          IMPLICIT ADAMS METHOD, FUNCTIONAL ITERATION
              IF(NORUN.EQ.1)THEN
              METH=1
              MITER=0
C...
C...     (2)  NORUN = 2
C...
C...          IMPLICIT ADAMS METHOD, CHORD ITERATION WITH AN INTERNALLY
C...          GENERATED (DIFFERENCE QUOTIENT) FULL JACOBIAN
              ELSE IF(NORUN.EQ.2)THEN
              METH=1
              MITER=2
C...
C...     (3)  NORUN = 3
C...
C...          IMPLICIT ADAMS METHOD, CHORD ITERATION WITH AN INTERNALLY
C...          GENERATED (DIFFERENCE QUOTIENT) DIAGONAL JACOBIAN APPROXI-
C...          TION
              ELSE IF(NORUN.EQ.3)THEN
              METH=1
              MITER=3
C...
C...     (4)  NORUN = 4
C...
C...          IMPLICIT ADAMS METHOD, CHORD ITERATION WITH AN INTERNALLY
C...          GENERATED (DIFFERENCE QUOTIENT) BANDED JACOBIAN
              ELSE IF(NORUN.EQ.4)THEN
              METH=1
              MITER=5
              IWORK(1)=1
              IWORK(2)=1
C...
C...     (5)  NORUN = 5
C...
C...          IMPLICIT BDF METHOD, FUNCTIONAL ITERATION
              ELSE IF(NORUN.EQ.5)THEN
              METH=2
              MITER=0
C...
C...     (6)  NORUN = 6
C...
C...          IMPLICIT BDF METHOD, CHORD ITERATION WITH AN INTERNALLY
C...          GENERATED (DIFFERENCE QUOTIENT) FULL JACOBIAN
              ELSE IF(NORUN.EQ.6)THEN
              METH=2
              MITER=2
C...
C...     (7)  NORUN = 7
C...
C...          IMPLICIT BDF METHOD, CHORD ITERATION WITH AN INTERNALLY
C...          GENERATED (DIFFERENCE QUOTIENT) DIAGONAL JACOBIAN APPROXI-
C...          TION
              ELSE IF(NORUN.EQ.7)THEN
              METH=2
              MITER=3
C...
C...     (8)  NORUN = 8
C...
C...          IMPLICIT BDF METHOD, CHORD ITERATION WITH AN INTERNALLY
C...          GENERATED (DIFFERENCE QUOTIENT) BANDED JACOBIAN
              ELSE IF(NORUN.EQ.8)THEN
              METH=2
              MITER=5
              IWORK(1)=1
              IWORK(2)=1
      END IF
C...
C...  THE METHOD FLAG, MF, IS COMPUTED FROM METH AND MITER
      MF=10*METH+MITER
C...
C...  INITIATE THE INTEGRATION
      TOUT=TV+TP
C...
C...  CALL SUBROUTINE LSODE TO COVER ONE PRINT INTERVAL
4     CALL LSODE(FCN,NEQN,YV,TV,TOUT,ITOL,RTOL,ATOL,ITASK,ISTATE,
     1           IOPT,RWORK,LRW,IWORK,LIW,JAC,MF)
C...
C...  PRINT THE SOLUTION
      T=TV
      DO 6 I=1,NEQN
      Y(I)=YV(I)
6     CONTINUE
      CALL PRINT(NI,NO)
C...
C...  TEST FOR AN ERROR CONDITION
      IF(ISTATE.LT.0)THEN
C...
C...     PRINT A MESSAGE INDICATING AN ERROR CONDITION
         WRITE(NO,1004)ISTATE
C...
C...     GO ON TO THE NEXT RUN
         GO TO 1
      END IF
C...
C...  CHECK FOR A RUN TERMINATION
      IF(NSTOP.NE.0)GO TO 1
C...
C...  THE INTEGRATION HAS PROCEEDED SATISFACTORILY, SO PREPARE FOR THE
C...  NEXT INTERVAL IN T.  NOTE THAT THE FOLLOWING CALCULATION OF THE
C...  OUTPUT TIME, TOUT, PRODUCES THREE OUTPUT POINTS FOR EACH DECADE
C...  IN T
      TOUT=TV*(1.0D+01)**(1.0D+00/3.0D+00)
C...
C...  CHECK FOR THE END OF THE RUN
      IF(TV.LT.(TF-0.5D+00*TP))GO TO 4
C...
C...  THE CURRENT RUN IS COMPLETE, SO PRINT THE COMPUTATIONAL STAT-
C...  ISTICS FOR LSODE AND GO ON TO THE NEXT RUN
      WRITE(NO,8)RWORK(11),IWORK(14),IWORK(11),IWORK(12),IWORK(13)
8     FORMAT(1H ,//,' COMPUTATIONAL STATISTICS'                    ,//,
     1 ' LAST STEP SIZE                       ',              D10.3,//,
     2 ' LAST ORDER OF THE METHOD             ',                I10,//,
     3 ' TOTAL NUMBER OF STEPS TAKEN          ',                I10,//,
     4 ' NUMBER OF FUNCTION EVALUATIONS       ',                I10,//,
     5 ' NUMBER OF JACOBIAN EVALUATIONS       ',                I10,/)
      GO TO 1
C...
C...  *****************************************************************
C...
C...  FORMATS
C...
1000  FORMAT(20A4)
1001  FORMAT(3D10.0)
1002  FORMAT(4I5,2X,A3,D10.0)
1003  FORMAT(1H1,
     1 ' RUN NO. - ',I3,2X,20A4,//,
     2 ' INITIAL T - ',D10.3,//,
     3 '   FINAL T - ',D10.3,//,
     4 '   PRINT T - ',D10.3,//,
     5 ' NUMBER OF DIFFERENTIAL EQUATIONS - ',I3,//,
     6 ' PRINT INTERVAL/MINIMUM INTEGRATION INTERVAL - ',I5,//,
     7 ' INTEGRATION ALGORITHM - ',I2,' - LSODE ',//,
     8 ' INTEGRATION ERROR MESSAGES - ',I1,//,
     9 ' ERROR CRITERION - ',A3,//,
     A ' MAXIMUM INTEGRATION ERROR - ',D10.3,//,
     B 1H1)
1004  FORMAT(1H ,//,' ISTATE = ',I3,//,
     1 ' INDICATING AN INTEGRATION ERROR, SO THE CURRENT RUN'     ,/,
     2 ' IS TERMINATED.  PLEASE REFER TO THE DOCUMENTATION FOR'   ,/,
     3 ' SUBROUTINE',//,25X,'LSODE',//,
     4 ' FOR AN EXPLANATION OF THESE ERROR INDICATORS'            )
      END
      SUBROUTINE FCN(NEQN,TV,YV,YDOT)
C...
C...  SUBROUTINE FCN IS AN INTERFACE ROUTINE BETWEEN SUBROUTINES LSODE
C...  AND DERV
C...
C...  DSS/2 COMMON AREA
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/      Y(1)
     2      /F/      F(1)
C...
C...  VARIABLE DIMENSION THE DEPENDENT AND DERIVATIVE ARRAYS
      DIMENSION YV(NEQN), YDOT(NEQN)
C...
C...  TRANSFER THE INDEPENDENT VARIABLE, DEPENDENT VARIABLE VECTOR
C...  FOR USE IN SUBROUTINE DERV
      T=TV
      DO 1 I=1,NEQN
      Y(I)=YV(I)
1     CONTINUE
C...
C...  EVALUATE THE DERIVATIVE VECTOR
      CALL DERV
C...
C...  TRANSFER THE DERIVATIVE VECTOR FOR USE BY SUBROUTINE LSODE
      DO 2 I=1,NEQN
      YDOT(I)=F(I)
2     CONTINUE
      RETURN
      END
      SUBROUTINE INITAL
C...
C...  LSODE SOLUTION OF TWO LINEAR ODES WITH A STIFFNESS RATIO OF 1E+06
C...  - PLOTTING OF THE COMPUTATIONAL STATISTICS
C...
C...  THE TWO SIMULTANEOUS, LINEAR, CONSTANT COEFFICIENT ORDINARY
C...  DIFFERENTIAL EQUATIONS
C...
C...     DY1/DT = A11*Y1 + A12*Y2                                    (1)
C...
C...     DY2/DT = A21*Y1 + A22*Y2                                    (2)
C...
C...  ARE INTEGRATED SUBJECT TO THE INITIAL CONDITIONS
C...
C...     Y1(0) = 0, Y2(0) = 2                                     (3)(4)
C...
C...  THE ANALYTICAL SOLUTION TO EQUATIONS (1) TO (4) CAN EASILY BE
C...  DERIVED.  FOR EXAMPLE, IF Y1(T) AND Y2(T) ARE ASSUMED TO BE
C...
C...     Y1 = C1*EXP(L*T), Y2 = C2*EXP(L*T)
C...
C...  SUBSTITUTION IN EQUATIONS (1) AND (2) GIVES
C...
C...     L*C1*EXP(L*T) = A11*C1*EXP(L*T) + A12*C2*EXP(L*T)           (5)
C...
C...     L*C2*EXP(L*T) = A21*C1*EXP(L*T) + A22*C2*EX(L*T)            (6)
C...
C...  THE EXPONENTIAL EXP(L*T) CANCELS FROM EQUATIONS (5) AND (6), AND
C...  THE FOLLOWING HOMOGENEOUS LINEAR ALGEBRAIC EQUATIONS FOR C1 AND C2
C...  RESULT
C...
C...     (A11 - L)*C1 +       A12*C2 = 0                             (7)
C...
C...           A21*C1 + (A22 - L)*C2 = 0                             (8)
C...
C...  EQUATIONS (7) AND (8) CONSTITUTE THE CLASSICAL, SECOND-ORDER,
C...  LINEAR ALGERAIC EIGENVALUE PROBLEM WHICH CAN BE SOLVED FOR THE
C...  VALUES OF L THAT DO NOT GIVE THE TRIVIAL SOLUTION C1 = 0, C2 = 0.
C...  THIS WILL BE DONE BY SETTING THE DETERMINANT OF THE COEFFICIENT
C...  MATRIX EQUAL TO ZERO (OTHER ALGORITHMS FOR CALCULATING THE EIGEN-
C...  VALUES, L1 AND L2, ARE AVAILABLE)
C...
C...     (A11 - L)*(A22 - L) - A12*A21 = 0                           (9)
C...
C...  OR
C...
C...     L**2 - (A11 + A22)*L + (A11*A22 - A12*A21) = 0             (10)
C...
C...  SOLUTION BY THE QUADRATIC EQUATION GIVES THE TWO EIGENVALUES, L1
C...  AND L2.  SINCE EQUATIONS (1) AND (2) ARE LINEAR, THE GENERAL
C...  SOLUTION CONSISTS OF A LINEAR COMBINATION OF THE TWO EXPONENTIALS
C...  EXP(L1*T) AND EXP(L2*T), I.E.,
C...
C...     Y1 = C11*EXP(L1*T) + C12*EXP(L2*T)                         (11)
C...
C...     Y2 = C21*EXP(L1*T) + C22*EXP(L2*T)                         (12)
C...
C...  WHERE C11, C12, C21 AND C22 ARE CONSTANTS TO BE DETERMINED (NOTE
C...  THAT (C11,C21) IS THE EIGENVECTOR FOR EIGENVALUE L1, AND (C12,C22)
C...  IS THE EIGENVECTOR FOR L2).  APPLYING INITIAL CONDITIONS (3) AND
C...  (4), PLUS EITHER EQUATION (7) OR (8) FOR L1 AND L2, GIVES THE
C...  RESULT
C...
C...     Y1 = -EXP(L1*T) + EXP(L2*T)                                (13)
C...
C...     Y2 =  EXP(L1*T) + EXP(L2*T)                                (14)
C...
C...  FOR THE SPECIAL CASE A11 = A22 = -A, A12 = A21 = B, L1 = -(A + B),
C...  L2 = -(A - B).  THE FOLLOWING PARTICULAR VALUES OF A AND B ILLUS-
C...  TRATE VARYING DEGREES OF STIFFNESS
C...
C...     CASE 1   A = 50.5        L1 = -100        L1/L2 = 100
C...              B = 49.5        L2 =   -1        (NONSTIFF)
C...
C...     CASE 2   A = 500.5       L1 = -1000       L1/L2 = 1000
C...              B = 499.5       L2 =    -1    (MODERATELY STIFF)
C...
C...     CASE 3   A = 500000.5    L1 = -1000000    L1/L2 = 1000000
C...              B = 499999.5    L2 =       -1     (VERY STIFF)
C...
C...  THE THIRD CASE PROVIDES A STRINGENT TEST OF A NUMERICAL INTEGRATOR
C...  FOR STIFF DIFFERENTIAL EQUATIONS.  FOR EXAMPLE, IF AN EXPLICIT
C...  INTEGRATOR IS USED IN CASE THREE, THE MAXIMUM STEP SIZE DETERMINED
C...  BY THE STABILITY OF THE CALCULATION WILL BE GIVEN APPROXIMATELY BY
C...
C...      ABS(HMAX*L1) LT 2
C...
C...  AND WITH L1 = -1000000, HMAX LT 2/1000000 = 0.000002.  SINCE THE
C...  TIME FOR THE PROBLEM IS DETERMINED BY L2, THROUGH THE EXPONENTIAL
C...  EXP(L2*T) IN EQUATIONS (13) AND (14), THE NUMERICAL SOLUTION
C...  MUST BE COMPUTED APPROXIMATELY OVER THE INTERVAL O LE T LE 10.
C...  THUS, TO COMPUTE THE SOLUTION TO T = 10, 10/0.000002 = 5,000,000
C...  STEPS IN T WILL BE REQUIRED BY THE EXPLICIT INTEGRATOR.  AN
C...  IMPLICIT INTEGRATOR, HOWEVER, WHICH IS NOT LIMITED BY STABILITY
C...  SHOULD PRODUCE A SOLUTION OVER THE INTERVAL 0 LE T LE 10 WITH AT
C...  MOST A FEW HUNDRED STEPS (THE NUMBER OF STEPS  WILL BE DETERMINED
C...  BY THE REQUIRED ACCURACY AND NOT BY THE STABILITY OF THE CALCU-
C...  LATION).  THIS VASTLY IMPROVED EFFICIENCY OF IMPLICIT INTEGRATORS
C...  FOR THIS STIFF PROBLEM IS DEMONSTRATED BY THE FOLLOWING CODING
C...
C...  BECAUSE OF THE STIFFNESS OF THIS PROBLEM, DOUBLE PRECISION CAL-
C...  CULATIONS ARE ADVISED
      DOUBLE PRECISION
     1              T,
     2             Y1,    Y2,
     3          DY1DT, DY2DT,
     4              A,     B
      COMMON/T/     T, NSTOP, NORUN
     1      /Y/    Y1,    Y2
     2      /F/ DY1DT, DY2DT
     3      /C/     A,     B
C...
C...  INITIAL CONDITIONS, EQUATIONS (3) AND (4)
      Y1=0.D+00
      Y2=2.D+00
C...
C...  THE FOLLOWING CONSTANTS IN THE ORDINARY DIFFERENTIAL EQUATIONS
C...  (ODES) CORRESPOND TO A STIFFNESS RATIO OF ONE MILLION (CASE 3
C...  ABOVE)
      A=500000.5D+00
      B=499999.5D+00
      RETURN
      END
      SUBROUTINE DERV
      DOUBLE PRECISION
     1              T,
     2             Y1,    Y2,
     3          DY1DT, DY2DT,
     4              A,     B
      COMMON/T/     T, NSTOP, NORUN
     1      /Y/    Y1,    Y2
     2      /F/ DY1DT, DY2DT
     3      /C/     A,     B
C...
C...  ODES, EQUATIONS (1) AND (2)
      DY1DT = -A*Y1 + B*Y2
      DY2DT =  B*Y1 - A*Y2
      RETURN
      END
      SUBROUTINE PRINT(NI,NO)
      DOUBLE PRECISION
     1              T,
     2             Y1,    Y2,
     3          DY1DT, DY2DT,
     4              A,     B,   AMB,  EXP1,  EXP2,   Y1E,   Y2E,
     5            Y1D,   Y2D,    HU, STEP1, STEP2
      COMMON/T/     T, NSTOP, NORUN
     1      /Y/    Y1,    Y2
     2      /F/ DY1DT, DY2DT
     3      /C/     A,     B
C...
C...  LSODE COMMON/LS0001/ IS INCLUDED AT THIS POINT TO ACCESS THE
C...  INTEGRATOR STEP SIZE IN T LAST USED SUCCESSFULLY, HU, CUMULATIVE
C...  NUMBER OF STEPS TAKEN, NST, CUMULATIVE NUMBER OF FUNCTION EVALU-
C...  TIONS, NFE, CUMULATIVE NUMBER OF JACOBIAN MATRIX EVALUATIONS AND
C...  LU DECOMPOSITIONS, NJE, METHOD ORDER LAST USED SUCCESSFULY, NQU
      COMMON/LS0001/STEP1(215),HU,STEP2(3),ISTEP(35),NST,NFE,NJE,NQU
C...
C...  DIMENSION THE ARRAYS FOR PLOTTING
      DIMENSION    TP(31),
     1             P1(31),    P2(31),    P3(31),    P4(31),    P5(31),
     2             P6(31),    P7(31),    P8(31)
C...
C...  INITIALIZE A COUNTER FOR THE PLOTTED STATISTICS
      DATA IP/0/
C...
C...  PRINT A HEADING FOR THE COMPUTATIONAL STATISTICS
      IF(T.EQ.0.D+00)WRITE(NO,2)
2     FORMAT(1H ,//,9X,1HT,
     1 10X,2HHU,9X,3HNST,9X,3HNFE,8X,3HNJE,6X,3HNQU)
C...
C...  EVALUATE THE EXACT (ANALYTICAL) SOLUTION, EQUATIONS (11) AND (12)
C...  WITH L1 = -(A + B), L2 = -(A - B), FOR COMPARISON WITH THE NUMERI-
C...  CAL SOLUTION
      AMB=A-B
      IF(AMB.EQ.0.D+00)AMB=1.D+00
      EXP1=DEXP(-AMB*T)
      EXP2=0.D+00
      IF(((A+B)*T).LT.50.D+00)EXP2=DEXP(-(A+B)*T)
      Y1E=EXP1-EXP2
      Y2E=EXP1+EXP2
C...
C...  COMPUTE THE DIFFERENCES BETWEEN THE NUMERICAL AND EXACT SOLUTIONS
      Y1D=Y1-Y1E
      Y2D=Y2-Y2E
C...
C...  INITIALIZE THREE VARIABLES FOR COMPUTING THE NET NUMBER OF STEPS,
C...  FUNCTION EVALUATIONS AND JACOBIAN MATRIX EVALUATIONS
      IF(T.GT.0.D+00)GO TO 3
      NET1=0
      NET2=0
      NET3=0
      RETURN
C...
C...  PRINT THE COMPUTATIONAL STATISTICS
3     NET1=NST-NET1
      NET2=NFE-NET2
      NET3=NJE-NET3
      WRITE(NO,1)T,HU,NST,NET1,NFE,NET2,NJE,NET3,NQU
1     FORMAT(D10.3,D12.4,
     1       I6,2H (,I3,1H),I6,2H (,I3,1H),I5,3H  (,I2,1H),I9)
C...
C...  STORE THE COMPUTATIONAL STATISTICS FOR SUBSEQUENT PLOTTING
      IP=IP+1
      TP(IP)=ALOG10(SNGL(T))
      P1(IP)=SNGL(HU)
      P2(IP)=FLOAT(NST)
      P3(IP)=FLOAT(NET1)
      P4(IP)=FLOAT(NFE)
      P5(IP)=FLOAT(NET2)
      P6(IP)=FLOAT(NJE)
      P7(IP)=FLOAT(NET3)
      P8(IP)=FLOAT(NQU)
      NET1=NST
      NET2=NFE
      NET3=NJE
C...
C...  PLOT THE COMPUTATIONAL STATISTICS
      IF(IP.LT.31)RETURN
C...  ******************************************************************
C...
C...  THE FOLLOWING CALLS TO A CONTINUOUS PLOTTER ARE MACHINE-DEPENDENT
C...  AND WILL HAVE TO BE CHANGED FOR THE USER*S LOCAL COMPUTER
C...  CALL QIKSAX(3,3)
C...  CALL QIKSET(5.,-9.,2.,5.,0.,-0.0)
C...  CALL QIKPLT(TP,P1,IP,8H*LOG(T)*,12H*INTEG STEP*,2H**,1)
C...  CALL QIKSAX(3,3)
C...  CALL QIKSET(5.,-9.,2.,5.,0.,-0.0)
C...  CALL QIKPLT(TP,P2,IP,8H*LOG(T)*,14H*CUM NO STEPS*,2H**,1)
C...  CALL QIKSAX(3,3)
C...  CALL QIKSET(5.,-9.,2.,5.,0.,-0.0)
C...  CALL QIKPLT(TP,P3,IP,8H*LOG(T)*,14H*INC NO STEPS*,2H**,1)
C...  CALL QIKSAX(3,3)
C...  CALL QIKSET(5.,-9.,2.,5.,0.,-0.0)
C...  CALL QIKPLT(TP,P4,IP,8H*LOG(T)*,14H*CUM NO DERVS*,2H**,1)
C...  CALL QIKSAX(3,3)
C...  CALL QIKSET(5.,-9.,2.,5.,0.,-0.0)
C...  CALL QIKPLT(TP,P5,IP,8H*LOG(T)*,14H*INC NO DERVS*,2H**,1)
C...  CALL QIKSAX(3,3)
C...  CALL QIKSET(5.,-9.,2.,5.,0.,-0.0)
C...  CALL QIKPLT(TP,P6,IP,8H*LOG(T)*,16H*CUM NO J EVALS*,2H**,1)
C...  CALL QIKSAX(3,3)
C...  CALL QIKSET(5.,-9.,2.,5.,0.,-0.0)
C...  CALL QIKPLT(TP,P7,IP,8H*LOG(T)*,16H*INC NO J EVALS*,2H**,1)
C...  CALL QIKSAX(3,3)
C...  CALL QIKSET(5.,-9.,2.,5.,0.,-0.0)
C...  CALL QIKPLT(TP,P8,IP,8H*LOG(T)*,15H*CURRENT ORDER*,2H**,1)
C...
C...  ******************************************************************
      RETURN
      END
LAPIDUS, ET AL, NUM METH DIFF SYS, P107
    0.D+00    1.D+01    1.D-09
    2 1000    2    1  REL 0.00001
END OF RUNS
*APP MATH45
      PROGRAM DASSLT
C...
C...  AN INTERFACE BETWEEN DSS/2 APPLICATIONS AND INTEGRATOR DASSL
C...
C...  THE FOLLOWING PROGRAM CALLS A DSS/2 APPLICATION, DEFINED AS THE
C...  USER-SUPPLIED SUBROUTINES INITAL, DERV AND PRINT, PLUS DATA.
C...  THE SYSTEM OF ODES PROGRAMMED IN SUBROUTINE DERV IS INTEGRATED
C...  BY DASSL (A SOLVER FOR ALGEBRAIC/ODE SYSTEMS DEVELOPED BY LINDA
C...  R. PETZOLD, LAWRENCE LIVERMORE NATIONAL LABORATORY).
C...
C...  THE MODEL INITIAL CONDITIONS ARE SET IN SUBROUTINE INITAL, AND
C...  THE MODEL DERIVATIVES ARE PROGRAMMED IN SUBROUTINE DERV.  THE
C...  NUMERICAL SOLUTION IS PRINTED AND PLOTTED IN SUBROUTINE PRINT.
C...
C...  TYPE ALL REAL VARIABLES AS DOUBLE PRECISION
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C...
C...  SUBROUTINES INITAL, DERV AND PRINT.  THE FOLLOWING CODING IS FOR
C...  250 ORDINARY DIFFERENTIAL EQUATIONS (ODES).  IF MORE ODES ARE TO
C...  BE INTEGRATED, ALL OF THE 250*S SHOULD BE CHANGED TO THE REQUIRED
C...  NUMBER
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/    Y(250)
     2      /F/    F(250)
C...
C...  THE NUMBER OF DIFFERENTIAL EQUATIONS IS AVAILABLE THROUGH COMMON
C...  /N/ FOR USE IN SUBROUTINE RES
      COMMON/N/      NEQN
C...
C...  COMMON AREA TO PROVIDE THE INPUT/OUTPUT UNIT NUMBERS TO OTHER
C...  SUBROUTINES
      COMMON/IO/       NI,        NO
C...
C...  ABSOLUTE DIMENSIONING OF THE ARRAYS REQUIRED BY DASSL.  ARRAY
C...  WORK IS SIZED BY THE FOLLOWING FORMULA FOR BANDED PROCESSING
C...  OF THE ODE JACOBIAN MATRIX VIA FINITE DIFFERENCES: 40+(MAXORD
C...  +4)*NEQN+(2*ML+MU+1)*NEQN+2*(NEQN/(ML+MU+1)+1).  FOR MAXORD = 5,
C...  NEQN = 250, ML = MU = 3, 40+(5+4)*250+(2*3+3+1)*250+2*(250/(3+3
C...  +1)+1) = 5000 (APPROXIMATELY).  IF FEWER THAN 250 EQUATIONS ARE
C...  TO BE SOLVED, THEN ML AND MU CAN BE LARGER FOR THE GIVEN SIZE OF
C...  WORK.  IF NEQN GT 250 AND/OR ML AND MU GT 3, WORK MUST BE DIMEN-
C...  SIONED TO A LARGER SIZE
      DIMENSION YV(250), YPRIME(250), DELTA(250),
     1      RWORK(5000),  IWORK(270),   INFO(15)
C...
C...  EXTERNAL THE DERIVATIVE AND ODE JACOBIAN MATRIX ROUTINES CALLED BY
C...  DASSL
      EXTERNAL RES, JAC
C...
C...  ARRAY FOR THE TITLE (FIRST LINE OF DATA), CHARACTERS  END OF RUNS
      CHARACTER TITLE(20)*4, ENDRUN(3)*4
C...
C...  VARIABLE FOR THE TYPE OF ERROR CRITERION
      CHARACTER*3 ABSREL
C...
C...  DEFINE THE CHARACTERS  END OF RUNS
      DATA ENDRUN/'END ','OF RU','NS  '/
C...
C...  DEFINE THE INPUT/OUTPUT UNIT NUMBERS
      NI=5
      NO=6
C...
C...  OPEN INPUT AND OUTPUT FILES
      OPEN(NI,FILE='INPUT')
      OPEN(NO,FILE='OUTPUT')
C...
C...  INITIALIZE THE RUN COUNTER
      NORUN=0
C...
C...  BEGIN A RUN
1     NORUN=NORUN+1
C...
C...  INITIALIZE THE RUN TERMINATION VARIABLE
      NSTOP=0
C...
C...  READ THE FIRST LINE OF DATA
      READ(NI,1000,END=999)(TITLE(I),I=1,20)
C...
C...  TEST FOR  END OF RUNS  IN THE DATA
      DO 2 I=1,3
      IF(TITLE(I).NE.ENDRUN(I))GO TO 3
2     CONTINUE
C...
C...  AN END OF RUNS HAS BEEN READ, SO TERMINATE EXECUTION
999   STOP
C...
C...  READ THE SECOND LINE OF DATA
3     READ(NI,1001,END=999)T0,TF,TP
C...
C...  READ THE THIRD LINE OF DATA
      READ(NI,1002,END=999)NEQN,NMAX,INT,IERROR,ABSREL,ERROR
C...
C...  PRINT A DATA SUMMARY
      WRITE(NO,1003)NORUN,(TITLE(I),I=1,20),
     1                     T0,TF,TP,
     2                     NEQN,NMAX,INT,IERROR,ABSREL,ERROR
C...
C...  INITIALIZE TIME
      T=T0
C...
C...  SET THE INITIAL CONDITIONS
      CALL INITAL
C...
C...  PRINT THE INITIAL CONDITIONS
      CALL PRINT(NI,NO)
C...
C...  SET THE INITIAL CONDITIONS FOR SUBROUTINE DASSL
      CALL DERV
      DO 5 I=1,NEQN
      YV(I)=Y(I)
      YPRIME(I)=F(I)
5     CONTINUE
C...
C...  SET THE PARAMETERS FOR SUBROUTINE DASSL
      TV=T0
      RTOL=ERROR
      ATOL=1.0D-10
      LRW=5000
      LIW=270
      DO 7 I=1,15
      INFO(I)=0
7     CONTINUE
C...
C...  FULL JACOBIAN MATRIX
      IF(NORUN.EQ.1)THEN
C...
C...  BANDED JACOBIAN MATRIX
      ELSE IF(NORUN.EQ.2)THEN
         INFO(6)=1
         IWORK(1)=1
         IWORK(2)=1
      END IF
C...
C...  INITIATE THE INTEGRATION
      TOUT=TV+TP
C...
C...  CALL SUBROUTINE DASSL TO COVER ONE PRINT INTERVAL
4     CALL DASSL(RES,NEQN,TV,YV,YPRIME,TOUT,INFO,RTOL,ATOL,IDID,
     1           RWORK,LRW,IWORK,LIW,RPAR,IPAR,JAC)
C...
C...  PRINT THE SOLUTION
      T=TV
      DO 6 I=1,NEQN
      Y(I)=YV(I)
6     CONTINUE
      CALL PRINT(NI,NO)
C...
C...  TEST FOR AN ERROR CONDITION
      IF(IDID.LT.0)THEN
C...
C...     PRINT A MESSAGE INDICATING AN ERROR CONDITION
         WRITE(NO,1004)IDID
C...
C...     GO ON TO THE NEXT RUN
         GO TO 1
      END IF
C...
C...  CHECK FOR A RUN TERMINATION
      IF(NSTOP.NE.0)GO TO 1
C...
C...  THE INTEGRATION HAS PROCEEDED SATISFACTORILY, SO PREPARE FOR THE
C...  NEXT INTERVAL IN T.  NOTE THAT THE FOLLOWING CALCULATION OF THE
C...  OUTPUT TIME, TOUT, PRODUCES THREE OUTPUT POINTS FOR EACH DECADE
C...  IN T
      TOUT=TV*(1.0D+01)**(1.0D+00/3.0D+00)
C...
C...  CHECK FOR THE END OF THE RUN
      IF(TV.LT.(TF-0.5D+00*TP))GO TO 4
C...
C...  THE CURRENT RUN IS COMPLETE, SO PRINT THE COMPUTATIONAL STAT-
C...  ISTICS FOR DASSL AND GO ON TO THE NEXT RUN
      WRITE(NO,8)RWORK(7),IWORK(8),IWORK(11),IWORK(12),IWORK(13)
8     FORMAT(1H ,//,' COMPUTATIONAL STATISTICS'                    ,//,
     1 ' LAST STEP SIZE                       ',              D10.3,//,
     2 ' LAST ORDER OF THE METHOD             ',                I10,//,
     3 ' TOTAL NUMBER OF STEPS TAKEN          ',                I10,//,
     4 ' NUMBER OF FUNCTION EVALUATIONS       ',                I10,//,
     5 ' NUMBER OF JACOBIAN EVALUATIONS       ',                I10,/)
      GO TO 1
C...
C...  *****************************************************************
C...
C...  FORMATS
C...
1000  FORMAT(20A4)
1001  FORMAT(3D10.0)
1002  FORMAT(4I5,2X,A3,D10.0)
1003  FORMAT(1H1,
     1 ' RUN NO. - ',I3,2X,20A4,//,
     2 ' INITIAL T - ',D10.3,//,
     3 '   FINAL T - ',D10.3,//,
     4 '   PRINT T - ',D10.3,//,
     5 ' NUMBER OF DIFFERENTIAL EQUATIONS - ',I3,//,
     6 ' PRINT INTERVAL/MINIMUM INTEGRATION INTERVAL - ',I5,//,
     7 ' INTEGRATION ALGORITHM - ',I2,' - DASSL ',//,
     8 ' INTEGRATION ERROR MESSAGES - ',I1,//,
     9 ' ERROR CRITERION - ',A3,//,
     A ' MAXIMUM INTEGRATION ERROR - ',D10.3,//,
     B 1H1)
1004  FORMAT(1H ,//,' IDID = ',I3,//,
     1 ' INDICATING AN INTEGRATION ERROR, SO THE CURRENT RUN'     ,/,
     2 ' IS TERMINATED.  PLEASE REFER TO THE DOCUMENTATION FOR'   ,/,
     3 ' SUBROUTINE',//,25X,'DASSL',//,
     4 ' FOR AN EXPLANATION OF THESE ERROR INDICATORS'            )
      END
      SUBROUTINE RES(TV,YV,YPRIME,DELTA,IRES,RPAR,IPAR)
C...
C...  SUBROUTINE RES IS AN INTERFACE ROUTINE BETWEEN SUBROUTINES DASSL
C...  AND DERV
C...
C...  DSS/2 COMMON AREA
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/      Y(1)
     2      /F/      F(1)
C...
C...  THE NUMBER OF DIFFERENTIAL EQUATIONS IS AVAILABLE THROUGH COMMON
C...  /N/
      COMMON/N/      NEQN
C...
C...  ABSOLUTE DIMENSION THE DEPENDENT, DERIVATIVE AND RESIDUAL ARRAYS
      DIMENSION YV(250), YPRIME(250), DELTA(250)
C...
C...  TRANSFER THE INDEPENDENT VARIABLE, DEPENDENT VARIABLE VECTOR
C...  FOR USE IN SUBROUTINE DERV
      T=TV
      DO 1 I=1,NEQN
      Y(I)=YV(I)
1     CONTINUE
C...
C...  EVALUATE THE DERIVATIVE VECTOR
      CALL DERV
C...
C...  TRANSFER THE DERIVATIVE VECTOR FOR USE BY SUBROUTINE DASSL
      DO 2 I=1,NEQN
      DELTA(I)=YPRIME(I)-F(I)
2     CONTINUE
      RETURN
      END
      SUBROUTINE INITAL
C...
C...  DASSL SOLUTION OF TWO LINEAR ODES WITH A STIFFNESS RATIO OF 1E+06
C...  - PRINTING OF THE NUMERICAL AND EXACT SOLUTIONS
C...
C...  THE TWO SIMULTANEOUS, LINEAR, CONSTANT COEFFICIENT ORDINARY
C...  DIFFERENTIAL EQUATIONS
C...
C...     DY1/DT = A11*Y1 + A12*Y2                                    (1)
C...
C...     DY2/DT = A21*Y1 + A22*Y2                                    (2)
C...
C...  ARE INTEGRATED SUBJECT TO THE INITIAL CONDITIONS
C...
C...     Y1(0) = 0, Y2(0) = 2                                     (3)(4)
C...
C...  THE ANALYTICAL SOLUTION TO EQUATIONS (1) TO (4) CAN EASILY BE
C...  DERIVED.  FOR EXAMPLE, IF Y1(T) AND Y2(T) ARE ASSUMED TO BE
C...
C...     Y1 = C1*EXP(L*T), Y2 = C2*EXP(L*T)
C...
C...  SUBSTITUTION IN EQUATIONS (1) AND (2) GIVES
C...
C...     L*C1*EXP(L*T) = A11*C1*EXP(L*T) + A12*C2*EXP(L*T)           (5)
C...
C...     L*C2*EXP(L*T) = A21*C1*EXP(L*T) + A22*C2*EX(L*T)            (6)
C...
C...  THE EXPONENTIAL EXP(L*T) CANCELS FROM EQUATIONS (5) AND (6), AND
C...  THE FOLLOWING HOMOGENEOUS LINEAR ALGEBRAIC EQUATIONS FOR C1 AND C2
C...  RESULT
C...
C...     (A11 - L)*C1 +       A12*C2 = 0                             (7)
C...
C...           A21*C1 + (A22 - L)*C2 = 0                             (8)
C...
C...  EQUATIONS (7) AND (8) CONSTITUTE THE CLASSICAL, SECOND-ORDER,
C...  LINEAR ALGERAIC EIGENVALUE PROBLEM WHICH CAN BE SOLVED FOR THE
C...  VALUES OF L THAT DO NOT GIVE THE TRIVIAL SOLUTION C1 = 0, C2 = 0.
C...  THIS WILL BE DONE BY SETTING THE DETERMINANT OF THE COEFFICIENT
C...  MATRIX EQUAL TO ZERO (OTHER ALGORITHMS FOR CALCULATING THE EIGEN-
C...  VALUES, L1 AND L2, ARE AVAILABLE)
C...
C...     (A11 - L)*(A22 - L) - A12*A21 = 0                           (9)
C...
C...  OR
C...
C...     L**2 - (A11 + A22)*L + (A11*A22 - A12*A21) = 0             (10)
C...
C...  SOLUTION BY THE QUADRATIC EQUATION GIVES THE TWO EIGENVALUES, L1
C...  AND L2.  SINCE EQUATIONS (1) AND (2) ARE LINEAR, THE GENERAL
C...  SOLUTION CONSISTS OF A LINEAR COMBINATION OF THE TWO EXPONENTIALS
C...  EXP(L1*T) AND EXP(L2*T), I.E.,
C...
C...     Y1 = C11*EXP(L1*T) + C12*EXP(L2*T)                         (11)
C...
C...     Y2 = C21*EXP(L1*T) + C22*EXP(L2*T)                         (12)
C...
C...  WHERE C11, C12, C21 AND C22 ARE CONSTANTS TO BE DETERMINED (NOTE
C...  THAT (C11,C21) IS THE EIGENVECTOR FOR EIGENVALUE L1, AND (C12,C22)
C...  IS THE EIGENVECTOR FOR L2).  APPLYING INITIAL CONDITIONS (3) AND
C...  (4), PLUS EITHER EQUATION (7) OR (8) FOR L1 AND L2, GIVES THE
C...  RESULT
C...
C...     Y1 = -EXP(L1*T) + EXP(L2*T)                                (13)
C...
C...     Y2 =  EXP(L1*T) + EXP(L2*T)                                (14)
C...
C...  FOR THE SPECIAL CASE A11 = A22 = -A, A12 = A21 = B, L1 = -(A + B),
C...  L2 = -(A - B).  THE FOLLOWING PARTICULAR VALUES OF A AND B ILLUS-
C...  TRATE VARYING DEGREES OF STIFFNESS
C...
C...     CASE 1   A = 50.5        L1 = -100        L1/L2 = 100
C...              B = 49.5        L2 =   -1        (NONSTIFF)
C...
C...     CASE 2   A = 500.5       L1 = -1000       L1/L2 = 1000
C...              B = 499.5       L2 =    -1    (MODERATELY STIFF)
C...
C...     CASE 3   A = 500000.5    L1 = -1000000    L1/L2 = 1000000
C...              B = 499999.5    L2 =       -1     (VERY STIFF)
C...
C...  THE THIRD CASE PROVIDES A STRINGENT TEST OF A NUMERICAL INTEGRATOR
C...  FOR STIFF DIFFERENTIAL EQUATIONS.  FOR EXAMPLE, IF AN EXPLICIT
C...  INTEGRATOR IS USED IN CASE THREE, THE MAXIMUM STEP SIZE DETERMINED
C...  BY THE STABILITY OF THE CALCULATION WILL BE GIVEN APPROXIMATELY BY
C...
C...      ABS(HMAX*L1) LT 2
C...
C...  AND WITH L1 = -1000000, HMAX LT 2/1000000 = 0.000002.  SINCE THE
C...  TIME FOR THE PROBLEM IS DETERMINED BY L2, THROUGH THE EXPONENTIAL
C...  EXP(L2*T) IN EQUATIONS (13) AND (14), THE NUMERICAL SOLUTION
C...  MUST BE COMPUTED APPROXIMATELY OVER THE INTERVAL O LE T LE 10.
C...  THUS, TO COMPUTE THE SOLUTION TO T = 10, 10/0.000002 = 5,000,000
C...  STEPS IN T WILL BE REQUIRED BY THE EXPLICIT INTEGRATOR.  AN
C...  IMPLICIT INTEGRATOR, HOWEVER, WHICH IS NOT LIMITED BY STABILITY
C...  SHOULD PRODUCE A SOLUTION OVER THE INTERVAL 0 LE T LE 10 WITH AT
C...  MOST A FEW HUNDRED STEPS (THE NUMBER OF STEPS  WILL BE DETERMINED
C...  BY THE REQUIRED ACCURACY AND NOT BY THE STABILITY OF THE CALCU-
C...  LATION).  THIS VASTLY IMPROVED EFFICIENCY OF IMPLICIT INTEGRATORS
C...  FOR THIS STIFF PROBLEM IS DEMONSTRATED BY THE FOLLOWING CODING
C...
C...  BECAUSE OF THE STIFFNESS OF THIS PROBLEM, DOUBLE PRECISION CAL-
C...  CULATIONS ARE ADVISED
      DOUBLE PRECISION
     1              T,
     2             Y1,    Y2,
     3          DY1DT, DY2DT,
     4              A,     B
      COMMON/T/     T, NSTOP, NORUN
     1      /Y/    Y1,    Y2
     2      /F/ DY1DT, DY2DT
     3      /C/     A,     B
C...
C...  INITIAL CONDITIONS, EQUATIONS (3) AND (4)
      Y1=0.D+00
      Y2=2.D+00
C...
C...  THE FOLLOWING CONSTANTS IN THE ORDINARY DIFFERENTIAL EQUATIONS
C...  (ODES) CORRESPOND TO A STIFFNESS RATIO OF ONE MILLION (CASE 3
C...  ABOVE)
      A=500000.5D+00
      B=499999.5D+00
      RETURN
      END
      SUBROUTINE DERV
      DOUBLE PRECISION
     1              T,
     2             Y1,    Y2,
     3          DY1DT, DY2DT,
     4              A,     B
      COMMON/T/     T, NSTOP, NORUN
     1      /Y/    Y1,    Y2
     2      /F/ DY1DT, DY2DT
     3      /C/     A,     B
C...
C...  ODES, EQUATIONS (1) AND (2)
      DY1DT = -A*Y1 + B*Y2
      DY2DT =  B*Y1 - A*Y2
      RETURN
      END
      SUBROUTINE PRINT(NI,NO)
      DOUBLE PRECISION
     1              T,
     2             Y1,    Y2,
     3          DY1DT, DY2DT,
     4              A,     B,   AMB,  EXP1,  EXP2,   Y1E,   Y2E,
     5            Y1D,   Y2D
      COMMON/T/     T, NSTOP, NORUN
     1      /Y/    Y1,    Y2
     2      /F/ DY1DT, DY2DT
     3      /C/     A,     B
C...
C...  PRINT A HEADING FOR THE SOLUTION
      IF(T.EQ.0.D+00)WRITE(NO,2)
2     FORMAT(1H ,//,9X,1HT,
     1 13X,2HY1,12X,3HY1E,12X,3HY1D,/,
     2 23X,2HY2,12X,3HY2E,12X,3HY2D)
C...
C...  EVALUATE THE EXACT (ANALYTICAL) SOLUTION, EQUATIONS (11) AND (12)
C...  WITH L1 = -(A + B), L2 = -(A - B), FOR COMPARISON WITH THE NUMERI-
C...  CAL SOLUTION
      AMB=A-B
      IF(AMB.EQ.0.D+00)AMB=1.D+00
      EXP1=DEXP(-AMB*T)
      EXP2=0.D+00
      IF(((A+B)*T).LT.50.D+00)EXP2=DEXP(-(A+B)*T)
      Y1E=EXP1-EXP2
      Y2E=EXP1+EXP2
C...
C...  COMPUTE THE DIFFERENCES BETWEEN THE NUMERICAL AND EXACT SOLUTIONS
      Y1D=Y1-Y1E
      Y2D=Y2-Y2E
C...
C...  PRINT THE INDEPENDENT VARIABLE, NUMERICAL AND EXACT SOLUTIONS, AND
C...  THE DIFFERENCES BETWEEN THE TWO SOLUTIONS
      WRITE(NO,1)T,Y1,Y1E,Y1D,Y2,Y2E,Y2D
1     FORMAT(1H ,/,D10.3,3D15.4,/,10X,3D15.4)
      RETURN
      END
LAPIDUS, ET AL, NUM METH DIFF SYS, P107
    0.D+00    1.D+01    1.D-09
    2 1000    2    1  REL 0.00001
END OF RUNS
*APP MATH46
      SUBROUTINE INITAL
C...
C...  KROGH'S ODE PROBLEM - SOLUTION OF A NONSTIFF CASE BY RUNGE KUTTA
C...
C...  KROGH'S PROBLEM IS A NONLINEAR ODE PROBLEM WITH AN EXACT
C...  SOLUTION.  THE NUMBER OF ODES AND THE STIFFNESS OF THESE
C...  EQUATIONS CAN BE VARIED BY THE CHOICE OF PARAMETERS.  IN
C...  THIS CASE, N = 20, AND THE STIFFNESS IS SET BY CONSTANTS
C...  READ FROM A DATA FILE.
C...
C...  THE NONLINEAR ODE PROBLEM PROPOSED BY KROGH (1) IS AN IDEAL
C...  TEST PROBLEM FOR ODE SOFTWARE FOR THE FOLLOWING REASONS:
C...
C...     (1)  THE ORDER OF THE PROBLEM (NUMBER OF ODES) CAN BE
C...          SELECTED BY THE USER (IN THE PRESENT CASE, N = 20).
C...
C...     (2)  THE STIFFNESS OF THE ODES CAN BE SELECTED BY THE USER.
C...          THIS POINT REQUIRES SOME CLARIFICATION SINCE THE ODES
C...          ARE NONLINEAR, BUT STIFFNESS IS A LINEAR CONCEPT BASED
C...          ON EIGENVALUES (A STIFF SYSTEM IS GENERALLY DEFINED AS:
C...
C...                 (PROBLEM TIME)*(LARGEST EIGENVALUE)
C...
C...                       IS MUCH GREATER THAN 1)
C...
C...          GENERALLY, THE CONCEPT OF STIFFNESS APPLIED TO NONLINEAR
C...          PROBLEMS MEANS APPLIED TO THE LINEARIZED VERSION OF THE
C...          NONLINEAR EQUATIONS, FOR WHICH EIGENVALUES CAN BE COM-
C...          PUTED.  HOWEVER, SINCE LINEARIZATION IS PERFORMED AROUND
C...          A BASE POINT, THE EIGENVALUES OF THE LINEARIZED SYSTEM
C...          WILL CHANGE WITH THE BASE POINT, I.E., THE LOCAL EIGEN-
C...          VALUES OF A NONLINEAR SYSTEM ARE NOT CONSTANT.
C...
C...          THE NONLINEAR ODES IN THE KROGH PROBLEM HAVE IN THEIR
C...          ANALYTICAL SOLUTION EXPONENTIALS OF THE FORM EXP(B(I)*T)
C...          WHERE T IS THE INDEPENDENT VARIABLE AND THE B(I), I =
C...          1, 2,..., N ARE PARAMETERS SELECTED BY THE USER.  THUS
C...          THE B(I) ARE ANALOGOUS TO EIGENVALUES, BUT THE EXPONENT-
C...          IALS (EXP(B(I)*T)) APPEAR NONLINEARLY IN THE ANALYTICAL
C...          SOLUTION (RATHER THAN AS A LINEAR COMBINATION IN THE
C...          ANALYTICAL SOLUTION OF A SYSTEM OF CONSTANT COEFFICIENT
C...          LINEAR ODES).
C...
C...          IN THIS SENSE, THE STIFFNESS OF THE KROGH TEST PROBLEM
C...          CAN BE SPECIFIED BY THE USER BY SELECTING THE B(I).
C...
C...     (3)  AS THE PRECEDING DISCUSSION INDICATES, THE KROGH TEST
C...          HAS AN ANALYTICAL (EXACT) SOLUTION, WHICH CAN BE USED
C...          AS A STANDARD IN EVALUATING A NUMERICAL INTEGRATOR, I.E.,
C...          THE ERRORS IN NUMERICAL SOLUTIONS CAN BE COMPUTED.
C...
C...  ALL OF THE FEATURES OF THE KROGH TEST PROBLEM ARE ILLUSTRATED IN
C...  THE FOLLOWING CODING FOR TWO CASES:
C...
C...     (1)  NONSTIFF CASE
C...
C...          HERE WE TAKE B(I) = -I, I = 1, 2,..., 20
C...
C...          THESE CONSTANTS ARE READ FROM A DATA FILE IN SUBROUTINE
C...          INITAL AT THE BEGINNING OF THE NUMERICAL SOLUTION, AND
C...          THE INTEGRATION IS PERFORMED BY A NONSTIFF, SECOND-ORDER
C...          RUNGE KUTTA METHOD IMPLEMENTED IN DSS/2.
C...
C...     (2)  STIFF CASE
C...
C...          HERE WE TAKE B(I), I = 1, 2,..., 20 TO HAVE THE FOLLOWING
C...          VALUES READ FROM A DATA FILE IN SUBROUTINE INITAL AT THE
C...          BEGINNING OF THE NUMERICAL SOLUTION, AND THE INTEGRATION
C...          IS PERFORMED BY A STIFF INTEGRATOR, THE BANDED VERSION
C...          OF LSODE.  SINCE THE BANDWIDTH OF THE ODE JACOBIAN MATRIX
C...          MUST BE SPECIFIED IN USING THIS INTEGRATOR, THE JACOBIAN
C...          MATRIX IS MAPPED IN SUBROUTINE PRINT, AND THE EIGENVALUES
C...          ARE COMPUTED ALONG THE SOLUTION TO DEMONSTRATE HOW THEY
C...          CHANGE (AGAIN, BECAUSE THE ODES ARE NONLINEAR).
C...
C...                                  1000.
C...                                  1000.
C...                                  1000.
C...                                  1000.
C...                                  1000.
C...                                  1000.
C...                                  -1000.
C...                                  -1000.
C...                                  -1000.
C...                                  -1000.
C...                                  -1000.
C...                                  -1000.
C...                                  10.
C...                                  10.
C...                                  -10.0
C...                                  -10.0
C...                                  0.001
C...                                  0.001
C...                                  -0.001
C...                                  -0.001
C...
C...           SINCE THESE VALUES OF B(I) SPAN SIX ORDERS OF MAGNITUDE,
C...           THIS PROBLEM CAN BE CONSIDERED (AND THEREFORE SHOULD NOT
C...           BE DONE BY A NONSTIFF (EXPLICIT) INTEGRATOR).
C...
C...  THE MATHEMATICAL DETAILS OF THE PROBLEM ARE GIVEN IN REFERENCE
C...  (1) CITED PREVIOUSLY.  THEY CAN ALSO BE INFERRED FROM THE
C...  FOLLOWING CODING.
C...
      COMMON /T/        T
      COMMON /Y/    Y(20)
      COMMON /F/ DYDT(20)
      COMMON /C/ BETA(20), U(20,20), B(20,20), N
      COMMON /IO/  NI, NO
C...
C...  READ THE NUMBER OF ODES AND THE CONSTANT ARRAY, BETA, WHICH
C...  DEFINES THE PROBLEM TIME SCALE AND STIFFNESS
      READ(NI,100)N
      DO 10 J=1,N
      READ(NI,101)BETA(J)
  10  CONTINUE
      WRITE(NO,102)N,(BETA(J),J=1,N)
C...
C...  INITIAL CONDITIONS
      DO 20 J=1,N
      Y(J) = -1.0
  20  CONTINUE
C...
C...  SET THE CONSTANT ARRAY, U
      TERM = 2.0/FLOAT(N)
      DO 30 I=1,N
      DO 40 J=1,N
      U(I,J) = TERM
  40  CONTINUE
      U(I,I) = TERM - 1.0
  30  CONTINUE
C...
C...  SET THE CONSTANT ARRAY, B
      DO 50 J=1,N
      DO 60 I=1,N
      SUM = 0.0
      DO 70 K=1,N
      SUM = SUM + U(I,K)*BETA(K)*U(K,J)
  70  CONTINUE
      B(I,J) = SUM
  60  CONTINUE
  50  CONTINUE
C...
C...  PRINT THE OUTPUT HEADING
      WRITE(NO,103)
      WRITE(NO,104)
C...
C...  FORMATS ARE LISTED HERE
 100  FORMAT(I5)
 101  FORMAT(F20.5)
 102  FORMAT(1H ,10X,'N = ',I3,10X,'BETA',20(/,17X,F15.3))
 103  FORMAT(1H1)
 104  FORMAT(1H ,12X,'TIME',6X,'Y(1)',4X,'YEX(1)',6X,'PER1',
     1                     5X,'Y(20)',3X,'YEX(20)',5X,'PER20',
     2                     4X,'PERMAX')
      RETURN
      END
      SUBROUTINE DERV
      COMMON /T/        T
      COMMON /Y/    Y(20)
      COMMON /F/ DYDT(20)
      COMMON /C/ BETA(20), U(20,20), B(20,20), N
      DIMENSION W(20)
C...
C...  CALCULATE THE ARRAY, W
      DO 10 I=1,N
      SUM = 0.0
      DO 20 J=1,N
      SUM = SUM + U(I,J)*Y(J)
  20  CONTINUE
      W(I) = SUM
  10  CONTINUE
C...
C...  CALCULATE THE N ODE DERIVATIVES
      DO 30 I=1,N
      SUM = 0.0
      DO 40 J=1,N
      SUM = SUM + U(I,J)*W(J)*W(J) - B(I,J)*Y(J)
  40  CONTINUE
      DYDT(I) = SUM
  30  CONTINUE
      RETURN
      END
      SUBROUTINE PRINT(NI,NO)
      COMMON /T/        T
      COMMON /Y/    Y(20)
      COMMON /F/ DYDT(20)
      COMMON /C/ BETA(20), U(20,20), B(20,20), N
      DIMENSION W(20), YEX(20)
C...
C...  ABSOLUTE DIMENSIONING OF THE ARRAYS REQUIRED BY SUBROUTINE JMAP
C...  (A, X, XOLD, F, FOLD) AND SUBROUTINE EIGEN (WI, WR, Z, RW, IW)
      REAL
     1           A(20,20), WR(20), WI(20), Z(20,20), RW(20),
     2                             X(20),  XOLD(20),
     3                             F(20),  FOLD(20)
      INTEGER                     IW(20)
C...
C...  THE FOLLOWING EQUIVALENCE FACILITATES TRANSFER OF THE DEPENDENT
C...  VARIABLE VECTOR IN /Y/ TO ARRAY Y, AND THE DERIVATIVE VECTOR IN
C...  IN /F/ TO ARRAY F FOR USE IN THE SUBSEQUENT CALL TO SUBROUTINE
C...  JMAP
      EQUIVALENCE (Y(1),X(1)),(DYDT(1),F(1))
C...
C...  CALCULATE THE N EXACT SOLUTIONS
      DO 10 J=1,N
      BETAT = BETA(J)*T
      IF (BETAT.GT.200.) THEN
         W(J) = 0.0
      ELSE IF (BETAT.LT.-200.) THEN
         W(J) = BETA(J)
      ELSE
         W(J) = BETA(J)/(1.0 - (1.0 + BETA(J))*EXP(BETAT))
      END IF
  10  CONTINUE
      DO 20 I=1,N
      SUM = 0.0
      DO 30 J=1,N
      SUM = SUM + U(I,J)*W(J)
  30  CONTINUE
      YEX(I) = SUM
  20  CONTINUE
C...
C...  CALCULATE THE MAXIMUM ERROR
      ERRMAX = ABS((Y(1) - YEX(1))/YEX(1))*100.
      DO 40 J=2,N
      ERR = ABS((Y(J) - YEX(J))/YEX(J))*100.
      IF (ERR.GT.ERRMAX) ERRMAX = ERR
  40  CONTINUE
C...
C...  PRINT THE NUMERICAL AND EXACT SOLUTIONS FOR I = 1 AND N, AND
C...  THE CORRESPONDING ERRORS, AND THE MAXIMUM ERROR
      PER1=ABS((Y(1)-YEX(1))/YEX(1))*100.
      PERN=ABS((Y(N)-YEX(N))/YEX(N))*100.
      PERMAX=ERRMAX
      WRITE(NO,101)T,Y(1),YEX(1),PER1,Y(N),YEX(N),PERN,PERMAX
      IF (T.EQ.0.0) RETURN
 101  FORMAT(/,5X,E12.3,7F10.4)
C...
C...  MAP THE JACOBIAN MATRIX OF THE ODE SYSTEM DEFINED IN SUBROUTINE
C...  DERV, AND COMPUTE ITS TEMPORAL EIGENVALUES
      CALL JMAP(N,A,X,XOLD,F,FOLD)
C...
C...  SUBROUTINE EIGEN (PART OF DSS/2) CALLS A SERIES OF EISPACK ROU-
C...  TINES TO COMPUTE THE TEMPORAL EIGENVALUES, AND OPTIONALLY, THE
C...  EIGENVECTORS OF THE 20-ODE SYSTEM JACOBIAN MATRIX
      CALL EIGEN(N,A,WR,WI,Z,RW,IW)
      RETURN
      END
KROGH PROBLEM FOR N = 20, NONSTIFF CASE
0.        1.0       0.1
   2010000    1    1  REL 0.0001
   20
-1.
-2.
-3.
-4.
-5.
-6.
-7.
-8.
-9.
-10.
-11.
-12.
-13.
-14.
-15.
-16.
-17.
-18.
-19.
-20.
END OF RUNS
*APP MATH47
      PROGRAM LSODET
C...
C...  AN INTERFACE BETWEEN DSS/2 APPLICATIONS AND INTEGRATOR LSODE
C...
C...  THE FOLLOWING PROGRAM CALLS A DSS/2 APPLICATION, DEFINED AS THE
C...  USER-SUPPLIED SUBROUTINES INITAL, DERV AND PRINT, PLUS DATA.
C...  THE SYSTEM OF ODES PROGRAMMED IN SUBROUTINE DERV IS INTEGRATED
C...  BY LSODE (THE BASIC SOLVER IN ODEPACK, A LIBRARY OF INTEGRATORS
C...  DEVELOPED BY ALAN C. HINDMARSH, LAWRENCE LIVERMORE NATIONAL LAB-
C...  ORATORY).
C...
C...  THE MODEL INITIAL CONDITIONS ARE SET IN SUBROUTINE INITAL, AND
C...  THE MODEL DERIVATIVES ARE PROGRAMMED IN SUBROUTINE DERV.  THE
C...  NUMERICAL SOLUTION IS PRINTED AND PLOTTED IN SUBROUTINE PRINT.
C...
C...  SUBROUTINES INITAL, DERV AND PRINT.  THE FOLLOWING CODING IS FOR
C...  250 ORDINARY DIFFERENTIAL EQUATIONS (ODES).  IF MORE ODES ARE TO
C...  BE INTEGRATED, ALL OF THE 250*S SHOULD BE CHANGED TO THE REQUIRED
C...  NUMBER
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/    Y(250)
     2      /F/    F(250)
C...
C...  COMMON AREA TO PROVIDE THE INPUT/OUTPUT UNIT NUMBERS TO OTHER
C...  SUBROUTINES
      COMMON/IO/       NI,        NO
C...
C...  ABSOLUTE DIMENSIONING OF THE ARRAYS REQUIRED BY LSODE.  ARRAY
C...  WORK IS SIZED BY THE FOLLOWING FORMULA FOR BANDED PROCESSING
C...  OF THE ODE JACOBIAN MATRIX VIA FINITE DIFFERENCES: 22+17*NEQN+
C...  (2*ML+MU)*NEQN.  FOR NEQN = 250, ML = MU = 3, 22+17*250+(2*3+3)*
C...  250 = 6600 (APPROXIMATELY).  IF FEWER THAN 250 ODES ARE TO BE
C...  INTEGRATED, THEN ML AND MU CAN BE LARGER FOR THE GIVEN SIZE OF
C...  WORK.  IF NEQN GT 250 AND/OR ML AND MU GT 3, WORK MUST BE DIMEN-
C...  SIONED TO A LARGER SIZE
      DIMENSION YV(250), RWORK(6600), IWORK(275)
C...
C...  EXTERNAL THE DERIVATIVE AND ODE JACOBIAN MATRIX ROUTINES CALLED BY
C...  LSODE
      EXTERNAL FCN, JAC
C...
C...  ARRAY FOR THE TITLE (FIRST LINE OF DATA), CHARACTERS  END OF RUNS
      CHARACTER TITLE(20)*4, ENDRUN(3)*4
C...
C...  VARIABLE FOR THE TYPE OF ERROR CRITERION
      CHARACTER*3 ABSREL
C...
C...  DEFINE THE CHARACTERS  END OF RUNS
      DATA ENDRUN/'END ','OF RU','NS  '/
C...
C...  DEFINE THE INPUT/OUTPUT UNIT NUMBERS
      NI=5
      NO=6
C...
C...  OPEN THE INPUT/OUTPUT FILES
      OPEN(NI,FILE='INPUT')
      OPEN(NO,FILE='OUTPUT')
C...
C...  INITIALIZE THE RUN COUNTER
      NORUN=0
C...
C...  BEGIN A RUN
1     NORUN=NORUN+1
C...
C...  INITIALIZE THE RUN TERMINATION VARIABLE
      NSTOP=0
C...
C...  READ THE FIRST LINE OF DATA
      READ(NI,1000,END=999)(TITLE(I),I=1,20)
C...
C...  TEST FOR  END OF RUNS  IN THE DATA
      DO 2 I=1,3
      IF(TITLE(I).NE.ENDRUN(I))GO TO 3
2     CONTINUE
C...
C...  AND END OF RUNS HAS BEEN READ, SO TERMINATE EXECUTION
999   STOP
C...
C...  READ THE SECOND LINE OF DATA
3     READ(NI,1001,END=999)T0,TF,TP
C...
C...  READ THE THIRD LINE OF DATA
      READ(NI,1002,END=999)NEQN,NMAX,INT,IERROR,ABSREL,ERROR
C...
C...  PRINT A DATA SUMMARY
      WRITE(NO,1003)NORUN,(TITLE(I),I=1,20),
     1                     T0,TF,TP,
     2                     NEQN,NMAX,INT,IERROR,ABSREL,ERROR
C...
C...  INITIALIZE TIME
      T=T0
C...
C...  SET THE INITIAL CONDITIONS
      CALL INITAL
C...
C...  PRINT THE INITIAL CONDITIONS
      CALL PRINT(NI,NO)
C...
C...  SET THE INITIAL CONDITIONS FOR SUBROUTINE LSODE
      DO 5 I=1,NEQN
      YV(I)=Y(I)
5     CONTINUE
C...
C...  SET THE PARAMETERS FOR SUBROUTINE LSODE
      N=20
      TV=T0
      ITOL=1
      RTOL=1.0E-05
      ATOL=1.0E-05
      LRW=6600
      LIW=275
      IOPT=0
      ITASK=1
      ISTATE=1
C...
C...  TWO LSODE OPTIONS, AS SELECTED BY THE RUN NUMBER NORUN, ARE
C...  PROGRAMMED HERE. THE TERMINOLOGY IS
C...
C...     IMPLICIT ADAMS METHOD FOR NONSTIFF PROBLEMS
C...
C...     METHOD BASED ON BACKWARD DIFFERENTIATION FORMULAS (BDF) FOR
C...     STIFF PROBLEMS
C...
C...  EACH OF THESE METHODS (NONSTIFF AND STIFF) GENERATES NONLINEAR
C...  ALGEBRAIC EQUATIONS DURING THE NUMERICAL INTEGRATION WHICH ARE
C...  SOLVED BY ONE OF THE FOLLOWING METHODS
C...
C...     FUNCTIONAL ITERATION (A PICARD ITERATION)
C...
C...     CHORD ITERATION, ESSENTIALLY NEWTON*S METHOD, WITH THE ODE
C...     JACOBIAN MATRIX PARTIAL DERIVATIVES APPROXIMATED BY FINITE
C...     DIFFERENCES.  A FULL, BANDED OR DIAGONAL MATRIX MAY BE USED.
C...     THE BANDED AND DIAGONAL FORMS TYPICALLY ARE APPROXIMATIONS TO
C...     THE FULL MATRIX, I.E., CONTAIN A SUBSET OF THE ELEMENTS OF THE
C...     FULL MATRIX.
C...
C...     (1)  NORUN = 1
C...
C...          IMPLICIT ADAMS METHOD, FUNCTIONAL ITERATION
              IF(NORUN.EQ.1)THEN
              METH=1
              MITER=0
C...
C...     (2)  NORUN = 2
C...
C...          IMPLICIT BDF METHOD, CHORD ITERATION WITH AN INTERNALLY
C...          GENERATED (DIFFERENCE QUOTIENT) FULL JACOBIAN
              ELSE IF(NORUN.EQ.2)THEN
              METH=2
              MITER=2
C...
      END IF
C...
C...  THE METHOD FLAG, MF, IS COMPUTED FROM METH AND MITER
      MF=10*METH+MITER
C...
C...  FOR THE NONSTIFF CASE (NORUN = 1), THE INDEPENDENT VARIABLE IS
C...  ADVANCED BY AN ADDITIVE INCREMENT
4        IF(NORUN.EQ.1)THEN
            TOUT=TV+TP
C...
C...  FOR THE STIFF CASE (NORUN = 2), THE INDEPENDENT VARIABLE IS
C...  ADVANCED BY A MULIPLICATIVE FACTOR
         ELSE IF(NORUN.EQ.2)THEN
            TOUT=TV*10.0
         END IF
C...
C...  CALL SUBROUTINE LSODE TO COVER ONE PRINT INTERVAL
      CALL LSODE(FCN,NEQN,YV,TV,TOUT,ITOL,RTOL,ATOL,ITASK,ISTATE,
     1           IOPT,RWORK,LRW,IWORK,LIW,JAC,MF)
C...
C...  PRINT THE SOLUTION
      T=TV
      DO 6 I=1,NEQN
      Y(I)=YV(I)
6     CONTINUE
      CALL PRINT(NI,NO)
C...
C...  TEST FOR AN ERROR CONDITION
      IF(ISTATE.LT.0)THEN
C...
C...     PRINT A MESSAGE INDICATING AN ERROR CONDITION
         WRITE(NO,1004)ISTATE
C...
C...     GO ON TO THE NEXT RUN
         GO TO 1
      END IF
C...
C...  CHECK FOR A RUN TERMINATION
      IF(NSTOP.NE.0)GO TO 1
C...
C...  CHECK FOR THE END OF THE RUN
      IF(TV.LT.(TF-0.5*TP))GO TO 4
C...
C...  THE CURRENT RUN IS COMPLETE, SO PRINT THE COMPUTATIONAL STAT-
C...  ISTICS FOR LSODE AND GO ON TO THE NEXT RUN
      WRITE(NO,8)RWORK(11),IWORK(14),IWORK(11),IWORK(12),IWORK(13)
8     FORMAT(1H ,//,' COMPUTATIONAL STATISTICS'                    ,//,
     1 ' LAST STEP SIZE                       ',              E10.3,//,
     2 ' LAST ORDER OF THE METHOD             ',                I10,//,
     3 ' TOTAL NUMBER OF STEPS TAKEN          ',                I10,//,
     4 ' NUMBER OF FUNCTION EVALUATIONS       ',                I10,//,
     5 ' NUMBER OF JACOBIAN EVALUATIONS       ',                I10,/)
      GO TO 1
C...
C...  *****************************************************************
C...
C...  FORMATS
C...
1000  FORMAT(20A4)
1001  FORMAT(3E10.0)
1002  FORMAT(4I5,2X,A3,E10.0)
1003  FORMAT(1H1,
     1 ' RUN NO. - ',I3,2X,20A4,//,
     2 ' INITIAL T - ',E10.3,//,
     3 '   FINAL T - ',E10.3,//,
     4 '   PRINT T - ',E10.3,//,
     5 ' NUMBER OF DIFFERENTIAL EQUATIONS - ',I3,//,
     6 ' PRINT INTERVAL/MINIMUM INTEGRATION INTERVAL - ',I5,//,
     7 ' INTEGRATION ALGORITHM - ',I2,' - LSODE ',//,
     8 ' INTEGRATION ERROR MESSAGES - ',I1,//,
     9 ' ERROR CRITERION - ',A3,//,
     A ' MAXIMUM INTEGRATION ERROR - ',E10.3,//,
     B 1H1)
1004  FORMAT(1H ,//,' ISTATE = ',I3,//,
     1 ' INDICATING AN INTEGRATION ERROR, SO THE CURRENT RUN'     ,/,
     2 ' IS TERMINATED.  PLEASE REFER TO THE DOCUMENTATION FOR'   ,/,
     3 ' SUBROUTINE',//,25X,'LSODE',//,
     4 ' FOR AN EXPLANATION OF THESE ERROR INDICATORS'            )
      END
      SUBROUTINE FCN(NEQN,TV,YV,YDOT)
C...
C...  SUBROUTINE FCN IS AN INTERFACE ROUTINE BETWEEN SUBROUTINES LSODE
C...  AND DERV
C...
C...  DSS/2 COMMON AREA
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/      Y(1)
     2      /F/      F(1)
C...
C...  VARIABLE DIMENSION THE DEPENDENT AND DERIVATIVE ARRAYS
      DIMENSION YV(NEQN), YDOT(NEQN)
C...
C...  TRANSFER THE INDEPENDENT VARIABLE, DEPENDENT VARIABLE VECTOR
C...  FOR USE IN SUBROUTINE DERV
      T=TV
      DO 1 I=1,NEQN
      Y(I)=YV(I)
1     CONTINUE
C...
C...  EVALUATE THE DERIVATIVE VECTOR
      CALL DERV
C...
C...  TRANSFER THE DERIVATIVE VECTOR FOR USE BY SUBROUTINE LSODE
      DO 2 I=1,NEQN
      YDOT(I)=F(I)
2     CONTINUE
      RETURN
      END
      SUBROUTINE INITAL
C...
C...  KROGH'S ODE PROBLEM - SOLUTION OF A STIFF CASE BY LSODE
C...
C...  KROGH'S PROBLEM IS A NONLINEAR ODE PROBLEM WITH AN EXACT
C...  SOLUTION.  THE NUMBER OF ODES AND THE STIFFNESS OF THESE
C...  EQUATIONS CAN BE VARIED BY THE CHOICE OF PARAMETERS.  IN
C...  THIS CASE, N = 20, AND THE STIFFNESS IS SET BY CONSTANTS
C...  READ FROM A DATA FILE.
C...
C...  THE NONLINEAR ODE PROBLEM PROPOSED BY KROGH (1) IS AN IDEAL
C...  TEST PROBLEM FOR ODE SOFTWARE FOR THE FOLLOWING REASONS:
C...
C...     (1)  THE ORDER OF THE PROBLEM (NUMBER OF ODES) CAN BE
C...          SELECTED BY THE USER (IN THE PRESENT CASE, N = 20).
C...
C...     (2)  THE STIFFNESS OF THE ODES CAN BE SELECTED BY THE USER.
C...          THIS POINT REQUIRES SOME CLARIFICATION SINCE THE ODES
C...          ARE NONLINEAR, BUT STIFFNESS IS A LINEAR CONCEPT BASED
C...          ON EIGENVALUES (A STIFF SYSTEM IS GENERALLY DEFINED AS:
C...
C...                 (PROBLEM TIME)*(LARGEST EIGENVALUE)
C...
C...                       IS MUCH GREATER THAN 1)
C...
C...          GENERALLY, THE CONCEPT OF STIFFNESS APPLIED TO NONLINEAR
C...          PROBLEMS MEANS APPLIED TO THE LINEARIZED VERSION OF THE
C...          NONLINEAR EQUATIONS, FOR WHICH EIGENVALUES CAN BE COM-
C...          PUTED.  HOWEVER, SINCE LINEARIZATION IS PERFORMED AROUND
C...          A BASE POINT, THE EIGENVALUES OF THE LINEARIZED SYSTEM
C...          WILL CHANGE WITH THE BASE POINT, I.E., THE LOCAL EIGEN-
C...          VALUES OF A NONLINEAR SYSTEM ARE NOT CONSTANT.
C...
C...          THE NONLINEAR ODES IN THE KROGH PROBLEM HAVE IN THEIR
C...          ANALYTICAL SOLUTION EXPONENTIALS OF THE FORM EXP(B(I)*T)
C...          WHERE T IS THE INDEPENDENT VARIABLE AND THE B(I), I =
C...          1, 2,..., N ARE PARAMETERS SELECTED BY THE USER.  THUS
C...          THE B(I) ARE ANALOGOUS TO EIGENVALUES, BUT THE EXPONENT-
C...          IALS (EXP(B(I)*T)) APPEAR NONLINEARLY IN THE ANALYTICAL
C...          SOLUTION (RATHER THAN AS A LINEAR COMBINATION IN THE
C...          ANALYTICAL SOLUTION OF A SYSTEM OF CONSTANT COEFFICIENT
C...          LINEAR ODES).
C...
C...          IN THIS SENSE, THE STIFFNESS OF THE KROGH TEST PROBLEM
C...          CAN BE SPECIFIED BY THE USER BY SELECTING THE B(I).
C...
C...     (3)  AS THE PRECEDING DISCUSSION INDICATES, THE KROGH TEST
C...          HAS AN ANALYTICAL (EXACT) SOLUTION, WHICH CAN BE USED
C...          AS A STANDARD IN EVALUATING A NUMERICAL INTEGRATOR, I.E.,
C...          THE ERRORS IN NUMERICAL SOLUTIONS CAN BE COMPUTED.
C...
C...  ALL OF THE FEATURES OF THE KROGH TEST PROBLEM ARE ILLUSTRATED IN
C...  THE FOLLOWING CODING FOR TWO CASES:
C...
C...     (1)  NONSTIFF CASE
C...
C...          HERE WE TAKE B(I) = -I, I = 1, 2,..., 20
C...
C...          THESE CONSTANTS ARE READ FROM A DATA FILE IN SUBROUTINE
C...          INITAL AT THE BEGINNING OF THE NUMERICAL SOLUTION, AND
C...          THE INTEGRATION IS PERFORMED BY A NONSTIFF, SECOND-ORDER
C...          RUNGE KUTTA METHOD IMPLEMENTED IN DSS/2.
C...
C...     (2)  STIFF CASE
C...
C...          HERE WE TAKE B(I), I = 1, 2,..., 20 TO HAVE THE FOLLOWING
C...          VALUES READ FROM A DATA FILE IN SUBROUTINE INITAL AT THE
C...          BEGINNING OF THE NUMERICAL SOLUTION, AND THE INTEGRATION
C...          IS PERFORMED BY A STIFF INTEGRATOR, THE BANDED VERSION
C...          OF LSODE.  SINCE THE BANDWIDTH OF THE ODE JACOBIAN MATRIX
C...          MUST BE SPECIFIED IN USING THIS INTEGRATOR, THE JACOBIAN
C...          MATRIX IS MAPPED IN SUBROUTINE PRINT, AND THE EIGENVALUES
C...          ARE COMPUTED ALONG THE SOLUTION TO DEMONSTRATE HOW THEY
C...          CHANGE (AGAIN, BECAUSE THE ODES ARE NONLINEAR).
C...
C...                                  1000.
C...                                  1000.
C...                                  1000.
C...                                  1000.
C...                                  1000.
C...                                  1000.
C...                                  -1000.
C...                                  -1000.
C...                                  -1000.
C...                                  -1000.
C...                                  -1000.
C...                                  -1000.
C...                                  10.
C...                                  10.
C...                                  -10.0
C...                                  -10.0
C...                                  0.001
C...                                  0.001
C...                                  -0.001
C...                                  -0.001
C...
C...           SINCE THESE VALUES OF B(I) SPAN SIX ORDERS OF MAGNITUDE,
C...           THIS PROBLEM CAN BE CONSIDERED (AND THEREFORE SHOULD NOT
C...           BE DONE BY A NONSTIFF (EXPLICIT) INTEGRATOR).
C...
C...           IN USING LSODE, THE SIZE OF A WORK ARRAY MUST BE SET TO
C...           ACCOMMODATE THE PARTICULAR PROBLEM, AS SPECIFIED BY THE
C...           FORMULA
C...
C...              SIZE = 22 + 17*NEQN + (2*ML + MU)*NEQN
C...
C...           FOR THE PRESENT PROBLEM, NEQN = 20.  ALSO, THE JACOBIAN
C...           MATRIX IS FULL (THE MAPS PRODUCED BY CALLING SUBROUTINE
C...           JMAP IN SUBROUTINE PRINT DEMONSTRATE THIS FULL STRUCTURE)
C...           SO THE LOWER AND UPPER HALF BANDWIDTHS ARE ML = MU = 19.
C...
C...           SUBSTITUTION IN THE FORMULA GIVES
C...
C...              SIZE = 22 + 17*20 + (2*19 + 19)*20
C...
C...                   = 1502
C...
C...           THE DIMENSION OF THE WORK ARRAY IN THE MAIN PROGRAM
C...           EXCEEDS THIS SIZE SO THE PROBLEM CAN BE ACCOMMODATED.
C...
C...  THE MATHEMATICAL DETAILS OF THE PROBLEM ARE GIVEN IN REFERENCE
C...  (1) CITED PREVIOUSLY.  THEY CAN ALSO BE INFERRED FROM THE
C...  FOLLOWING CODING.
C...
      COMMON /T/        T
      COMMON /Y/    Y(20)
      COMMON /F/ DYDT(20)
      COMMON /C/ BETA(20), U(20,20), B(20,20), N
      COMMON /IO/  NI, NO
C...
C...  READ THE NUMBER OF ODES AND THE CONSTANT ARRAY, BETA, WHICH
C...  DEFINES THE PROBLEM TIME SCALE AND STIFFNESS
      READ(NI,100)N
      DO 10 J=1,N
      READ(NI,101)BETA(J)
  10  CONTINUE
      WRITE(NO,102)N,(BETA(J),J=1,N)
C...
C...  INITIAL CONDITIONS
      DO 20 J=1,N
      Y(J) = -1.0
  20  CONTINUE
C...
C...  SET THE CONSTANT ARRAY, U
      TERM = 2.0/FLOAT(N)
      DO 30 I=1,N
      DO 40 J=1,N
      U(I,J) = TERM
  40  CONTINUE
      U(I,I) = TERM - 1.0
  30  CONTINUE
C...
C...  SET THE CONSTANT ARRAY, B
      DO 50 J=1,N
      DO 60 I=1,N
      SUM = 0.0
      DO 70 K=1,N
      SUM = SUM + U(I,K)*BETA(K)*U(K,J)
  70  CONTINUE
      B(I,J) = SUM
  60  CONTINUE
  50  CONTINUE
C...
C...  PRINT THE OUTPUT HEADING
      WRITE(NO,103)
      WRITE(NO,104)
C...
C...  FORMATS ARE LISTED HERE
 100  FORMAT(I5)
 101  FORMAT(F20.5)
 102  FORMAT(1H ,10X,'N = ',I3,10X,'BETA',20(/,17X,F15.3))
 103  FORMAT(1H1)
 104  FORMAT(1H ,12X,'TIME',6X,'Y(1)',4X,'YEX(1)',6X,'PER1',
     1                     5X,'Y(20)',3X,'YEX(20)',5X,'PER20',
     2                     4X,'PERMAX')
      RETURN
      END
      SUBROUTINE DERV
      COMMON /T/        T
      COMMON /Y/    Y(20)
      COMMON /F/ DYDT(20)
      COMMON /C/ BETA(20), U(20,20), B(20,20), N
      DIMENSION W(20)
C...
C...  CALCULATE THE ARRAY, W
      DO 10 I=1,N
      SUM = 0.0
      DO 20 J=1,N
      SUM = SUM + U(I,J)*Y(J)
  20  CONTINUE
      W(I) = SUM
  10  CONTINUE
C...
C...  CALCULATE THE N ODE DERIVATIVES
      DO 30 I=1,N
      SUM = 0.0
      DO 40 J=1,N
      SUM = SUM + U(I,J)*W(J)*W(J) - B(I,J)*Y(J)
  40  CONTINUE
      DYDT(I) = SUM
  30  CONTINUE
      RETURN
      END
      SUBROUTINE PRINT(NI,NO)
      COMMON /T/        T
      COMMON /Y/    Y(20)
      COMMON /F/ DYDT(20)
      COMMON /C/ BETA(20), U(20,20), B(20,20), N
      DIMENSION W(20), YEX(20)
C...
C...  ABSOLUTE DIMENSIONING OF THE ARRAYS REQUIRED BY SUBROUTINE JMAP
C...  (A, X, XOLD, F, FOLD) AND SUBROUTINE EIGEN (WI, WR, Z, RW, IW)
      REAL
     1           A(20,20), WR(20), WI(20), Z(20,20), RW(20),
     2                             X(20),  XOLD(20),
     3                             F(20),  FOLD(20)
      INTEGER                     IW(20)
C...
C...  THE FOLLOWING EQUIVALENCE FACILITATES TRANSFER OF THE DEPENDENT
C...  VARIABLE VECTOR IN /Y/ TO ARRAY Y, AND THE DERIVATIVE VECTOR IN
C...  IN /F/ TO ARRAY F FOR USE IN THE SUBSEQUENT CALL TO SUBROUTINE
C...  JMAP
      EQUIVALENCE (Y(1),X(1)),(DYDT(1),F(1))
C...
C...  CALCULATE THE N EXACT SOLUTIONS
      DO 10 J=1,N
      BETAT = BETA(J)*T
C...
C...  AVOID AN OVERFLOW OF THE EXPONENTIAL FUNCTION, EXP(BETAT), IN
C...  THE EXACT SOLUTION
      IF (BETAT.GT.200.) THEN
         W(J) = 0.0
C...
C...  AVOID AN UNDERFLOW OF THE EXPONENTIAL FUNCTION, EXP(BETAT), IN
C...  THE EXACT SOLUTION
      ELSE IF (BETAT.LT.-200.) THEN
         W(J) = BETA(J)
      ELSE
         W(J) = BETA(J)/(1.0 - (1.0 + BETA(J))*EXP(BETAT))
      END IF
  10  CONTINUE
      DO 20 I=1,N
      SUM = 0.0
      DO 30 J=1,N
      SUM = SUM + U(I,J)*W(J)
  30  CONTINUE
      YEX(I) = SUM
  20  CONTINUE
C...
C...  CALCULATE THE MAXIMUM ERROR
      ERRMAX = ABS((Y(1) - YEX(1))/YEX(1))*100.
      DO 40 J=2,N
      ERR = ABS((Y(J) - YEX(J))/YEX(J))*100.
      IF (ERR.GT.ERRMAX) ERRMAX = ERR
  40  CONTINUE
C...
C...  PRINT THE NUMERICAL AND EXACT SOLUTIONS FOR I = 1 AND N, AND
C...  THE CORRESPONDING ERRORS, AND THE MAXIMUM ERROR
      PER1=ABS((Y(1)-YEX(1))/YEX(1))*100.
      PERN=ABS((Y(N)-YEX(N))/YEX(N))*100.
      PERMAX=ERRMAX
      WRITE(NO,101)T,Y(1),YEX(1),PER1,Y(N),YEX(N),PERN,PERMAX
      IF (T.EQ.0.0) RETURN
 101  FORMAT(/,5X,E12.3,7F10.4)
C...
C...  MAP THE JACOBIAN MATRIX OF THE ODE SYSTEM DEFINED IN SUBROUTINE
C...  DERV, AND COMPUTE ITS TEMPORAL EIGENVALUES
      CALL JMAP(N,A,X,XOLD,F,FOLD)
C...
C...  SUBROUTINE EIGEN (PART OF DSS/2) CALLS A SERIES OF EISPACK ROU-
C...  TINES TO COMPUTE THE TEMPORAL EIGENVALUES, AND OPTIONALLY, THE
C...  EIGENVECTORS OF THE 20-ODE SYSTEM JACOBIAN MATRIX
      CALL EIGEN(N,A,WR,WI,Z,RW,IW)
      RETURN
      END
KROGH PROBLEM FOR N = 20, NONSTIFF CASE
0.        1.0       0.1
   2010000    1    1  REL 0.0001
   20
-1.
-2.
-3.
-4.
-5.
-6.
-7.
-8.
-9.
-10.
-11.
-12.
-13.
-14.
-15.
-16.
-17.
-18.
-19.
-20.
KROGH PROBLEM FOR N = 20, STIFF CASE
0.00001   10000.    0.00001
   2010000    1    1  REL 0.0001
   20
1000.
1000.
1000.
1000.
1000.
1000.
-1000.
-1000.
-1000.
-1000.
-1000.
-1000.
10.
10.
-10.0
-10.0
0.001
0.001
-0.001
-0.001
END OF RUNS
*APP MATH48
      SUBROUTINE INITAL
C...
C...  BANDWIDTH REDUCTION IN THE NUMERICAL METHOD OF LINES INTEGRATION
C...  OF PARTIAL DIFFERENTIAL EQUATIONS
C...
C...  THE FOLLOWING CODING ILLUSTRATES SOME APPROACHES TO REDUCING THE
C...  BANDWIDTH OF THE ODE JACOBIAN MATRIX IN THE NUMERICAL METHOD OF
C...  LINES INTEGRATION OF PDES.  THIS IS AN EXAMPLE OF GENERALLY
C...  ATTEMPTING TO MANIPULATE THE ODE JACOBIAN MATRIX EFFICIENTLY
C...  WHICH IS PARTICULARLY WORTHWHILE WHEN INTEGRATING STIFF ODES.
C...
C...  TO EXPLAIN A BIT FURTHER, STIFF (IMPLICIT) ODE INTEGRATORS
C...  REQUIRE THE SOLUTION OF SIMULATENOUS NONLINEAR ALGEBRAIC
C...  EQUATIONS TO COMPUTE THE DEPENDENT VARIABLE VECTOR (SOLUTION
C...  OF THE ODES) AT THE NEXT VALUE OF THE INDEPENDENT VARIABLE.
C...  THUS, A MULTIDIMENSIONAL ROOT FINDER MUST BE USED, TYPICALLY
C...  NEWTON'S METHOD.  THIS IN TURN MEANS THAT A SYSTEM OF LINEAR
C...  ALGEBRAIC EQUATIONS MUST BE SOLVED ITERATIVELY UNTIL SOME
C...  MEASURE OF CONVERGENCE TO THE SOLUTION OF THE NONLINEAR EQUATIONS
C...  IS ACHIEVED.  THE ITERATIVE SOLUTION OF THE LINEAR ALGEBRAIC
C...  EQUATIONS IS THE MAJOR PART OF THE COMPUTATIONAL EFFORT IN USING
C...  AN IMPLICIT INTEGRATOR, AND THEREFORE THIS LINEAR ALGEBRA MUST
C...  BE DONE EFFICIENTLY, PARTICULARLY FOR LARGE SYSTEMS OF ODES.
C...
C...  GENERALLY, DOING LINEAR ALGEBRA EFFICIENTLY MEANS EXPLOITING THE
C...  STRUCTURE OF THE COEFFICIENT MATRIX TO AVOID THE N**3 OPERATIONS
C...  COUNT OF A FULL ROW REDUCTION (N IS THE NUMBER OF FIRST ORDER ODES
C...  AND THEREFORE THE NUMBER OF LINEAR ALGEBRAIC EQUATIONS).
C...
C...  IN PARTICULAR, WHEN INTEGRATING PDES BY THE NUMERICAL METHOD OF
C...  LINES, THE ODE JACOBIAN MATRIX IS FREQUENTLY BANDED, BUT THE
C...  BANDWIDTH MAY BE LARGE, DEPENDING ON THE NUMBER OF PDES, THEIR
C...  STRUCTURE AND COUPLING.  IF THE LINEAR ALGEBRA IS DONE BY A DIRECT
C...  METHOD, AND IS STRUCTURED FOR THE BAND (DOES NOT USE THE ZERO
C...  ELEMENTS OUTSIDE THE BAND), THE OPERATIONS COUNT IS NM**2, WHERE
C...  M IS THE BANDWIDTH.  THIS REPRESENTS A MAJOR REDUCTION IN THE
C...  NUMBER OF OPERATIONS FOR LARGE N AND SMALL M RELATIVE TO A FULL
C...  MATRIX (N**3) ALGORITHM.  FOR EXAMPLE, IF N = 1000, M = 20, A
C...  FULL ROW REDUCTION WOULD REQUIRE 1000**3 = 1.0E+09 ARITHMETIC
C...  OPERATIONS (FOR A 1 MFLOPS MACHINE, OR ONE MILLION FLOATING
C...  OPERATIONS/SEC, THIS CALCULATION WOULD REQUIRE 1000 SECONDS, AND
C...  THE LINEAR ALGEBRA WOULD HAVE TO BE DONE MANY TIMES TO COMPUTE
C...  THE COMPLETE ODE SOLUTION).  FOR A BAND-STRUCTURE ALGORITHM, THE
C...  OPERATIONS COUNT IS 1000*(20**2) = 4.0E+05 OR 1/2500 OF THE
C...  OPERATIONS FOR A FULL MATRIX CALCULATION.  CLEARLY, THE BAND
C...  ALGORITHM IS VERY EFFECTIVE IN REDUCING THE COMPUTATIONAL EFFORT,
C...  AND THIS EFFICIENCY INCREASES WITH INCREASING N AND DECREASING M.
C...
C...  IN OTHER WORDS, ANY PROCEDURE WHICH REDUCES M IS WORTH PURSUING.
C...  TO THIS END, WE CONSIDER A STRAIGHTFORWARD PROCEDURE FOR REDUCING
C...  M IN THE NUMERICAL METHOD OF LINES INTEGRATION OF SIMULTANEOUS
C...  PDES.  THIS PROCEDURE IS ILLUSTRATED IN THE FOLLOWING CODING FOR
C...  THE METHOD OF LINES INTEGRATION OF NINE SIMULATENOUS, FIRST ORDER,
C...  LINEAR, HYPERBOLIC PDES, PROGRAMMED IN THREE DIFFERENT WAYS:
C...
C...     (1)  THE SPATIAL GRID FOR EACH PDE IS ADJACENT TO THE GRIDS
C...     FOR TWO OTHER PDES.  FOR EXAMPLE, IF THE DEPENDENT VARIABLES OF
C...     THREE PDES ARE T1(X,T), T2(X,T) AND T3(X,T), AND THE CORRES-
C...     PONDING ARRAYS ON AN 11-POINT GRID IN X ARE T1(11), T2(11) AND
C...     T3(11), THESE ARRAYS COULD BE PUT IN COMMON AS:
C...
C...        COMMON/Y/ T1(11), T2(11), T3(11)
C...
C...     IN MEMORY, THE ELEMENTS OF THE ARRAYS ARE ARRANGED AS:
C...
C...     T1(1), T1(2),..., T1(11), T2(1), T2(2),..., T2(11), T3(1),...
C...
C...     THIS ARRANGEMENT WHICH IS IMPLEMENTED IN SUBROUTINES INIT1,
C...     DERV1 AND PRINT1, CALLED IN THE FIRST RUN (WITH NORUN = 1),
C...     LEADS TO A RELATIVELY WIDE BAND (LARGE M).  THE ODE JACOBIAN
C...     MATRIX IN MAPPED FOR THIS CASE, BY A CALL TO SUBROUTINE JMAP
C...     IN SUBROUTINE PRINT1, TO DEMONSTRATE THE STRUCTURE OF THE
C...     MATRIX.  ADDITIONALLY, THE EIGENVALUES OF THE JACOBIAN MATRIX
C...     ARE CALCULATED BY A CALL TO SUBROUTINE EIGEN, AND THE NUMERI-
C...     CAL METHOD OF LINES SOLUTION IS THEN COMPUTED.
C...
C...     (2)  THE SPATIAL GRIDS FOR THE PDES ARE INTERLEAVED, WITH
C...     THE DEPENDENT VARIABLES AT A GIVEN VALUE OF THE SPATIAL
C...     INDEPENDENT VARIABLE PLACED IN ADJACENT POSITIONS.  AGAIN,
C...     FOR THE ARRAYS T1(11), T2(11), T3(11), THE ELEMENTS ARE
C...     ARRANGED AS:
C...
C...     T1(1), T2(1), T3(1), T1(2), T2(2), T3(2),..., T3(11)
C...
C...     THIS ARRANGEMENT, WHICH IS IMPLEMENTED IN SUBROUTINES INIT2,
C...     DERV2 AND PRINT2, CALLED IN THE SECOND RUN (NORUN = 2),
C...     LEADS TO A NARROWER JACOBIAN MATRIX BANDWIDTH THAN CASE (1).
C...     AGAIN, THE MATRIX IS MAPPED TO DEMONSTRATE THIS BANDWIDTH
C...     REDUCTION, AND THE EIGENVALUES AND SOLUTION ARE COMPUTED TO
C...     DEMONSTRATE THAT THEY REMAIN ESSENTIALLY UNCHANGED (SLIGHT
C...     VARIATIONS IN THE NUMERICAL OUTPUT MIGHT BE OBSERVED DUE
C...     TO THE REARRANGED ODES).
C...
C...     (3)  A VARIATION ON CASE (2) WHICH CAN BEST BE UNDERSTOOD BY
C...     STUDYING THE CODE IN SUBROUTINES INIT3, DERV3 AND PRIN3, CALLED
C...     IN THE THIRD RUN (NORUN = 3).  THIS THIRD ARRANGEMENT DID NOT
C...     PRODUCE MUCH OF AN IMPROVEMENT (REDUCTION IN THE BANDWIDTH, M)
C...     OVER CASE (2).
C...
C...  THE USE OF THE SECOND APPROACH, (2) ABOVE, IS RECOMMENDED WHEN
C...  PROGRAMMING A METHOD OF LINES INTEGRATION OF A SYSTEM OF PDES,
C...  AND THE RESULTING ODES ARE TO BE INTEGRATED BY AN IMPLICIT
C...  (STIFF) INTEGRATOR WITH A BANDED JACOBIAN MATRIX FACILITY, E.G.,
C...  LSODE, DASSL.
C...
C...  THIS PROCEDURE IS BASED ON INTUITION AND EXPERIENCE, AND HAS
C...  PROVEN TO BE EFFECTIVE.  HOWEVER, IT IS NOT VERY GENERAL, E.G.,
C...  IT IS NOT CLEAR WHAT TO DO WITH TWO AND THREE-DIMENSIONAL PDES.
C...  MAPPING THE ODE JACOBIAN MATRIX MIGHT SUGGEST A PROCEDURE FOR
C...  REDUCING THE MATRIX BANDWIDTH.  ALTERNATIVELY, A BANDWIDTH
C...  REDUCTION ALGORITHM COULD BE APPLIED TO THE MATRIX WHICH WOULD
C...  AUTOMATICALLY REORDER THE ODES TO ACHIEVE BANDWIDTH REDUCTION.
C...  THE LATTER (USE OF BANDWIDTH REDUCTION ALGORITHMS) APPEARS TO
C...  OFFER THE BEST POSSIBILITY FOR A GENERAL APPROACH TO PDE PROBLEMS.
C...
C...  THE FOLLOWING CODING, IN SUBROUTINES INITAL, DERV AND PRINT,
C...  SELECTS SUBROUTINE INIT1, DERV1 AND PRINT1 FOR CASE (1) ABOVE
C...  (NORUN = 1), INIT2, DERV2 AND PRINT2 FOR CASE (2) (NORUN = 2)
C...  INIT3, DERV3 AND PRINT3 FOR CASE (3) (NORUN = 3).  THE PDE PROB-
C...  LEM IS DESCRIBED IN DETAIL IN SUBROUTINES INIT1, INIT2 AND INIT3
C...  (THE SAME DESCRIPTION, REPEATED THREE TIMES).
C...
C...  ALSO, THE ORDERING OF THE ODES ACCORDING TO CASES (1), (2) AND
C...  (3) CAN BEST BE UNDERSTOOD BY STUDYING THE CODING IN SUBROUTINES
C...  DERV1, DERV2 AND DERV3.  THE MAPPING OF THE RESULTING ODE JACOBIAN
C...  MATRIX, AND THE CALCULATION OF THE ASSOCIATED EIGENVALUES, IS
C...  PROGRAMMED IN SUBROUTINES PRINT1, PRINT2 AND PRINT3 VIA CALLS
C...  TO SUBROUTINES JMAP AND EIGEN, RESPECTIVELY.
C...
C...  THE FOLLOWING COMMON PROVIDES NORUN
      COMMON/T/
     1       TIME,     NSTOP,     NORUN
C...
C...  SELECT THE INITIAL CONDITION SUBROUTINE, INIT1, INIT2 OR INIT3
      IF(NORUN.EQ.1)THEN
         CALL INIT1
      ELSE IF(NORUN.EQ.2)THEN
         CALL INIT2
      ELSE IF(NORUN.EQ.3)THEN
         CALL INIT3
      END IF
      RETURN
      END
      SUBROUTINE DERV
      COMMON/T/
     1       TIME,     NSTOP,     NORUN
C...
C...  SELECT THE DERIVATIVE SUBROUTINE, DERV1, DERV2 OR DERV3
      IF(NORUN.EQ.1)THEN
         CALL DERV1
      ELSE IF(NORUN.EQ.2)THEN
         CALL DERV2
      ELSE IF(NORUN.EQ.3)THEN
         CALL DERV3
      END IF
      RETURN
      END
      SUBROUTINE PRINT(NI,NO)
      COMMON/T/
     1       TIME,     NSTOP,     NORUN
C...
C...  SELECT THE PRINT SUBROUTINE, PRINT1, PRINT2 OR PRINT3
      IF(NORUN.EQ.1)THEN
         CALL PRINT1(NI,NO)
      ELSE IF(NORUN.EQ.2)THEN
         CALL PRINT2(NI,NO)
      ELSE IF(NORUN.EQ.3)THEN
         CALL PRINT3(NI,NO)
      END IF
      RETURN
      END
      SUBROUTINE INIT1
C...
C...  DYNAMIC MODEL OF A FOUR-PASS SHELL AND TUBE HEAT EXCHANGER WITH
C...  MAPPING OF THE MODEL JACOBIAN MATRIX
C...
C...  A HEAT EXCHANGER IS A DISTRIBUTED SYSTEM IN WHICH CONVECTION AND
C...  TRANSFER OF HEAT ALONG THE EXCHANGER ARE THE PRINCIPAL MODES OF
C...  OPERATION.  THUS THE SPATIAL DISTRIBUTION OF TEMPERATURE WITHIN
C...  THE EXCHANGER MUST BE TAKEN INTO ACCOUNT IN A REALISTIC ANALYSIS.
C...  IF THE TRANSIENT OPERATION OF AN EXCHANGER IS ALSO TO BE CON-
C...  SIDERED, THE MATHEMATICAL MODEL MUST NECESSARILY INVOLVE SPACE
C...  AND TIME, I.E., THE MODEL IS EXPRESSED IN TERMS OF PDES.  ALSO,
C...  MIXING IN THE HEADERS OF THE EXCHANGER (THE ENTRANCE CHAMBER FOR
C...  EACH TUBE PASS) IS MODELED BY ODES WHICH SERVE AS BOUNDARY CON-
C...  DITIONS FOR THE PDES.  THE ANALYSIS OF EXPERIMENTAL DATA FOR HEAT
C...  EXCHANGERS HAS INDICATED THAT THE MIXING IN THE HEADERS CANNOT BE
C...  NEGLECTED AND THUS A MIXED ODE/PDE MODEL IS REQUIRED.  TO ILLUS-
C...  TRATE SOME OF THESE CONCEPTS, CONSIDER THE FOLLOWING SYSTEM OF
C...  NINE PDES AND FIVE PDES FOR A FOUR-PASS, SHELL AND TUBE HEAT
C...  EXCHANGER (SUBSCRIPTS T AND X DENOTE PARTIAL DERIVATIVES WITH
C...  RESPECT TO T AND X, RESPECTIVELY)
C...
C...                   T1  = -C1*T1  + C3*(T5 - T1)                  (1)
C...                     T         X
C...
C...                   T2  =  C1*T2  + C3*(T6 - T2)                  (2)
C...                     T         X
C...
C...                   T3  = -C1*T3  + C3*(T7 - T3)                  (3)
C...                     T         X
C...
C...                   T4  =  C1*T4  + C3*(T8 - T4)                  (4)
C...                     T         X
C...
C...                T5  = C4*(T1 - T5) + C5*(T9 - T5)                (5)
C...                  T
C...
C...                T6  = C4*(T2 - T6) + C5*(T9 - T6)                (6)
C...                  T
C...
C...                T7  = C4*(T3 - T7) + C5*(T9 - T7)                (7)
C...                  T
C...
C...                T8  = C4*(T4 - T8) + C5*(T9 - T8)                (8)
C...                  T
C...
C...           T9  = -C2*T9  + C6*((T5 - T9) + (T6 - T9) +
C...             T         X                                         (9)
C...                               (T7 - T9) + (T8 - T9))
C...
C...  THE NINE DEPENDENT VARIABLES, T1(X,T), T2(X,T), ..., T9(X,T) ARE
C...  TO BE COMPUTED.  C1, C2. ..., C6 ARE GIVEN NUMERICAL CONSTANTS
C...  WHICH REFLECT THE THERMAL CAPACITANCES OF THE LIQUIDS FLOWING
C...  THROUGH THE EXCHANGER, THE THERMAL CAPACITANCE OF THE METAL IN
C...  THE EXCHANGER TUBES AND THE HEAT TRANSFER CHARACTERISTICS.  EQUA-
C...  TIONS (1) TO (4) AND (9) EACH REQUIRE A BOUNDARY CONDITION IN X
C...  AND ALL NINE EQUATIONS REQUIRE AN INITIAL CONDITION IN T.  THESE
C...  WILL BE TAKEN AS
C...
C...                 DT1(0,T)/DT = B1*(TI - T1(0,T))                (10)
C...
C...              DT2(L,T)/DT = B2*(T1(L,T) - T2(L,T))              (11)
C...
C...              DT3(0,T)/DT = B2*(T2(0,T) - T3(0,T))              (12)
C...
C...              DT4(L,T)/DT = B2*(T3(L,T) - T4(L,T))              (13)
C...
C...                           T9(0,T) = TSI                        (14)
C...
C...             T1(X,0) = T2(X,0) = T3(X,0) = T4(X,0) =
C...
C...             T5(X,0) = T6(X,0) = T7(X,0) = T8(X,0) =            (15)
C...
C...                            T9(X,0) = 0
C...
C...  FINALLY, ONE ORDINARY DIFFERENTIAL EQUATION WILL BE ADDED TO MODEL
C...  THE MIXING IN THE HEADER AT THE EXIT OF THE FOURTH PASS
C...
C...                    DT0/DT = B1*(T4(0,T) - T0)                  (16)
C...
C...                             T0(0) = 0                          (17)
C...
C...  EQUATIONS (1) TO (17) CONSTITUTE THE COMPLETE SYSTEM (NINE PDES
C...  AND FIVE ODES).  L, B1 AND B2 ARE THE EXCHANGER LENGTH AND MIXING
C...  TIME CONSTANTS FOR THE HEADERS, RESPECTIVELY.  TI AND TSI ARE THE
C...  ENTERING TEMPERATURES OF THE TUBE SIDE AND SHELL SIDE FLUIDS,
C...  RESPECTIVELY.
C...
C...  THE SOLUTION OF EQUATIONS (1) TO (17) IS BASED ON THE APPROXI-
C...  MATION OF THE DERIVATIVES IN X IN EQUATIONS (1) TO (4) AND (9)
C...  OVER A GRID OF 11 POINTS.  AN APPROXIMATING ODE IS WRITTEN FOR
C...  EACH GRID POINT FOR EACH PDE.  THUS THERE WILL BE A TOTAL OF 11*9
C...  = 99 ODES APPROXIMATING EQUATIONS (1) TO (9).  FINALLY, EQUATION
C...  (16) BRINGS THE TOTAL ODES TO 100.
C...
C...  IN ORDER TO GAIN A PICTURE OF THE 100-ODE SYSTEM STRUCTURE, THE
C...  FOLLOWING PROGRAM ALSO CALLS SUBROUTINES JMAP AND EIGEN TO MAP THE
C...  100-ODE SYSTEM JACOBIAN MATRIX AND COMPUTE THE TEMPORAL EIGEN-
C...  VALUES, RESPECTIVELY.
C...
      COMMON/T/
     1       TIME,     NSTOP,     NORUN
     2      /Y/
     3     T1(11),    T2(11),    T3(11),    T4(11),    T5(11),
     4     T6(11),    T7(11),    T8(11),    T9(11),        T0
     5      /F/
     6    T1T(11),   T2T(11),   T3T(11),   T4T(11),   T5T(11),
     7    T6T(11),   T7T(11),   T8T(11),   T9T(11),       T0T
     8      /S/
     9    T1X(11),   T2X(11),   T3X(11),   T4X(11),   T9X(11)
      COMMON/C/
     1         XL,        C1,        C2,        C3,        C4,
     2         C5,        C6,        B1,        B2,        TI,
     3        TSI,        NG,         N
C...
C...  INITIALIZE THE PROBLEM SYSTEM PARAMETERS
C...
C...  MODEL CONSTANTS
      XL=12.0E+00
      C1=1.98E+00
      C2=0.3E+00
      C3=0.13E+00
      C4=0.476E+00
      C5=0.434E+00
      C6=0.00963E+00
      B1=0.588E+00
      B2=0.294E+00
      TI=10.0E+00
      TSI=0.0E+00
      NG=11
      N=100
C...
C...  INITIAL CONDITIONS
      DO 1 I=1,NG
      T1(I)=0.0E+00
      T2(I)=0.0E+00
      T3(I)=0.0E+00
      T4(I)=0.0E+00
      T5(I)=0.0E+00
      T6(I)=0.0E+00
      T7(I)=0.0E+00
      T8(I)=0.0E+00
      T9(I)=0.0E+00
1     CONTINUE
      T0=0.0E+00
      RETURN
      END
      SUBROUTINE DERV1
      COMMON/T/
     1       TIME,     NSTOP,     NORUN
     2      /Y/
     3     T1(11),    T2(11),    T3(11),    T4(11),    T5(11),
     4     T6(11),    T7(11),    T8(11),    T9(11),        T0
     5      /F/
     6    T1T(11),   T2T(11),   T3T(11),   T4T(11),   T5T(11),
     7    T6T(11),   T7T(11),   T8T(11),   T9T(11),       T0T
     8      /S/
     9    T1X(11),   T2X(11),   T3X(11),   T4X(11),   T9X(11)
      COMMON/C/
     1         XL,        C1,        C2,        C3,        C4,
     2         C5,        C6,        B1,        B2,        TI,
     3        TSI,        NG,         N
C...
C...
C...  SET BOUNDARY CONDITION (14)
      T9(1)=TSI
C...
C...  COMPUTE THE FIRST DERIVATIVES WITH RESPECT TO X BY FIVE-POINT
C...  BIASED UPWIND APPROXIMATIONS
      CALL DSS020(0.0E+00,XL,NG,T1,T1X, 1.0E+00)
      CALL DSS020(0.0E+00,XL,NG,T2,T2X,-1.0E+00)
      CALL DSS020(0.0E+00,XL,NG,T3,T3X, 1.0E+00)
      CALL DSS020(0.0E+00,XL,NG,T4,T4X,-1.0E+00)
      CALL DSS020(0.0E+00,XL,NG,T9,T9X, 1.0E+00)
C...
C...  ASSEMBLE THE PDES, EQUATIONS (1) TO (9)
      DO 1 I=1,NG
      T1T(I)=-C1*T1X(I) + C3*(T5(I)-T1(I))
      T2T(I)= C1*T2X(I) + C3*(T6(I)-T2(I))
      T3T(I)=-C1*T3X(I) + C3*(T7(I)-T3(I))
      T4T(I)= C1*T4X(I) + C3*(T8(I)-T4(I))
      T5T(I)=             C4*(T1(I)-T5(I))
     1                  + C5*(T9(I)-T5(I))
      T6T(I)=             C4*(T2(I)-T6(I))
     1                  + C5*(T9(I)-T6(I))
      T7T(I)=             C4*(T3(I)-T7(I))
     1                  + C5*(T9(I)-T7(I))
      T8T(I)=             C4*(T4(I)-T8(I))
     1                  + C5*(T9(I)-T8(I))
      T9T(I)=-C2*T9X(I) - 4.0E+00*C6*T9(I)
     1                  + C6*(T5(I)+T6(I)+T7(I)+T8(I))
1     CONTINUE
C...
C...  EVALUATE THE ODE DERIVATIVES FROM EQUATIONS (10) AND (13) AND
C...  EQUATION (16).  NOTE THAT THESE DERIVATIVES MUST BE COMPUTED
C...  AFTER THOSE FOR THE PDES
      T1T( 1)=B1*(    TI-T1( 1))
      T2T(NG)=B2*(T1(NG)-T2(NG))
      T3T( 1)=B2*(T2( 1)-T3( 1))
      T4T(NG)=B2*(T3(NG)-T4(NG))
      T9T( 1)=0.0E+00
      T0T    =B1*(T4( 1)-    T0)
      RETURN
      END
      SUBROUTINE PRINT1(NI,NO)
      COMMON/T/
     1       TIME,     NSTOP,     NORUN
     2      /Y/
     3     T1(11),    T2(11),    T3(11),    T4(11),    T5(11),
     4     T6(11),    T7(11),    T8(11),    T9(11),        T0
     5      /F/
     6    T1T(11),   T2T(11),   T3T(11),   T4T(11),   T5T(11),
     7    T6T(11),   T7T(11),   T8T(11),   T9T(11),       T0T
     8      /S/
     9    T1X(11),   T2X(11),   T3X(11),   T4X(11),   T9X(11)
      COMMON/C/
     1         XL,        C1,        C2,        C3,        C4,
     2         C5,        C6,        B1,        B2,        TI,
     3        TSI,        NG,         N
C...
C...  THIS SECTION OF SUBROUTINE PRINT
C...
C...     (1)  CALLS SUBROUTINE JMAP TO MAP THE JACOBIAN MATRIX OF
C...          100-ODE SYSTEM.
C...
C...     (2)  CALLS A SERIES OF EISPACK ROUTINES VIA SUBROUTINE EIGEN
C...          TO COMPUTE THE TEMPORAL EIGENVALUES OF THE ODE SYSTEM,
C...          AND OPTIONALLY, THE ASSOCIATED EIGENVECTORS.
C...
C...  ABSOLUTE DIMENSIONING OF THE ARRAYS REQUIRED BY SUBROUTINE JMAP
C...  (A, Y, YOLD, F, FOLD) AND SUBROUTINE EIGEN (WI, WR, Z, RW, IW)
      REAL
     1       A(100,100), WR(100), WI(100), Z(100,100), RW(100),
     2                             Y(100),  YOLD(100),
     3                             F(100),  FOLD(100)
      INTEGER                     IW(100)
C...
C...  THE FOLLOWING EQUIVALENCE FACILITATES TRANSFER OF THE DEPENDENT
C...  VARIABLE VECTOR IN /Y/ TO ARRAY Y, AND THE DERIVATIVE VECTOR IN
C...  IN /F/ TO ARRAY F FOR USE IN THE SUBSEQUENT CALL TO SUBROUTINE
C...  JMAP
      EQUIVALENCE (T1(1),Y(1)),(T1T(1),F(1))
C...
C...  MAP THE JACOBIAN MATRIX OF THE ODE SYSTEM DEFINED IN SUBROUTINE
C...  DERV, AND COMPUTE ITS TEMPORAL EIGENVALUES
      IF(TIME.GT.1.0E+00)GO TO 5
      CALL JMAP(N,A,Y,YOLD,F,FOLD)
C...
C...  SUBROUTINE EIGEN (PART OF DSS/2) CALLS A SERIES OF EISPACK ROU-
C...  TINES TO COMPUTE THE TEMPORAL EIGENVALUES, AND OPTIONALLY, THE
C...  EIGENVECTORS OF THE 100-ODE SYSTEM JACOBIAN MATRIX
      CALL EIGEN(N,A,WR,WI,Z,RW,IW)
C...
C...  PRINT A HEADING FOR THE NUMERICAL SOLUTION
      WRITE(NO,3)
3     FORMAT(1H1,9X,50HMIXED ORDINARY/PARTIAL DIFFERENTIAL EQUATION MODE
     1L,/)
      WRITE(NO,1)C1,C2,C3,C4
1     FORMAT(
     13X,4HC1 = ,E10.3,3X,4HC2 = ,E10.3,3X,4HC3 = ,E10.3,
     23X,4HC4 = ,E10.3)
      WRITE(NO,2)C5,C6,B1,B2
2     FORMAT(
     13X,4HC5 = ,E10.3,3X,4HC6 = ,E10.3,3X,4HB1 = ,E10.3,
     23X,4HB2 = ,E10.3,//)
      WRITE(NO,4)
4     FORMAT(
     1 6X,4HTIME,7X,7HT1(X=0),7X,8HT4(X=12),8X,2HT0,10X,
     2 8HT9(X=12))
C...
C...  PRINT THE SOLUTION
5     WRITE(NO,6)TIME,T1(1),T4(NG),T0,T9(NG)
6     FORMAT(E12.3,4E14.5)
      RETURN
      END
      SUBROUTINE INIT2
C...
C...  DYNAMIC MODEL OF A FOUR-PASS SHELL AND TUBE HEAT EXCHANGER WITH
C...  MAPPING OF THE MODEL JACOBIAN MATRIX
C...
C...  A HEAT EXCHANGER IS A DISTRIBUTED SYSTEM IN WHICH CONVECTION AND
C...  TRANSFER OF HEAT ALONG THE EXCHANGER ARE THE PRINCIPAL MODES OF
C...  OPERATION.  THUS THE SPATIAL DISTRIBUTION OF TEMPERATURE WITHIN
C...  THE EXCHANGER MUST BE TAKEN INTO ACCOUNT IN A REALISTIC ANALYSIS.
C...  IF THE TRANSIENT OPERATION OF AN EXCHANGER IS ALSO TO BE CON-
C...  SIDERED, THE MATHEMATICAL MODEL MUST NECESSARILY INVOLVE SPACE
C...  AND TIME, I.E., THE MODEL IS EXPRESSED IN TERMS OF PDES.  ALSO,
C...  MIXING IN THE HEADERS OF THE EXCHANGER (THE ENTRANCE CHAMBER FOR
C...  EACH TUBE PASS) IS MODELED BY ODES WHICH SERVE AS BOUNDARY CON-
C...  DITIONS FOR THE PDES.  THE ANALYSIS OF EXPERIMENTAL DATA FOR HEAT
C...  EXCHANGERS HAS INDICATED THAT THE MIXING IN THE HEADERS CANNOT BE
C...  NEGLECTED AND THUS A MIXED ODE/PDE MODEL IS REQUIRED.  TO ILLUS-
C...  TRATE SOME OF THESE CONCEPTS, CONSIDER THE FOLLOWING SYSTEM OF
C...  NINE PDES AND FIVE PDES FOR A FOUR-PASS, SHELL AND TUBE HEAT
C...  EXCHANGER (SUBSCRIPTS T AND X DENOTE PARTIAL DERIVATIVES WITH
C...  RESPECT TO T AND X, RESPECTIVELY)
C...
C...                   T1  = -C1*T1  + C3*(T5 - T1)                  (1)
C...                     T         X
C...
C...                   T2  =  C1*T2  + C3*(T6 - T2)                  (2)
C...                     T         X
C...
C...                   T3  = -C1*T3  + C3*(T7 - T3)                  (3)
C...                     T         X
C...
C...                   T4  =  C1*T4  + C3*(T8 - T4)                  (4)
C...                     T         X
C...
C...                T5  = C4*(T1 - T5) + C5*(T9 - T5)                (5)
C...                  T
C...
C...                T6  = C4*(T2 - T6) + C5*(T9 - T6)                (6)
C...                  T
C...
C...                T7  = C4*(T3 - T7) + C5*(T9 - T7)                (7)
C...                  T
C...
C...                T8  = C4*(T4 - T8) + C5*(T9 - T8)                (8)
C...                  T
C...
C...           T9  = -C2*T9  + C6*((T5 - T9) + (T6 - T9) +
C...             T         X                                         (9)
C...                               (T7 - T9) + (T8 - T9))
C...
C...  THE NINE DEPENDENT VARIABLES, T1(X,T), T2(X,T), ..., T9(X,T) ARE
C...  TO BE COMPUTED.  C1, C2. ..., C6 ARE GIVEN NUMERICAL CONSTANTS
C...  WHICH REFLECT THE THERMAL CAPACITANCES OF THE LIQUIDS FLOWING
C...  THROUGH THE EXCHANGER, THE THERMAL CAPACITANCE OF THE METAL IN
C...  THE EXCHANGER TUBES AND THE HEAT TRANSFER CHARACTERISTICS.  EQUA-
C...  TIONS (1) TO (4) AND (9) EACH REQUIRE A BOUNDARY CONDITION IN X
C...  AND ALL NINE EQUATIONS REQUIRE AN INITIAL CONDITION IN T.  THESE
C...  WILL BE TAKEN AS
C...
C...                 DT1(0,T)/DT = B1*(TI - T1(0,T))                (10)
C...
C...              DT2(L,T)/DT = B2*(T1(L,T) - T2(L,T))              (11)
C...
C...              DT3(0,T)/DT = B2*(T2(0,T) - T3(0,T))              (12)
C...
C...              DT4(L,T)/DT = B2*(T3(L,T) - T4(L,T))              (13)
C...
C...                           T9(0,T) = TSI                        (14)
C...
C...             T1(X,0) = T2(X,0) = T3(X,0) = T4(X,0) =
C...
C...             T5(X,0) = T6(X,0) = T7(X,0) = T8(X,0) =            (15)
C...
C...                            T9(X,0) = 0
C...
C...  FINALLY, ONE ORDINARY DIFFERENTIAL EQUATION WILL BE ADDED TO MODEL
C...  THE MIXING IN THE HEADER AT THE EXIT OF THE FOURTH PASS
C...
C...                    DT0/DT = B1*(T4(0,T) - T0)                  (16)
C...
C...                             T0(0) = 0                          (17)
C...
C...  EQUATIONS (1) TO (17) CONSTITUTE THE COMPLETE SYSTEM (NINE PDES
C...  AND FIVE ODES).  L, B1 AND B2 ARE THE EXCHANGER LENGTH AND MIXING
C...  TIME CONSTANTS FOR THE HEADERS, RESPECTIVELY.  TI AND TSI ARE THE
C...  ENTERING TEMPERATURES OF THE TUBE SIDE AND SHELL SIDE FLUIDS,
C...  RESPECTIVELY.
C...
C...  THE SOLUTION OF EQUATIONS (1) TO (17) IS BASED ON THE APPROXI-
C...  MATION OF THE DERIVATIVES IN X IN EQUATIONS (1) TO (4) AND (9)
C...  OVER A GRID OF 11 POINTS.  AN APPROXIMATING ODE IS WRITTEN FOR
C...  EACH GRID POINT FOR EACH PDE.  THUS THERE WILL BE A TOTAL OF 11*9
C...  = 99 ODES APPROXIMATING EQUATIONS (1) TO (9).  FINALLY, EQUATION
C...  (16) BRINGS THE TOTAL ODES TO 100.
C...
C...  IN ORDER TO GAIN A PICTURE OF THE 100-ODE SYSTEM STRUCTURE, THE
C...  FOLLOWING PROGRAM ALSO CALLS SUBROUTINES JMAP AND EIGEN TO MAP THE
C...  100-ODE SYSTEM JACOBIAN MATRIX AND COMPUTE THE TEMPORAL EIGEN-
C...  VALUES, RESPECTIVELY.
C...
      COMMON/T/
     1       TIME,     NSTOP,     NORUN
     2      /Y/
     3     T1(11),    T2(11),    T3(11),    T4(11),    T5(11),
     4     T6(11),    T7(11),    T8(11),    T9(11),        T0
     5      /F/
     6    T1T(11),   T2T(11),   T3T(11),   T4T(11),   T5T(11),
     7    T6T(11),   T7T(11),   T8T(11),   T9T(11),       T0T
     8      /S/
     9    T1X(11),   T2X(11),   T3X(11),   T4X(11),   T9X(11)
      COMMON/C/
     1         XL,        C1,        C2,        C3,        C4,
     2         C5,        C6,        B1,        B2,        TI,
     3        TSI,        NG,         N
C...
C...  INITIALIZE THE PROBLEM SYSTEM PARAMETERS
C...
C...  MODEL CONSTANTS
      XL=12.0E+00
      C1=1.98E+00
      C2=0.3E+00
      C3=0.13E+00
      C4=0.476E+00
      C5=0.434E+00
      C6=0.00963E+00
      B1=0.588E+00
      B2=0.294E+00
      TI=10.0E+00
      TSI=0.0E+00
      NG=11
      N=100
C...
C...  INITIAL CONDITIONS
      DO 1 I=1,NG
      T1(I)=0.0E+00
      T2(I)=0.0E+00
      T3(I)=0.0E+00
      T4(I)=0.0E+00
      T5(I)=0.0E+00
      T6(I)=0.0E+00
      T7(I)=0.0E+00
      T8(I)=0.0E+00
      T9(I)=0.0E+00
1     CONTINUE
      T0=0.0E+00
      RETURN
      END
      SUBROUTINE DERV2
      COMMON/T/
     1       TIME,     NSTOP,     NORUN
     2      /Y/
     3     Y(100)
     5      /F/
     6     F(100)
     8      /S/
     9    T1X(11),   T2X(11),   T3X(11),   T4X(11),   T9X(11)
      COMMON/C/
     1         XL,        C1,        C2,        C3,        C4,
     2         C5,        C6,        B1,        B2,        TI,
     3        TSI,        NG,         N
      COMMON/A/
     3     T1(11),    T2(11),    T3(11),    T4(11),    T5(11),
     4     T6(11),    T7(11),    T8(11),    T9(11),        T0
      COMMON/B/
     6    T1T(11),   T2T(11),   T3T(11),   T4T(11),   T5T(11),
     7    T6T(11),   T7T(11),   T8T(11),   T9T(11),       T0T
C...
C...  ******************************************************************
C...  TRANSLATE THE DEPENDENT VARIABLE VECTOR X IN COMMON/Y/ TO THE
C...  PROBLEM DEPENDENT VARIABLES
      J=0
      DO 10 I=1,NG
      J=J+1
      T1(I)=Y(J)
      J=J+1
      T2(I)=Y(J)
      J=J+1
      T3(I)=Y(J)
      J=J+1
      T4(I)=Y(J)
      J=J+1
      T5(I)=Y(J)
      J=J+1
      T6(I)=Y(J)
      J=J+1
      T7(I)=Y(J)
      J=J+1
      T8(I)=Y(J)
      J=J+1
      T9(I)=Y(J)
10    CONTINUE
      J=J+1
      T0=Y(J)
C...  ******************************************************************
C...
C...  SET BOUNDARY CONDITION (14)
      T9(1)=TSI
C...
C...  COMPUTE THE FIRST DERIVATIVES WITH RESPECT TO X BY FIVE-POINT
C...  BIASED UPWIND APPROXIMATIONS
      CALL DSS020(0.0E+00,XL,NG,T1,T1X, 1.0E+00)
      CALL DSS020(0.0E+00,XL,NG,T2,T2X,-1.0E+00)
      CALL DSS020(0.0E+00,XL,NG,T3,T3X, 1.0E+00)
      CALL DSS020(0.0E+00,XL,NG,T4,T4X,-1.0E+00)
      CALL DSS020(0.0E+00,XL,NG,T9,T9X, 1.0E+00)
C...
C...  ASSEMBLE THE PDES, EQUATIONS (1) TO (9)
      DO 1 I=1,NG
      T1T(I)=-C1*T1X(I) + C3*(T5(I)-T1(I))
      T2T(I)= C1*T2X(I) + C3*(T6(I)-T2(I))
      T3T(I)=-C1*T3X(I) + C3*(T7(I)-T3(I))
      T4T(I)= C1*T4X(I) + C3*(T8(I)-T4(I))
      T5T(I)=             C4*(T1(I)-T5(I))
     1                  + C5*(T9(I)-T5(I))
      T6T(I)=             C4*(T2(I)-T6(I))
     1                  + C5*(T9(I)-T6(I))
      T7T(I)=             C4*(T3(I)-T7(I))
     1                  + C5*(T9(I)-T7(I))
      T8T(I)=             C4*(T4(I)-T8(I))
     1                  + C5*(T9(I)-T8(I))
      T9T(I)=-C2*T9X(I) - 4.0E+00*C6*T9(I)
     1                  + C6*(T5(I)+T6(I)+T7(I)+T8(I))
1     CONTINUE
C...
C...  EVALUATE THE ODE DERIVATIVES FROM EQUATIONS (10) AND (13) AND
C...  EQUATION (16).  NOTE THAT THESE DERIVATIVES MUST BE COMPUTED
C...  AFTER THOSE FOR THE PDES
      T1T( 1)=B1*(    TI-T1( 1))
      T2T(NG)=B2*(T1(NG)-T2(NG))
      T3T( 1)=B2*(T2( 1)-T3( 1))
      T4T(NG)=B2*(T3(NG)-T4(NG))
      T9T( 1)=0.0E+00
      T0T    =B1*(T4( 1)-    T0)
C...
C...  ******************************************************************
C...  TRANSLATE THE PROBLEM DEPENDENT VARIABLE DERIVATIVES TO THE
C...  DEPENDENT VARIABLE DERIVATIVE VECTOR F IN COMMON/F/
      J=0
      DO 11 I=1,NG
      J=J+1
      F(J)=T1T(I)
      J=J+1
      F(J)=T2T(I)
      J=J+1
      F(J)=T3T(I)
      J=J+1
      F(J)=T4T(I)
      J=J+1
      F(J)=T5T(I)
      J=J+1
      F(J)=T6T(I)
      J=J+1
      F(J)=T7T(I)
      J=J+1
      F(J)=T8T(I)
      J=J+1
      F(J)=T9T(I)
11    CONTINUE
      J=J+1
      F(J)=T0T
C...  ******************************************************************
C...
      RETURN
      END
      SUBROUTINE PRINT2(NI,NO)
      COMMON/T/
     1       TIME,     NSTOP,     NORUN
     2      /Y/
     3     Y(100)
     5      /F/
     6     F(100)
     8      /S/
     9    T1X(11),   T2X(11),   T3X(11),   T4X(11),   T9X(11)
      COMMON/C/
     1         XL,        C1,        C2,        C3,        C4,
     2         C5,        C6,        B1,        B2,        TI,
     3        TSI,        NG,         N
      COMMON/A/
     3     T1(11),    T2(11),    T3(11),    T4(11),    T5(11),
     4     T6(11),    T7(11),    T8(11),    T9(11),        T0
      COMMON/B/
     6    T1T(11),   T2T(11),   T3T(11),   T4T(11),   T5T(11),
     7    T6T(11),   T7T(11),   T8T(11),   T9T(11),       T0T
C...
C...  THIS SECTION OF SUBROUTINE PRINT
C...
C...     (1)  CALLS SUBROUTINE JMAP TO MAP THE JACOBIAN MATRIX OF
C...          100-ODE SYSTEM.
C...
C...     (2)  CALLS A SERIES OF EISPACK ROUTINES VIA SUBROUTINE EIGEN
C...          TO COMPUTE THE TEMPORAL EIGENVALUES OF THE ODE SYSTEM,
C...          AND OPTIONALLY, THE ASSOCIATED EIGENVECTORS.
C...
C...  ABSOLUTE DIMENSIONING OF THE ARRAYS REQUIRED BY SUBROUTINE JMAP
C...  (A, YOLD, FOLD) AND SUBROUTINE EIGEN (WI, WR, Z, RW, IW)
      REAL
     1       A(100,100), WR(100), WI(100), Z(100,100), RW(100),
     2                          YOLD(100),  FOLD(100)
      INTEGER                     IW(100)
C...
C...  MAP THE JACOBIAN MATRIX OF THE ODE SYSTEM DEFINED IN SUBROUTINE
C...  DERV, AND COMPUTE ITS TEMPORAL EIGENVALUES
      IF(TIME.GT.1.0E+00)GO TO 5
      CALL JMAP(N,A,Y,YOLD,F,FOLD)
C...
C...  SUBROUTINE EIGEN (PART OF DSS/2) CALLS A SERIES OF EISPACK ROU-
C...  TINES TO COMPUTE THE TEMPORAL EIGENVALUES, AND OPTIONALLY, THE
C...  EIGENVECTORS OF THE 100-ODE SYSTEM JACOBIAN MATRIX
      CALL EIGEN(N,A,WR,WI,Z,RW,IW)
C...
C...  PRINT A HEADING FOR THE NUMERICAL SOLUTION
      WRITE(NO,3)
3     FORMAT(1H1,9X,50HMIXED ORDINARY/PARTIAL DIFFERENTIAL EQUATION MODE
     1L,/)
      WRITE(NO,1)C1,C2,C3,C4
1     FORMAT(
     13X,4HC1 = ,E10.3,3X,4HC2 = ,E10.3,3X,4HC3 = ,E10.3,
     23X,4HC4 = ,E10.3)
      WRITE(NO,2)C5,C6,B1,B2
2     FORMAT(
     13X,4HC5 = ,E10.3,3X,4HC6 = ,E10.3,3X,4HB1 = ,E10.3,
     23X,4HB2 = ,E10.3,//)
      WRITE(NO,4)
4     FORMAT(
     1 6X,4HTIME,7X,7HT1(X=0),7X,8HT4(X=12),8X,2HT0,10X,
     2 8HT9(X=12))
C...
C...  PRINT THE SOLUTION
5     WRITE(NO,6)TIME,T1(1),T4(NG),T0,T9(NG)
6     FORMAT(E12.3,4E14.5)
      RETURN
      END
      SUBROUTINE INIT3
C...
C...  DYNAMIC MODEL OF A FOUR-PASS SHELL AND TUBE HEAT EXCHANGER WITH
C...  MAPPING OF THE MODEL JACOBIAN MATRIX
C...
C...  A HEAT EXCHANGER IS A DISTRIBUTED SYSTEM IN WHICH CONVECTION AND
C...  TRANSFER OF HEAT ALONG THE EXCHANGER ARE THE PRINCIPAL MODES OF
C...  OPERATION.  THUS THE SPATIAL DISTRIBUTION OF TEMPERATURE WITHIN
C...  THE EXCHANGER MUST BE TAKEN INTO ACCOUNT IN A REALISTIC ANALYSIS.
C...  IF THE TRANSIENT OPERATION OF AN EXCHANGER IS ALSO TO BE CON-
C...  SIDERED, THE MATHEMATICAL MODEL MUST NECESSARILY INVOLVE SPACE
C...  AND TIME, I.E., THE MODEL IS EXPRESSED IN TERMS OF PDES.  ALSO,
C...  MIXING IN THE HEADERS OF THE EXCHANGER (THE ENTRANCE CHAMBER FOR
C...  EACH TUBE PASS) IS MODELED BY ODES WHICH SERVE AS BOUNDARY CON-
C...  DITIONS FOR THE PDES.  THE ANALYSIS OF EXPERIMENTAL DATA FOR HEAT
C...  EXCHANGERS HAS INDICATED THAT THE MIXING IN THE HEADERS CANNOT BE
C...  NEGLECTED AND THUS A MIXED ODE/PDE MODEL IS REQUIRED.  TO ILLUS-
C...  TRATE SOME OF THESE CONCEPTS, CONSIDER THE FOLLOWING SYSTEM OF
C...  NINE PDES AND FIVE PDES FOR A FOUR-PASS, SHELL AND TUBE HEAT
C...  EXCHANGER (SUBSCRIPTS T AND X DENOTE PARTIAL DERIVATIVES WITH
C...  RESPECT TO T AND X, RESPECTIVELY)
C...
C...                   T1  = -C1*T1  + C3*(T5 - T1)                  (1)
C...                     T         X
C...
C...                   T2  =  C1*T2  + C3*(T6 - T2)                  (2)
C...                     T         X
C...
C...                   T3  = -C1*T3  + C3*(T7 - T3)                  (3)
C...                     T         X
C...
C...                   T4  =  C1*T4  + C3*(T8 - T4)                  (4)
C...                     T         X
C...
C...                T5  = C4*(T1 - T5) + C5*(T9 - T5)                (5)
C...                  T
C...
C...                T6  = C4*(T2 - T6) + C5*(T9 - T6)                (6)
C...                  T
C...
C...                T7  = C4*(T3 - T7) + C5*(T9 - T7)                (7)
C...                  T
C...
C...                T8  = C4*(T4 - T8) + C5*(T9 - T8)                (8)
C...                  T
C...
C...           T9  = -C2*T9  + C6*((T5 - T9) + (T6 - T9) +
C...             T         X                                         (9)
C...                               (T7 - T9) + (T8 - T9))
C...
C...  THE NINE DEPENDENT VARIABLES, T1(X,T), T2(X,T), ..., T9(X,T) ARE
C...  TO BE COMPUTED.  C1, C2. ..., C6 ARE GIVEN NUMERICAL CONSTANTS
C...  WHICH REFLECT THE THERMAL CAPACITANCES OF THE LIQUIDS FLOWING
C...  THROUGH THE EXCHANGER, THE THERMAL CAPACITANCE OF THE METAL IN
C...  THE EXCHANGER TUBES AND THE HEAT TRANSFER CHARACTERISTICS.  EQUA-
C...  TIONS (1) TO (4) AND (9) EACH REQUIRE A BOUNDARY CONDITION IN X
C...  AND ALL NINE EQUATIONS REQUIRE AN INITIAL CONDITION IN T.  THESE
C...  WILL BE TAKEN AS
C...
C...                 DT1(0,T)/DT = B1*(TI - T1(0,T))                (10)
C...
C...              DT2(L,T)/DT = B2*(T1(L,T) - T2(L,T))              (11)
C...
C...              DT3(0,T)/DT = B2*(T2(0,T) - T3(0,T))              (12)
C...
C...              DT4(L,T)/DT = B2*(T3(L,T) - T4(L,T))              (13)
C...
C...                           T9(0,T) = TSI                        (14)
C...
C...             T1(X,0) = T2(X,0) = T3(X,0) = T4(X,0) =
C...
C...             T5(X,0) = T6(X,0) = T7(X,0) = T8(X,0) =            (15)
C...
C...                            T9(X,0) = 0
C...
C...  FINALLY, ONE ORDINARY DIFFERENTIAL EQUATION WILL BE ADDED TO MODEL
C...  THE MIXING IN THE HEADER AT THE EXIT OF THE FOURTH PASS
C...
C...                    DT0/DT = B1*(T4(0,T) - T0)                  (16)
C...
C...                             T0(0) = 0                          (17)
C...
C...  EQUATIONS (1) TO (17) CONSTITUTE THE COMPLETE SYSTEM (NINE PDES
C...  AND FIVE ODES).  L, B1 AND B2 ARE THE EXCHANGER LENGTH AND MIXING
C...  TIME CONSTANTS FOR THE HEADERS, RESPECTIVELY.  TI AND TSI ARE THE
C...  ENTERING TEMPERATURES OF THE TUBE SIDE AND SHELL SIDE FLUIDS,
C...  RESPECTIVELY.
C...
C...  THE SOLUTION OF EQUATIONS (1) TO (17) IS BASED ON THE APPROXI-
C...  MATION OF THE DERIVATIVES IN X IN EQUATIONS (1) TO (4) AND (9)
C...  OVER A GRID OF 11 POINTS.  AN APPROXIMATING ODE IS WRITTEN FOR
C...  EACH GRID POINT FOR EACH PDE.  THUS THERE WILL BE A TOTAL OF 11*9
C...  = 99 ODES APPROXIMATING EQUATIONS (1) TO (9).  FINALLY, EQUATION
C...  (16) BRINGS THE TOTAL ODES TO 100.
C...
C...  IN ORDER TO GAIN A PICTURE OF THE 100-ODE SYSTEM STRUCTURE, THE
C...  FOLLOWING PROGRAM ALSO CALLS SUBROUTINES JMAP AND EIGEN TO MAP THE
C...  100-ODE SYSTEM JACOBIAN MATRIX AND COMPUTE THE TEMPORAL EIGEN-
C...  VALUES, RESPECTIVELY.
C...
      COMMON/T/
     1       TIME,     NSTOP,     NORUN
     2      /Y/
     3     T1(11),    T2(11),    T3(11),    T4(11),    T5(11),
     4     T6(11),    T7(11),    T8(11),    T9(11),        T0
     5      /F/
     6    T1T(11),   T2T(11),   T3T(11),   T4T(11),   T5T(11),
     7    T6T(11),   T7T(11),   T8T(11),   T9T(11),       T0T
     8      /S/
     9    T1X(11),   T2X(11),   T3X(11),   T4X(11),   T9X(11)
      COMMON/C/
     1         XL,        C1,        C2,        C3,        C4,
     2         C5,        C6,        B1,        B2,        TI,
     3        TSI,        NG,         N
C...
C...  INITIALIZE THE PROBLEM SYSTEM PARAMETERS
C...
C...  MODEL CONSTANTS
      XL=12.0E+00
      C1=1.98E+00
      C2=0.3E+00
      C3=0.13E+00
      C4=0.476E+00
      C5=0.434E+00
      C6=0.00963E+00
      B1=0.588E+00
      B2=0.294E+00
      TI=10.0E+00
      TSI=0.0E+00
      NG=11
      N=100
C...
C...  INITIAL CONDITIONS
      DO 1 I=1,NG
      T1(I)=0.0E+00
      T2(I)=0.0E+00
      T3(I)=0.0E+00
      T4(I)=0.0E+00
      T5(I)=0.0E+00
      T6(I)=0.0E+00
      T7(I)=0.0E+00
      T8(I)=0.0E+00
      T9(I)=0.0E+00
1     CONTINUE
      T0=0.0E+00
      RETURN
      END
      SUBROUTINE DERV3
      COMMON/T/
     1       TIME,     NSTOP,     NORUN
     2      /Y/
     3     Y(100)
     5      /F/
     6     F(100)
     8      /S/
     9    T1X(11),   T2X(11),   T3X(11),   T4X(11),   T9X(11)
      COMMON/C/
     1         XL,        C1,        C2,        C3,        C4,
     2         C5,        C6,        B1,        B2,        TI,
     3        TSI,        NG,         N
      COMMON/A/
     3     T1(11),    T2(11),    T3(11),    T4(11),    T5(11),
     4     T6(11),    T7(11),    T8(11),    T9(11),        T0
      COMMON/B/
     6    T1T(11),   T2T(11),   T3T(11),   T4T(11),   T5T(11),
     7    T6T(11),   T7T(11),   T8T(11),   T9T(11),       T0T
C...
C...  ******************************************************************
C...  TRANSLATE THE DEPENDENT VARIABLE VECTOR X IN COMMON/Y/ TO THE
C...  PROBLEM DEPENDENT VARIABLES
      J=0
      DO 10 I=1,NG
      J=J+1
      T1(I)=Y(J)
      J=J+1
      T5(I)=Y(J)
      J=J+1
      T2(I)=Y(J)
      J=J+1
      T6(I)=Y(J)
      J=J+1
      T9(I)=Y(J)
      J=J+1
      T3(I)=Y(J)
      J=J+1
      T7(I)=Y(J)
      J=J+1
      T4(I)=Y(J)
      J=J+1
      T8(I)=Y(J)
10    CONTINUE
      J=J+1
      T0=Y(J)
C...  ******************************************************************
C...
C...  SET BOUNDARY CONDITION (14)
      T9(1)=TSI
C...
C...  COMPUTE THE FIRST DERIVATIVES WITH RESPECT TO X BY FIVE-POINT
C...  BIASED UPWIND APPROXIMATIONS
      CALL DSS020(0.0E+00,XL,NG,T1,T1X, 1.0E+00)
      CALL DSS020(0.0E+00,XL,NG,T2,T2X,-1.0E+00)
      CALL DSS020(0.0E+00,XL,NG,T3,T3X, 1.0E+00)
      CALL DSS020(0.0E+00,XL,NG,T4,T4X,-1.0E+00)
      CALL DSS020(0.0E+00,XL,NG,T9,T9X, 1.0E+00)
C...
C...  ASSEMBLE THE PDES, EQUATIONS (1) TO (9)
      DO 1 I=1,NG
      T1T(I)=-C1*T1X(I) + C3*(T5(I)-T1(I))
      T2T(I)= C1*T2X(I) + C3*(T6(I)-T2(I))
      T3T(I)=-C1*T3X(I) + C3*(T7(I)-T3(I))
      T4T(I)= C1*T4X(I) + C3*(T8(I)-T4(I))
      T5T(I)=             C4*(T1(I)-T5(I))
     1                  + C5*(T9(I)-T5(I))
      T6T(I)=             C4*(T2(I)-T6(I))
     1                  + C5*(T9(I)-T6(I))
      T7T(I)=             C4*(T3(I)-T7(I))
     1                  + C5*(T9(I)-T7(I))
      T8T(I)=             C4*(T4(I)-T8(I))
     1                  + C5*(T9(I)-T8(I))
      T9T(I)=-C2*T9X(I) - 4.0E+00*C6*T9(I)
     1                  + C6*(T5(I)+T6(I)+T7(I)+T8(I))
1     CONTINUE
C...
C...  EVALUATE THE ODE DERIVATIVES FROM EQUATIONS (10) AND (13) AND
C...  EQUATION (16).  NOTE THAT THESE DERIVATIVES MUST BE COMPUTED
C...  AFTER THOSE FOR THE PDES
      T1T( 1)=B1*(    TI-T1( 1))
      T2T(NG)=B2*(T1(NG)-T2(NG))
      T3T( 1)=B2*(T2( 1)-T3( 1))
      T4T(NG)=B2*(T3(NG)-T4(NG))
      T9T( 1)=0.0E+00
      T0T    =B1*(T4( 1)-    T0)
C...
C...  ******************************************************************
C...  TRANSLATE THE PROBLEM DEPENDENT VARIABLE DERIVATIVES TO THE
C...  DEPENDENT VARIABLE DERIVATIVE VECTOR F IN COMMON/F/
      J=0
      DO 11 I=1,NG
      J=J+1
      F(J)=T1T(I)
      J=J+1
      F(J)=T5T(I)
      J=J+1
      F(J)=T2T(I)
      J=J+1
      F(J)=T6T(I)
      J=J+1
      F(J)=T9T(I)
      J=J+1
      F(J)=T3T(I)
      J=J+1
      F(J)=T7T(I)
      J=J+1
      F(J)=T4T(I)
      J=J+1
      F(J)=T8T(I)
11    CONTINUE
      J=J+1
      F(J)=T0T
C...  ******************************************************************
C...
      RETURN
      END
      SUBROUTINE PRINT3(NI,NO)
      COMMON/T/
     1       TIME,     NSTOP,     NORUN
     2      /Y/
     3     Y(100)
     5      /F/
     6     F(100)
     8      /S/
     9    T1X(11),   T2X(11),   T3X(11),   T4X(11),   T9X(11)
      COMMON/C/
     1         XL,        C1,        C2,        C3,        C4,
     2         C5,        C6,        B1,        B2,        TI,
     3        TSI,        NG,         N
      COMMON/A/
     3     T1(11),    T2(11),    T3(11),    T4(11),    T5(11),
     4     T6(11),    T7(11),    T8(11),    T9(11),        T0
      COMMON/B/
     6    T1T(11),   T2T(11),   T3T(11),   T4T(11),   T5T(11),
     7    T6T(11),   T7T(11),   T8T(11),   T9T(11),       T0T
C...
C...  THIS SECTION OF SUBROUTINE PRINT
C...
C...     (1)  CALLS SUBROUTINE JMAP TO MAP THE JACOBIAN MATRIX OF
C...          100-ODE SYSTEM.
C...
C...     (2)  CALLS A SERIES OF EISPACK ROUTINES VIA SUBROUTINE EIGEN
C...          TO COMPUTE THE TEMPORAL EIGENVALUES OF THE ODE SYSTEM,
C...          AND OPTIONALLY, THE ASSOCIATED EIGENVECTORS.
C...
C...  ABSOLUTE DIMENSIONING OF THE ARRAYS REQUIRED BY SUBROUTINE JMAP
C...  (A, YOLD, FOLD) AND SUBROUTINE EIGEN (WI, WR, Z, RW, IW)
      REAL
     1       A(100,100), WR(100), WI(100), Z(100,100), RW(100),
     2                          YOLD(100),  FOLD(100)
      INTEGER                     IW(100)
C...
C...  MAP THE JACOBIAN MATRIX OF THE ODE SYSTEM DEFINED IN SUBROUTINE
C...  DERV, AND COMPUTE ITS TEMPORAL EIGENVALUES
      IF(TIME.GT.1.0E+00)GO TO 5
      CALL JMAP(N,A,Y,YOLD,F,FOLD)
C...
C...  SUBROUTINE EIGEN (PART OF DSS/2) CALLS A SERIES OF EISPACK ROU-
C...  TINES TO COMPUTE THE TEMPORAL EIGENVALUES, AND OPTIONALLY, THE
C...  EIGENVECTORS OF THE 100-ODE SYSTEM JACOBIAN MATRIX
      CALL EIGEN(N,A,WR,WI,Z,RW,IW)
C...
C...  PRINT A HEADING FOR THE NUMERICAL SOLUTION
      WRITE(NO,3)
3     FORMAT(1H1,9X,50HMIXED ORDINARY/PARTIAL DIFFERENTIAL EQUATION MODE
     1L,/)
      WRITE(NO,1)C1,C2,C3,C4
1     FORMAT(
     13X,4HC1 = ,E10.3,3X,4HC2 = ,E10.3,3X,4HC3 = ,E10.3,
     23X,4HC4 = ,E10.3)
      WRITE(NO,2)C5,C6,B1,B2
2     FORMAT(
     13X,4HC5 = ,E10.3,3X,4HC6 = ,E10.3,3X,4HB1 = ,E10.3,
     23X,4HB2 = ,E10.3,//)
      WRITE(NO,4)
4     FORMAT(
     1 6X,4HTIME,7X,7HT1(X=0),7X,8HT4(X=12),8X,2HT0,10X,
     2 8HT9(X=12))
C...
C...  PRINT THE SOLUTION
5     WRITE(NO,6)TIME,T1(1),T4(NG),T0,T9(NG)
6     FORMAT(E12.3,4E14.5)
      RETURN
      END
MIXED ODE/PDE SYSTEM
0.        50.0      2.5
  100 1000    1    1  ABS 0.05
MIXED ODE/PDE SYSTEM
0.        50.0      2.5
  100 1000    1    1  ABS 0.05
MIXED ODE/PDE SYSTEM
0.        50.0      2.5
  100 1000    1    1  ABS 0.05
END OF RUNS
*APP MATH49
      SUBROUTINE INITAL
C...
C...  TWO-DIMENSIONAL PARTIAL DIFFERENTIAL EQUATION WITH A MIXED PARTIAL
C...  DERIVATIVE
C...
C...  CONSIDER THE FOLLOWING TWO-DIMENSIONAL, HYPERBOLIC-PARABOLIC
C...  PARTIAL DIFFERENTIAL EQUATION (PDE) WITH A MIXED SECOND-ORDER
C...  PARTIAL DERIVATIVE (1):
C...
C...     U  = - (AX*U)  - (AY*U)  + (1/2)*(BXX*U)   + (1/2)*(BYY*U)
C...      T           X         Y                XX                YY
C...
C...        + C*(BXY*U)                                           (1)
C...                 XY
C...
C...  WHERE AX, AY, BXX, BYY AND BXY ARE VARIABLE COEFFICIENTS, I.E.,
C...  AX = AX(X,Y),..., BXY = BXY(X,Y).
C...
C...  (1)  THIS PROBLEM WAS SUGGESTED BY: DRS. JOHN D. REEVE AND PETER
C...       L. CHESSON, DEPARTMENT OF ZOOLOGY, COLLEGE OF BIOLOGICAL
C...       SCIENCES, THE OHIO STATE UNIVERSITY, 1735 NEIL AVENUE,
C...       COLUMBUS, OH  43210-1293
C...
C...  THE FOLLOWING CODING IS FOR THE DIRICHLET BOUNDARY CONDITIONS:
C...
C...     U(0,Y,T) = U(XL,Y,T) = U(X,0,T) = U(X,YL,T) = 0  (2)(3)(4)(5)
C...
C...  AND THE INITIAL CONDITION
C...
C...     U(X,Y,0) = 1                                              (6)
C...
C...  ALSO, THE VARIABLE COEFFICIENTS ARE TAKEN AS CONSTANTS (ALTHOUGH
C...  THE PROGRAMMING IS IN PLACE FOR MAKING THEM FUNCTIONS OF X AND Y),
C...  I.E.,
C...
C...     BX(X,Y) = BY(X,Y) = AXX(X,Y) = AYY(X,Y) = AXY(X,Y) = 1
C...
C...  THE SOLUTION IS BY THE NUMERICAL METHOD OF LINES ON AN 11 X 11
C...  POINT GRID IN X AND Y, WITH XL = YL = 1.  THE SOLUTION TO EQUATION
C...  (1) IS COMPUTED FOR THREE CASES: THE COEFFICIENT C OF THE MIXED
C...  PARTIAL DERIVATIVE HAS THE VALUES 0, 0.5 AND 1.0.  U(XL/2,YL/2,T)
C...  IS PLOTTED VS T TO DEMONSTRATE THE EFFECT OF THE MIXED PARTIAL
C...  DERIVATIVE.
C...
C...  DSS/2 COMMON AREA
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/  U(11,11)
     2      /F/ UT(11,11)
     3      /S/ UX(11,11), UY(11,11),UXX(11,11),UYY(11,11),UXY(11,11)
     4      /C/ AX(11,11), AY(11,11),BXX(11,11),BYY(11,11),BXY(11,11),
     5                 XL,        YL,         C
     6      /I/        NX,        NY,        IP
C...
C...  SET THE MODEL PARAMETERS
      XL=1.0
      YL=1.0
      NX=11
      NY=11
      IF(NORUN.EQ.1)C=0.
      IF(NORUN.EQ.2)C=0.5
      IF(NORUN.EQ.3)C=1.0
C...
C...  INITIAL CONDITION
      DO 1 I=1,NX
      DO 1 J=1,NY
      U(I,J)=1.0
1     CONTINUE
C...
C...  INITIAL DERIVATIVES
      CALL DERV
      IP=0
      RETURN
      END
      SUBROUTINE DERV
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/  U(11,11)
     2      /F/ UT(11,11)
     3      /S/ UX(11,11), UY(11,11),UXX(11,11),UYY(11,11),UXY(11,11)
     4      /C/ AX(11,11), AY(11,11),BXX(11,11),BYY(11,11),BXY(11,11),
     5                 XL,        YL,         C
     6      /I/        NX,        NY,        IP
C...
C...  VARIABLE COEFFICIENTS (WHICH CAN BE PROGRAMMED AS A FUNCTION OF
C...  X AND Y)
      DO 1 I=1,NX
      DO 1 J=1,NY
      AX(I,J)=1.0
      AY(I,J)=1.0
      BXX(I,J)=1.0
      BYY(I,J)=1.0
      BXY(I,J)=1.0
1     CONTINUE
C...
C...  BC AT X = 0 (DIRICHLET)
      DO 2 J=1,NY
      U(1,J)=0.
2     CONTINUE
C...
C...  BC AT Y = 0 (DIRICHLET)
      DO 3 I=1,NX
      U(I,1)=0.
3     CONTINUE
C...
C...  BC AT X = XL (DIRICHLET)
      DO 4 J =1,NY
      U(NX,J)=0.
4     CONTINUE
C...
C...  BC AT Y = YL (DIRICHLET)
      DO 5 I=1,NX
      U(I,NY)=0.
5     CONTINUE
C...
C...  PRODUCTS TO BE DIFFERENTIATED
      DO 6 I=1,NX
      DO 6 J=1,NY
      AX(I,J)=AX(I,J)*U(I,J)
      AY(I,J)=AY(I,J)*U(I,J)
      BXX(I,J)=BXX(I,J)*U(I,J)
      BYY(I,J)=BYY(I,J)*U(I,J)
      BXY(I,J)=BXY(I,J)*U(I,J)
6     CONTINUE
C...
C...  SPATIAL DERIVATIVES
C...
C...     SECOND ORDER DERIVATIVES
C...
C...        DERIVATIVE IN X
            CALL DSS034(0.,XL,NX,NY,1,BXX,UX,0.)
            CALL DSS034(0.,XL,NX,NY,1,UX,UXX,0.)
C...
C...        DERIVATIVE IN Y
            CALL DSS034(0.,YL,NX,NY,2,BYY,UY,0.)
            CALL DSS034(0.,YL,NX,NY,2,UY,UYY,0.)
C...
C...        DERIVATIVE IN X AND Y
            CALL DSS034(0.,XL,NX,NY,1,BXY,UX,0.)
            CALL DSS034(0.,XL,NX,NY,2,UX,UXY,0.)
C...
C...     FIRST ORDER DERIVATIVES
C...
C...        DERIVATIVE IN X
            CALL DSS034(0.,XL,NX,NY,1,AX,UX,1.)
C...
C...        DERIVATIVE IN Y
            CALL DSS034(0.,YL,NX,NY,2,AY,UY,1.)
C...
C...  PARTIAL DIFFERENTIAL EQUATION
      DO 7 I=1,NX
      DO 7 J=1,NY
      UT(I,J)=-UX(I,J)-UY(I,J)+0.5*UXX(I,J)+0.5*UYY(I,J)+C*UXY(I,J)
7     CONTINUE
C...
C...  BC AT X = 0 (DIRICHLET)
      DO 12 J=1,NY
      UT(1,J)=0.
12    CONTINUE
C...
C...  BC AT Y = 0 (DIRICHLET)
      DO 13 I=1,NX
      UT(I,1)=0.
13    CONTINUE
C...
C...  BC AT X = XL (DIRICHLET)
      DO 14 J =1,NY
      UT(NX,J)=0.
14    CONTINUE
C...
C...  BC AT Y = YL (DIRICHLET)
      DO 15 I=1,NX
      UT(I,NY)=0.
15    CONTINUE
      RETURN
      END
      SUBROUTINE PRINT(NI,NO)
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/  U(11,11)
     2      /F/ UT(11,11)
     3      /S/ UX(11,11), UY(11,11),UXX(11,11),UYY(11,11),UXY(11,11)
     4      /C/ AX(11,11), AY(11,11),BXX(11,11),BYY(11,11),BXY(11,11),
     5                 XL,        YL,         C
     6      /I/        NX,        NY,        IP
C...
C...  DIMENSION THE ARRAYS FOR PLOTTING
      REAL  TP(51), UP(3,51)
C...
C...  PRINT THE SOLUTION EVERY TENTH CALL TO SUBROUTINE PRINT
      IP=IP+1
      IF(((IP-1)/10*10).EQ.(IP-1))THEN
       WRITE(NO,2)T,((U(I,J),I=1,NX,2),J=1,NY,2)
2      FORMAT(' T = ',F10.4,/,
     1 15X,'X = 0',4X,'X = 0.2',3X,'X = 0.4',3X,'X = 0.6',
     2             3X,'X = 0.8',3X,'X = 1.0',/,
     3 3X,'  Y = 0',6F10.4,/,3X,'Y = 0.2',6F10.4,/,3X,'Y = 0.4',6F10.4,/,
     4 3X,'Y = 0.6',6F10.4,/,3X,'Y = 0.8',6F10.4,/,3X,'Y = 1.0',6F10.4,/
     5 /)
      END IF
C...
C...  STORE THE SOLUTION U(XL/2,YL/2,T) FOR PLOTTING
      TP(IP)=T
      UP(NORUN,IP)=U(6,6)
C...
C...  PLOT U(XL/2,YL/2,T) VS T FOR THREE CASES C = 0, 0.5, 1
      IF((NORUN.NE.3).OR.(IP.NE.51))RETURN
      CALL TPLOTS(NORUN,IP,TP,UP)
      WRITE(NO,10)
10    FORMAT(//,' U(XL/2,YL/2,T) VS T, C = 0, 0.5, 1')
      RETURN
      END
TWO-D PDE WITH MIXED PARTIAL DERIVATIVE
0.        0.5       0.01
  121 1000    1    1  ABS 0.001
TWO-D PDE WITH MIXED PARTIAL DERIVATIVE
0.        0.5       0.01
  121 1000    1    1  ABS 0.001
TWO-D PDE WITH MIXED PARTIAL DERIVATIVE
0.        0.5       0.01
  121 1000    1    1  ABS 0.001
END OF RUNS
*APP MATH50
      SUBROUTINE INITAL
C...
C...  EFFECT OF DISCONTINUOUS INITIAL/BOUNDARY CONDITIONS ON THE
C...  NUMERICAL METHOD OF LINES SOLUTION OF A TWO-DIMENSIONAL
C...  PARABOLIC PARTIAL DIFFERENTIAL EQUATION
C...
C...  DISCONTINUITIES BETWEEN INITIAL CONDITIONS AND BOUNDARY CONDITIONS
C...  OFTEN OCCUR IN THE FORMULATION OF PROBLEMS IN PARTIAL DIFFERENTIAL
C...  EQUATIONS FOR PHYSICAL APPLICATIONS.  FOR EXAMPLE, IN ANALYZING
C...  A THERMAL SYSTEM, INITIALLY THE TEMPERATURE OF THE SYSTEM MIGHT
C...  BE A PRESCRIBED CONSTANT, AND THE SURFACE TEMPERATURE MIGHT THEN
C...  BE CHANGED INSTANTANEOUSLY TO ANOTHER VALUE DUE TO QUENCHING.
C...  THUS AT THE BOUNDARY, THE TEMPERATURE UNDERGOES A FINITE STEP OR
C...  DISCONTINUITY.  WE COULD THEN NATURALLY INQUIRE HOW A NUMERICAL
C...  PROCEDURE FOR THE PROBLEM ACCOMMODATES THE DISCONTINUITY.
C...
C...  THIS SITUATION IS ANALYZED IN THE FOLLOWING PROBLEM FOR A TWO-
C...  DIMENSIONAL PARABOLIC PDE (THE HEAT CONDUCTION EQUATION) WITH
C...  DISCONTINUOUS INITIAL/BOUNDARY CONDITIONS.  THE DISCONTINUITY
C...  INTRODUCES SOME SMALL OSCILLATIONS IN THE NUMERICAL SOLUTION
C...  WHICH ARE QUICKLY DAMPED, BUT OTHERWISE HAS LITTLE EFFECT ON THE
C...  THE SOLUTION.  TWO RUNS ARE PROGRAMMED:
C...
C...     (1)  THE PHYSICALLY UNREALISTIC OSCILLATION BELOW THE INITIAL
C...     CONDITION IS NOT ALTERED.
C...
C...     (2)  IF THE TEMPERATURE GOES BELOW THE INITIAL CONDITION, THE
C...     TEMPERATURE IS SET TO THE INITIAL CONDITION.
C...
C...  THE SOLUTIONS FOR BOTH CASES ARE PLOTTED TOGETHER FOR COMPARISON.
C...  ALSO, A STEADY STATE ENERGY BALANCE IS PERFORMED AS AN INDEPENDENT
C...  CHECK OF THE NUMERICAL SOLUTION, CONFIRMING, AT LEAST AT STEADY
C...  STATE, THAT THE NUMERICAL SOLUTION IS ACCURATE.
C...
C...  CONSIDER THE FOLLOWING TWO-DIMENSIONAL PDE FOR HEAT CONDUCTION
C...  IN A FINITE CYLINDER (1):
C...
C...     U  = D*(U   + (1/R)*U  + U  )                          (1)
C...      T       RR          R    ZZ
C...
C...  WHERE
C...
C...     U       TEMPERATURE
C...
C...     R       CYLINDER RADIAL COORDINATE
C...
C...     Z       CYLINDER AXIAL COORDINATE
C...
C...     T       TIME
C...
C...     D       THERMAL DIFFUSIVITY (= K/(RHO*CP))
C...
C...     K       THERMAL CONDUCTIVITY
C...
C...     RHO     DENSITY
C...
C...     CP      SPECIFIC HEAT
C...
C...  (1)  THIS PROBLEM WAS DEVELOPED BY DR. E. J. NOLAN, MILK COMPON-
C...       ENTS BRANCH, UNITED STATES DEPARTMENT OF AGRICULTURE, AGRI-
C...       CULTURAL RESEARCH SERVICE, NORTH ATLANTIC AREA, EASTERN
C...       REGIONAL RESEARCH CENTER, 600 MERMAID LANE, PHILADELPHIA,
C...       PA 19118
C...
C...  THE AUXILIARY CONDITIONS FOR EQUATION (1) ARE
C...
C...     U(R,Z,0) = U0                                          (2)
C...
C...     U(RA,Z,T) = U(R,0,T) = U(R,ZL,T) = US, U (0,Z,T) = 0 (3)(4)
C...                                             R            (5)(6)
C...  WHERE
C...
C...     RA      CYLINDER RADIUS
C...
C...     ZL      CYLINDER LENGTH
C...
C...     U0      INITIAL TEMPERATURE
C...
C...     US      SURFACE TEMPERATURE
C...
C...  IN ADDITION TO THE TEMPERATURE FIELD, U(R,Z,T), TWO OTHER RELATED
C...  QUANTITIES, THE TOTAL HEAT CONTENT, QTOT, AND THE TIME INTEGRATED
C...  HEAT FLUX, QI, ARE OF INTEREST, AND ARE GIVEN BY THE EQUATIONS
C...
C...     QTOT = PI*(RA**2)*ZL*RHO*CP*(UAVG - U0)                (7)
C...
C...           T
C...     QI = INT (QR**2 + QZ0**2 + QZL**2)**0.5 DT             (8)
C...           0
C...
C...  WHERE
C...
C...     UAVG   TEMPERATURE AVERAGED OVER THE CYLINDER
C...
C...     QR     RADIAL HEAT FLUX AT R = RA, Z = ZL/2 (= -K*U (RA,ZL/2,T))
C...                                                        R
C...
C...     QZ0    AXIAL HEAT FLUX AT R = RA, Z = 0 (= -K*U (RA,0,T))
C...                                                    Z
C...
C...     QZL    AXIAL HEAT FLUX AT R = RA, Z = ZL (= -K*U (RA,ZL,T))
C...                                                     Z
C...
C...  THE AVERAGE TEMPERATURE, UAVG IS COMPUTED FROM
C...
C...             ZL  RA
C...            INT INT 2*PI*R*U DR DZ
C...             0   0
C...     UAVG = ----------------------                          (9)
C...             ZL  RA
C...            INT INT 2*PI*R DR DZ
C...             0   0
C...
C...  THE INTEGRAL IN EQUATION (8) IS COMPUTED BY THE USUAL TIME
C...  INTEGRATION OF DSS/2 (THROUGH VARIABLES IN COMMON/F/ AND /Y/).
C...  THE INTEGRAL IN THE NUMERATOR OF EQUATION (9) IS COMPUTED BY
C...  A COMBINATION OF SUBROUTINES LINT2 (PART OF DSS/2) AND TWODQ
C...  (FROM THE IMSL LIBRARY).  IF THE IMSL LIBRARY IS NOT AVAILABLE,
C...  TWODQ CAN BE REPLACED BY ANOTHER ROUTINE FOR TWO DIMENSIONAL
C...  INTEGRALS, OR THE CALCULATION OF UAVG AND QTOT IN SUBROUTINE
C...  PRINT CAN BE COMMENTED OUT.  THE INTEGRAL IN THE DENOMINATOR OF
C...  EQUATION (9) IS, OF COURSE, JUST THE VOLUME OF THE CYLINDER,
C...  PI*(RA**2)*ZL.
C...
C...  THE SOLUTION TO EQUATION (1) HAS THE PROPERTY U(R,Z,INF) = US.
C...  THUS, UAVG(INF) = US AND FROM EQUATION (7)
C...
C...     QTOT(INF) = PI*(RA**2)*ZL*RHO*CP*(US - U0)       (10)
C...
C...  QTOT(INF) CAN BE CALCULATED INDEPENDENTLY FROM EQUATION (10)
C...  AND USED TO CHECK THE NUMERICAL RESULT FOR LARGE TIME.  FOR
C...  EXAMPLE, IF U0 = 25, US = 50, RA = 1, ZL = 5, RHO = 1, CP = 1,
C...
C...     QTOT(INF) = PI*(1**2)*5*(50 - 25) = PI*125 = 392.7
C...
C...  THE FOLLOWING CODING IN AN IMPLEMENTATION OF EQUATIONS (1) TO
C...  (10).
C...
C...  USUAL DSS/2 COMMON AREAS
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/   U(6,11),        QI
     2      /F/  UT(6,11),         Q
     3      /S/  UR(6,11), URR(6,11),  UZ(6,11), UZZ(6,11)
     4      /C/        RA,        ZL,        US,        U0,         K,
     5                RHO,        CP,         D,      R(6),        QR,
     6                QZ0,       QZL,      UAVG,      QTOT,        PI
     7      /I/        NR,        NZ,        IP
      REAL              K
C...
C...  COMMON AREA TO ACCESS THE INPUT/OUTPUT UNIT NUMBERS
      COMMON/IO/ NI, NO
C...
C...  SET THE MODEL PARAMETERS
C...
C...     CYLINDER RADIUS
         RA=1.0
C...
C...     CYLINDER LENGTH
         ZL=5.0
C...
C...     PI
         PI=3.1415927
C...
C...     AMBIENT TEMPERATURE
         US=50.
C...
C...     INITIAL TEMPERATURE
         U0=25.
C...
C...     THERMAL CONDUCITIVITY
         K=1.0
C...
C...     DENSITY
         RHO=1.0
C...
C...     SPECIFIC HEAT
         CP=1.0
C...
C...     THERMAL DIFFUSIVITY
         D=K/(RHO*CP)
C...
C...     RADIAL GRID POINTS
         NR=6
C...
C...     AXIAL GRID POINTS
         NZ=11
C...
C...  INITIAL CONDITION FOR THE PDE
      DO 1 I=1,NR
      DO 1 J=1,NZ
      U(I,J)=U0
1     CONTINUE
C...
C...  INITIAL CONDITION FOR THE TIME INTEGRATED HEAT FLUX
      QI=0.
C...
C...  PRINT THE INITIAL CONDITION WITHOUT THE BOUNDARY CONDITIONS (IP
C...  IS INITIALIZED HERE AND PASSED THROUGH COMMON TO CONTROL THE
C...  OUTPUT IN SUBROUTINE PRINT)
      IP=0
      CALL PRINT(NI,NO)
C...
C...  INCLUDE THE BOUNDARY CONDITIONS INITIALLY
      CALL DERV
C...
C...  THE INITIAL CONDITION WITH THE BOUNDARY CONDITIONS WILL BE
C...  PRINTED AFTER THE FOLLOWING RETURN BY A CALL TO SUBROUTINE
C...  PRINT FROM THE DSS/2 MAIN PROGRAM
      IP=0
      RETURN
      END
      SUBROUTINE DERV
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/   U(6,11),        QI
     2      /F/  UT(6,11),         Q
     3      /S/  UR(6,11), URR(6,11),  UZ(6,11), UZZ(6,11)
     4      /C/        RA,        ZL,        US,        U0,         K,
     5                RHO,        CP,         D,      R(6),        QR,
     6                QZ0,       QZL,      UAVG,      QTOT,        PI
     7      /I/        NR,        NZ,        IP
      REAL              K
C...
C...  ELIMINATE ANY SMALL OSCILLATION DUE TO THE DISCONTINUITY AT T = 0
C...  IN THE SECOND RUN
      IF(NORUN.EQ.2)THEN
      DO 8 I=1,NR
      DO 8 J=1,NZ
      IF(U(I,J).LT.U0)U(I,J)=U0
8     CONTINUE
      END IF
C...
C...  BOUNDARY CONDITION AT R = RA
      DO 1 J=1,NZ
      U(NR,J)=US
1     CONTINUE
C...
C...  BOUNDARY CONDITION AT Z = 0
      DO 2 I=1,NR
      U(I,1)=US
2     CONTINUE
C...
C...  BOUNDARY CONDITION AT Z = ZL
      DO 3 I=1,NR
      U(I,NZ)=US
3     CONTINUE
C...
C...  DERIVATIVE UR
      CALL DSS034(0.,RA,NR,NZ,1,U,UR,0.)
C...
C...  DERIVATIVE UZ
      CALL DSS034(0.,ZL,NR,NZ,2,U,UZ,0.)
C...
C...  BOUNDARY CONDITION AT R = 0
      DO 4 J=1,NZ
      UR(1,J)=0.
4     CONTINUE
C...
C...  DERIVATIVE URR
      CALL DSS034(0.,RA,NR,NZ,1,UR,URR,0.)
C...
C...  DERIVATIVE UZZ
      CALL DSS034(0.,ZL,NR,NZ,2,UZ,UZZ,0.)
C...
C...  PDE
      DO 5 I=1,NR
      DO 5 J=1,NZ
      IF(I.EQ.1)THEN
         UT(I,J)=D*(2.0*URR(I,J)+UZZ(I,J))
      ELSE
         R(I)=(RA-0.)*FLOAT(I-1)/FLOAT(NR-1)
         UT(I,J)=D*(URR(I,J)+1.0/R(I)*UR(I,J)+UZZ(I,J))
      END IF
5     CONTINUE
C...
C...  ZERO THE TIME DERIVATIVES AT THE BOUNDARIES Z = 0, ZL
      DO 6 I=1,NR
      UT(I, 1)=0.
      UT(I,NZ)=0.
6     CONTINUE
C...
C...  ZERO THE TIME DERIVATIVE AT THE BOUNDARY R = RA
      DO 7 J=1,NZ
      UT(NR,J)=0.
7     CONTINUE
C...
C...  COMPUTE THE TIME INTEGRATED HEAT FLUX AT THE CENTER (R = 0,
C...  Z = ZL/2)
C...
C...     SURFACE FLUX AT R = RA, Z = ZL/2
         QR=-K*UR(NR,NZ/2+1)
C...
C...     SURFACE FLUX AT R = RA, Z = 0
         QZ0=-K*UZ(NR,1)
C...
C...     SURFACE FLUX AT R = RA, Z = ZL
         QZL=-K*UZ(NR,NZ)
C...
C...     MAGNITUDE OF THE THREE FLUXES
         Q=SQRT(QR**2+QZ0**2+QZL**2)
      RETURN
      END
      SUBROUTINE PRINT(NI,NO)
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/   U(6,11),        QI
     2      /F/  UT(6,11),         Q
     3      /S/  UR(6,11), URR(6,11),  UZ(6,11), UZZ(6,11)
     4      /C/        RA,        ZL,        US,        U0,         K,
     5                RHO,        CP,         D,      R(6),        QR,
     6                QZ0,       QZL,      UAVG,      QTOT,        PI
     7      /I/        NR,        NZ,        IP
      REAL              K
C...
C...  DIMENSION THE ARRAYS FOR PLOTTING
      REAL TP(51), UP(2,51), QIP(2,51)
C...
C...  EXTERNAL THE FUNCTIONS CALLED BY IMSL SUBROUTINE TWODQ
      EXTERNAL FCN, RLOWER, RUPPER
C...
C...  PRINT THE NUMERICAL SOLUTON EVERY TENTH CALL TO SUBROUTINE PRINT
      IP=IP+1
      IF(((IP-1)/10*10).EQ.(IP-1))THEN
C...
C...  U(X,Y,T) VS X AND Y AT THE CURRENT T
      WRITE(NO,1)T,((U(I,J),I=1,NR,1),J=1,NZ,2)
1     FORMAT(1H ,//,' T = ',F7.2,/,
     1 10X,'       R=0','  R=0.2*RA','  R=0.4*RA',
     2     '  R=0.6*RA','  R=0.8*RA','      R=RA',/,
     3 '       Z=0',6F10.3,/,'  Z=0.2*ZL',6F10.3,/,
     4 '  Z=0.4*ZL',6F10.3,/,'  Z=0.6*ZL',6F10.3,/,
     5 '  Z=0.8*ZL',6F10.3,/,'      Z=ZL',6F10.3,)
C...
C...  PRINT THE TIME INTEGRATED HEAT FLUX
      WRITE(NO,2)QI
2     FORMAT(1H ,/,' QI = ',F10.2)
C...
C...  COMPUTE THE INTEGRAL AVERAGE TEMPERATURE USING IMSL SUBROUTINE
C...  TWODQ FOR TWO-DIMENSIONAL INTEGRALS
      ERRABS=0.01
      ERRREL=0.001
      IRULE=1
      CALL TWODQ(FCN,0.,ZL,RLOWER,RUPPER,ERRABS,ERRREL,IRULE,UAVG,ERR)
C...
C...  THE INTEGRAL IS DIVIDED BY THE VOLUME OF THE CYLINDER TO OBTAIN
C...  THE INTEGRAL AVERAGE TEMPERATURE
      VOL=PI*(RA**2)*ZL
      UAVG=UAVG/VOL
C...
C...  COMPUTE THE TOTAL HEAT CONTENT
      QTOT=VOL*RHO*CP*(UAVG-U0)
C...
C...  PRINT THE AVERAGE TEMPERATURE, TOTAL HEAT CONTENT
      WRITE(NO,3)UAVG,QTOT
3     FORMAT(1H ,/,' AVERAGE TEMPERATURE = ',F10.2,//,
     1             ' TOTAL HEAT CONTENT  = ',F10.2,//)
      END IF
C...
C...  STORE THE SOLUTION FOR PLOTTING
      TP(IP)=T
      UP(NORUN,IP)=U(1,NZ/2+1)
      QIP(NORUN,IP)=QI
C...
C...  PLOT THE SOLUTION AT THE END OF THE SECOND RUN (TO DEMONSTRATE
C...  THE EFFECT OF SETTING U = U0 AT THE BEGINNING OF SUBROUTINE DERV)
      IF((IP.LT.51).OR.(NORUN.LT.2))RETURN
C...
C...  U(0,ZL/2,T) VS T
      CALL TPLOTS(NORUN,IP,TP,UP)
      WRITE(NO,11)
11    FORMAT(1H ,/,' U(0,ZL/2,T) VS T',/,
     1             ' 1 - NO LOWER CONSTRAINT',
     2          3X,' 2 - U = U0 CONSTRAINT')
C...
C...  QI(T) VS T
      CALL TPLOTS(NORUN,IP,TP,QIP)
      WRITE(NO,12)
12    FORMAT(1H ,/,' TIME INTEGRATED HEAT FLUX, QI(T), VS T',/,
     1             ' 1 - NO LOWER CONSTRAINT',
     2          3X,' 2 - U = U0 CONSTRAINT')
      RETURN
      END
      REAL FUNCTION FCN(Z,R)
C...
C...  FUNCTION FCN DEFINES THE INTEGRAND OF THE TWO-DIMENSIONAL
C...  INTEGRAL IN R AND Z FOR THE AVERAGE TEMPERATURE
C...
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/   U(6,11),        QI
     2      /F/  UT(6,11),         Q
     3      /S/  UR(6,11), URR(6,11),  UZ(6,11), UZZ(6,11)
     4      /C/        RA,        ZL,        US,        U0,         K,
     5                RHO,        CP,         D,    DUM(6),        QR,
     6                QZ0,       QZL,      UAVG,      QTOT,        PI
     7      /I/        NR,        NZ,        IP
      REAL              K
C...
C...  PERFORM A LINEAR INTERPOLATION IN THE TEMPERATURE AT R AND Z.
C...  SUBROUTINE LINT2 IS PART OF DSS/2, AND IS DESCRIBED IN AN
C...  APPENDIX OF MANUAL NO. 1
      CALL LINT2(NR,0.,RA,R,NZ,0.,ZL,Z,U,UINT,NERR1,NERR2)
C...
C...  EVALUATE THE INTEGRAND
      FCN=2.0*PI*R*UINT
      RETURN
      END
      REAL FUNCTION RLOWER(R)
C...
C...  FUNCTION RLOWER SETS THE LOWER LIMIT ON THE INTEGRAL IN R FOR
C...  COMPUTING THE AVERAGE TEMPERATURE
C...
      RLOWER=0.
      RETURN
      END
      REAL FUNCTION RUPPER(R)
C...
C...  FUNCTION RUPPER SETS THE UPPER LIMIT ON THE INTEGRAL IN R FOR
C...  COMPUTING THE AVERAGE TEMPERATURE
C...
C...  THE UPPER LIMIT IS AVAILABLE THROUGH COMMON/C/
      COMMON/C/        RA
C...
      RUPPER=RA
      RETURN
      END
TWO-DIMENSIONAL HEAT CONDUCTION
0.        1.        0.02
   67 1000    1    1  ABS 0.01
TWO-DIMENSIONAL HEAT CONDUCTION
0.        1.        0.02
   67 1000    1    1  ABS 0.01
END OF RUNS
