*APP FLOW01
      SUBROUTINE INITAL
C...
C...  DYNAMICS OF LIQUID TRANSFER FROM A TANK CAR
C...
C...  THE LIQUID IN A TANK CAR, OF LENGTH L AND DIAMETER D, IS TO BE
C...  TRANSFERRED TO TWO VERTICAL STORAGE TANKS.  THE DELIVERY LINES
C...  DISCHARGE AT LEVELS Z1 AND Z2 ABOVE THE PUMP CENTER LINE.  THE
C...  PIPING SYSTEM IS SHOWN BELOW
C...
C...                                         .  .
C...                                         .  .
C...                                     .....  ..... STORAGE
C...            . . .                    .          .  TANK 1
C...         .         .                 .          .
C...       .             .               .          .          .   .
C...      .  CYLINDRICAL  .    ..........+          .          .   .
C...      .   TANK CAR    .    .         ............      .....   .....
C...       .             .     . L1      .          .      .           .
C...         .         .       .         ............      .           .
C...            . . .          ............................+
C...              .            .             L2            .           .
C...              +            .                           .............
C...            .....          .                   STORAGE .           .
C...       PUMP .   ............                    TANK 2 .............
C...            .....    L0
C...              .
C...             ...
C...
C...  THE MATHEMATICAL MODEL FOR THIS SYSTEM, WHICH CAN BE USED TO
C...  CALCULATE
C...
C...     (1)  THE TIME REQUIRED TO EMPTY THE TANK CAR
C...
C...     (2)  THE AMOUNT OF LIQUID PUMPED TO EACH STORAGE TANK (NOTE -
C...          DISCHARGES INTO THE STORAGE TANKS ARE NEVER SUBMERGED)
C...
C...  IS DETAILED BELOW.
C...
C...  THE CONTINUITY BALANCE ON THE TANK CAR IS
C...
C...     DV/DT = D(L*A)/DT = L*(DA/DZ)*(DZ/DT) = -SP*V0
C...
C...  WHERE
C...
C...     V     VOLUME OF LIQUID IN THE TANK CAR
C...
C...     T     TIME
C...
C...     L     LENGTH OF THE TANK CAR
C...
C...     A     CROSS SECTIONAL AREA OF THE LIQUID IN THE TANK CAR
C...
C...     Z     HEIGHT OF LIQUID IN THE TANK CAR
C...
C...     SP    CROSS SECTIONAL AREA OF THE EXIT PIPE FROM THE TANK CAR
C...
C...     V0    VELOCITY IN THE EXIT LINE
C...
C...  V, A AND Z ARE ALL FUNCTIONS OF TIME WHICH IS THE REASON FOR THE
C...  VARIOUS TIME DERIVATIVES IN THE PRECEDING DIFFERENTIAL EQUATION.
C...  A IS RELATED TO Z BY
C...
C...     A = PI*(D/2)**2 -(D**2/8)*(2*ARCCOS((Z - D/2)/(D/2))
C...
C...       - (8/D**2)*(Z - D/2)*SQRT(D**2/4 - (Z - D/2)**2))
C...
C...  FOR WHICH THE DERIVATIVE DA/DZ IS
C...
C...     DA/DZ = (D**2/4)*(2/D)*(1/SQRT(1 - ((Z - D/2)/(D/2))**2))
C...
C...           + SQRT(D**2/4 - (Z - D/2)**2)
C...
C...           - ((Z - D/2)**2)*(1/SQRT(D**2/4 - (Z - D/2)**2))
C...
C...  THE VELOCITIES IN THE LINES CAN BE CALCULATED BY EITHER MOMENTUM
C...  OR ENERGY BALANCES.  IN THIS CASE, WE CHOOSE ENERGY BALANCES.  THE
C...  ENERGY BALANCE FOR THE LINE OF LENGTH L0 IS
C...
C...     D(L0*SP*RHO*(1/(2*GC)*V0**2))/DT
C...
C...        = SP*(PR + (G/GC)*RHO*Z))*V0)
C...
C...        - SP*P*V0 - F0*V0*ABS(V0)*L0*RHO/(2*DP*GC)*V0*SP
C...
C...        + SP*V0*RHO*(-(G/GC)*ZB)
C...
C...  THE ENERGY BALANCE FOR THE LINE OF LENGTH L1 IS
C...
C...     D(L1*SP*RHO*(1/(2*GC)*V1**2))/DT
C...
C...        = SP*P*V1 - SP*PA*V1
C...
C...        - F1*V1*ABS(V1)*L1*RHO/(2*DP*GC)*V1*SP
C...
C...        + SP*VP*RHO*(G/GC)*(ZB - Z1)
C...
C...  THE ENERGY BALANCE FOR THE LINE OF LENGTH L2 IS
C...
C...     D(L2*SP*RHO*(1/(2*GC)*V2**2))/DT
C...
C...        = SP*P*V2 - SP*PA*V2 -
C...
C...        - F2*V2*ABS(V2)*L2*RHO/(2*DP*GC)*V2*SP
C...
C...        + SP*V2*RHO*(G/GC)*(ZB - Z2)
C...
C...  THE PRESSURE RISE ACROSS THE PUMP, PR, IS RELATED TO THE FLOW
C...  THROUGH THE PUMP, Q, BY THE QUADRATIC EQUATION
C...
C...     PR = A0 + A1*Q + A2*Q**2, Q = V0*SP
C...
C...  FROM CONTINUITY AT THE POINT WHERE THE THREE LINES CONNECT,
C...
C...     V0 = V1 + V2
C...
C...  WHICH CAN BE DIFFERENTIATED WITH RESPECT TO T
C...
C...     DV0/DT = DV1/DT + DV2/DT
C...
C...  EACH OF THESE THREE DERIVATIVES ALSO APPEARS IN ONE OF THE
C...  ENERGY BALANCES, I.E.,
C...
C...     DV0/DT = (GC/(L0*RHO))*(PR + (G/GC)*RHO*Z - P)
C...
C...        - F0*ABS(V0)/(2*DP)*V0 - G*ZB/L0
C...
C...     DV1/DT = (GC/(L1*RHO))*(P - PA)
C...
C...        - F1*ABS(V1)/(2*DP)*V1 - (G/L1)*(Z1 - ZB)
C...
C...     DV2/DT = (GC/(L2*RHO))*(P - PA)
C...
C...        - F2*ABS(V2)/(2*DP)*V2 - (G/L2)*(Z2 - ZB)
C...
C...  IF THE DERIVATIVES DV0/DT, DV1/DT AND DV2/DT ARE ELIMINATED
C...  BETWEEN THESE VARIOUS EQUATIONS
C...
C...     (GC/RHO)*(P/L1 + P/L2 + P/L0)
C...
C...     = (GC/RHO)*(PA/L1 + PA/L2 + PR/L0 + (G/GC)*RHO*Z/L0)
C...
C...     - F0*ABS(V0)/(2*DP)*V0 + F1*ABS(V1)/(2*DP)*V1
C...
C...     + F2*ABS(V2)/(2*DP)*V2 - G*(ZB/L0 - (Z1 - ZB)/L1
C...
C...     - (Z2 - ZB)/L2)
C...
C...  THIS EQUATION CAN THEN BE SOLVED FOR THE PRESSURE P AT THE INTER-
C...  SECTION OF THE THREE LINES.  THE RESULTING EQUATION FOR P CAN THEN
C...  BE USED TO CALCULATE P IN THE RHS OF THE ORDINARY DIFFERENTIAL
C...  EQUATIONS (ODES)
C...
C...     P = ((PR/L0 + PA/L1 + PA/L2 + (G/GC)*RHO*Z/L0)
C...
C...       - F0*ABS(V0)*RHO/(2*DP*GC)*V0
C...
C...       + F1*ABS(V1)*RHO/(2*DP*GC)*V1
C...
C...       + F2*ABS(V2)*RHO/(2*DP*GC)*V2
C...
C...       - (RHO*G/GC)*(ZB/L0 - (Z1 - ZB)/L1 - (Z2 - ZB)/L2))
C...
C...       /(1/L0 + 1/L1 + 1/L2)
C...
C...  THE DEPENDENT VARIABLES OF THE MODEL ARE Z (OR V), V0, V1, AND V2.
C...  ALGEBRAIC VARIABLES INCLUDE V (OR Z), P AND PR.  THUS, FOUR INITIAL
C...  CONDITIONS ARE REQUIRED (TWO MORE DEPENDENT VARIABLES, Q1T AND
C...  Q2T, ARE ADDED BELOW, SO A TOTAL OF SIX DEPENDENT INITIAL CONDI-
C...  TIONS WILL ACTUALLY BE REQUIRED)
C...
C...     Z(0), V0(0), V1(0), V2(0), Q1T(0), Q2T(0)
C...
C...  THE NUMERICAL PARAMETERS FOR THE MODEL ARE
C...
C...     RHO = 1000 KG/M**3
C...
C...     VIS = 0.001 KG/(M-SEC)
C...
C...     D = 2.5 M
C...
C...     L = 10 M
C...
C...     L0 = 30 M
C...
C...     ZB = Z2 = 10 M
C...
C...     Z1 = 20 M
C...
C...     L1 = 40 M
C...
C...     L2 = 30 M
C...
C...     DP = 0.075 M
C...
C...     PA = 1.0E+05 PASCALS (NEWTON/M**2 = N/M**2)
C...
C...     PR = 1.27E+06 + 5.27E+06*Q0 - 2.32E+08*Q0**2
C...
C...  SIMULATE THIS SYSTEM AND PLOT V0(T), V1(T), V2(T), Z(T), Q1T(T)
C...  Q2T(T) VS T.  Q1T(T) AND Q2T(T) ARE CUMULATIVE VOLUMES OF LIQUID
C...  FLOWING INTO THE STORAGE TANKS, I.E.,
C...
C...            T                T
C...     Q1T = INT Q1*DT, Q2T = INT Q2*DT
C...            0                0
C...
C...  THE INITIAL CONDITIONS ARE
C...
C...     Z(0) = 2.0 M, V0(0) = V1(0) = V2(0) = Q1T(0) = Q2T(0) = 0
C...
C...  SET THE MODEL NUMERICAL PARAMETERS
C...
C...  COMMON AREA
      COMMON/T/     T, NSTOP, NORUN
     1      /Y/     Z,    V0,    V1,    V2,   Q1T,   Q2T
     2      /F/  DZDT, DV0DT, DV1DT, DV2DT,    Q1,    Q2
     3      /C/   RHO,   VIS,     D,    DP,     L,    L0,    L1,    L2,
     4             ZB,    Z1,    Z2,    PA,     G,    GC,    SP,   C01,
     5            C11,   C21,   C02,   C12,   C22,    C1,    C2,   CP1,
     6            CP2,   CP3,   CP4,    IP
     7      /V/    F0,    F1,    F2,    PR,     P
      REAL          L,    L0,    L1,    L2
C...
C...  SET THE MODEL PARAMETERS
      RHO=1000.
      VIS=0.001
      D=2.5
      DP=0.075
      L=10.
      L0=30.
      L1=40.
      L2=30.
      ZB=10.
      Z1=20.
      Z2=10.
      PA=1.0E+05
      G=9.8
      GC=1.
C...
C...  COMPUTE SOME CONSTANTS
      PI=3.1415927
      SP=PI*(DP**2)/4.
      C01=GC/(L0*RHO)
      C11=GC/(L1*RHO)
      C21=GC/(L2*RHO)
      C02=(G/L0)*(0.-ZB)
      C12=(G/L1)*(Z1-ZB)
      C22=(G/L2)*(Z2-ZB)
      C1=(G/GC)*RHO
      C2=1./(2.*DP)
      CP1=(PA/L1+PA/L2)
      CP2=RHO/(2.*DP*GC)
      CP3=(ZB/L0-(Z1-ZB)/L1-(Z2-ZB)/L2)
      CP4=1./(1./L0+1./L1+1./L2)
C...
C...  MODEL INITIAL CONDITIONS
      Z=2.0
      V0=0.
      V1=0.
      V2=0.
      Q1T=0.
      Q2T=0.
C...
C...  COMPUTE THE INITIAL DERIVATIVES
      CALL DERV
      IP=0
      END
      SUBROUTINE DERV
      COMMON/T/     T, NSTOP, NORUN
     1      /Y/     Z,    V0,    V1,    V2,   Q1T,   Q2T
     2      /F/  DZDT, DV0DT, DV1DT, DV2DT,    Q1,    Q2
     3      /C/   RHO,   VIS,     D,    DP,     L,    L0,    L1,    L2,
     4             ZB,    Z1,    Z2,    PA,     G,    GC,    SP,   C01,
     5            C11,   C21,   C02,   C12,   C22,    C1,    C2,   CP1,
     6            CP2,   CP3,   CP4,    IP
     7      /V/    F0,    F1,    F2,    PR,     P
      COMMON/IO/   NI,    NO
      REAL          L,    L0,    L1,    L2
C...
C...  TEST FOR AN EMPTY TANK CAR
      IF(Z.GT.0.)THEN
C...
C...  MODEL ALGEBRA
C...
C...  FRICTION FACTORS FOR LINES OF L0, L1 AND L2
      CALL FF(V0,F0)
      CALL FF(V1,F1)
      CALL FF(V2,F2)
C...
C...  PUMP PRESSURE
      CALL PP
C...
C...  PRESSURE AT THE INTERSECTION OF THE THREE LINES
      CALL PC
C...
C...  MODEL DIFFERENTIAL EQUATIONS
      CALL DERV1
      CALL DERV2
      CALL DERV3
      CALL DERV4
      CALL DERV5
      CALL DERV6
      RETURN
C...
C...  TANK CAR IS EMPTY
      ELSE
      WRITE(NO,1)Z,T
1     FORMAT(1H ,//,5H Z = ,F8.4,8H AT T = ,F6.2)
C...
C...  WHEN THE SECOND ELEMENT IN COMMON/T/ (E.G., NSTOP) IS SET TO A
C...  NONZERO VALUE, THE INTEGRATION OF THE DERIVATIVES IN COMMON/F/
C...  IS STOPPED AND SUBROUTINE PRINT IS CALLED ONE MORE TIME TO PRINT
C...  THE SOLUTION AT THIS POINT.  DSS/2 THEN GOES ON TO THE NEXT RUN
C...  IF ONE IS PROGRAMMED (I.E., IF THREE MORE LINES OF DATA ARE PRO-
C...  VIDED)
      NSTOP=1
      END IF
      RETURN
      END
      SUBROUTINE DERV1
      COMMON/T/     T, NSTOP, NORUN
     1      /Y/     Z,    V0,    V1,    V2,   Q1T,   Q2T
     2      /F/  DZDT, DV0DT, DV1DT, DV2DT,    Q1,    Q2
     3      /C/   RHO,   VIS,     D,    DP,     L,    L0,    L1,    L2,
     4             ZB,    Z1,    Z2,    PA,     G,    GC,    SP,   C01,
     5            C11,   C21,   C02,   C12,   C22,    C1,    C2,   CP1,
     6            CP2,   CP3,   CP4,    IP
     7      /V/    F0,    F1,    F2,    PR,     P
      REAL          L,    L0,    L1,    L2
C...
C...  FUNCTION DERV1 EVALUATES THE DERIVATIVE DZ/DT
C...
      DZDT=-SP*V0/(L*DADZ(D,Z))
      RETURN
      END
      SUBROUTINE DERV2
      COMMON/T/     T, NSTOP, NORUN
     1      /Y/     Z,    V0,    V1,    V2,   Q1T,   Q2T
     2      /F/  DZDT, DV0DT, DV1DT, DV2DT,    Q1,    Q2
     3      /C/   RHO,   VIS,     D,    DP,     L,    L0,    L1,    L2,
     4             ZB,    Z1,    Z2,    PA,     G,    GC,    SP,   C01,
     5            C11,   C21,   C02,   C12,   C22,    C1,    C2,   CP1,
     6            CP2,   CP3,   CP4,    IP
     7      /V/    F0,    F1,    F2,    PR,     P
      REAL          L,    L0,    L1,    L2
C...
C...  SUBROUTINE DERV2 EVALUATES THE DERIVATIVE DV0/DT
C...
      DV0DT=C01*(PR+C1*Z-P)-F0*ABS(V0)*V0*C2+C02
      RETURN
      END
      SUBROUTINE DERV3
      COMMON/T/     T, NSTOP, NORUN
     1      /Y/     Z,    V0,    V1,    V2,   Q1T,   Q2T
     2      /F/  DZDT, DV0DT, DV1DT, DV2DT,    Q1,    Q2
     3      /C/   RHO,   VIS,     D,    DP,     L,    L0,    L1,    L2,
     4             ZB,    Z1,    Z2,    PA,     G,    GC,    SP,   C01,
     5            C11,   C21,   C02,   C12,   C22,    C1,    C2,   CP1,
     6            CP2,   CP3,   CP4,    IP
     7      /V/    F0,    F1,    F2,    PR,     P
      REAL          L,    L0,    L1,    L2
C...
C...  SUBROUTINE DERV3 EVALUATES THE DERIVATIVE DV1/DT
C...
      DV1DT=C11*(P-PA)-F1*ABS(V1)*V1*C2-C12
      RETURN
      END
      SUBROUTINE DERV4
      COMMON/T/     T, NSTOP, NORUN
     1      /Y/     Z,    V0,    V1,    V2,   Q1T,   Q2T
     2      /F/  DZDT, DV0DT, DV1DT, DV2DT,    Q1,    Q2
     3      /C/   RHO,   VIS,     D,    DP,     L,    L0,    L1,    L2,
     4             ZB,    Z1,    Z2,    PA,     G,    GC,    SP,   C01,
     5            C11,   C21,   C02,   C12,   C22,    C1,    C2,   CP1,
     6            CP2,   CP3,   CP4,    IP
     7      /V/    F0,    F1,    F2,    PR,     P
      REAL          L,    L0,    L1,    L2
C...
C...  SUBROUTINE DERV4 EVALUATES THE DERIVATIVE DV2/DT
C...
      DV2DT=C21*(P-PA)-F2*ABS(V2)*V2*C2-C22
      RETURN
      END
      SUBROUTINE DERV5
      COMMON/T/     T, NSTOP, NORUN
     1      /Y/     Z,    V0,    V1,    V2,   Q1T,   Q2T
     2      /F/  DZDT, DV0DT, DV1DT, DV2DT,    Q1,    Q2
     3      /C/   RHO,   VIS,     D,    DP,     L,    L0,    L1,    L2,
     4             ZB,    Z1,    Z2,    PA,     G,    GC,    SP,   C01,
     5            C11,   C21,   C02,   C12,   C22,    C1,    C2,   CP1,
     6            CP2,   CP3,   CP4,    IP
     7      /V/    F0,    F1,    F2,    PR,     P
      REAL          L,    L0,    L1,    L2
C...
C...  SUBROUTINE DERV5 EVALUATES THE DERIVATIVE Q1
C...
      Q1=V1*SP
      RETURN
      END
      SUBROUTINE DERV6
      COMMON/T/     T, NSTOP, NORUN
     1      /Y/     Z,    V0,    V1,    V2,   Q1T,   Q2T
     2      /F/  DZDT, DV0DT, DV1DT, DV2DT,    Q1,    Q2
     3      /C/   RHO,   VIS,     D,    DP,     L,    L0,    L1,    L2,
     4             ZB,    Z1,    Z2,    PA,     G,    GC,    SP,   C01,
     5            C11,   C21,   C02,   C12,   C22,    C1,    C2,   CP1,
     6            CP2,   CP3,   CP4,    IP
     7      /V/    F0,    F1,    F2,    PR,     P
      REAL          L,    L0,    L1,    L2
C...
C...  SUBROUTINE DERV6 EVALUATES THE DERIVATIVE Q2
C...
      Q2=V2*SP
      RETURN
      END
      SUBROUTINE FF(V,F)
      COMMON/T/     T, NSTOP, NORUN
     1      /Y/     Z,    V0,    V1,    V2,   Q1T,   Q2T
     2      /F/  DZDT, DV0DT, DV1DT, DV2DT,    Q1,    Q2
     3      /C/   RHO,   VIS,     D,    DP,     L,    L0,    L1,    L2,
     4             ZB,    Z1,    Z2,    PA,     G,    GC,    SP,   C01,
     5            C11,   C21,   C02,   C12,   C22,    C1,    C2,   CP1,
     6            CP2,   CP3,   CP4,    IP
     7      /V/    F0,    F1,    F2,    PR,     P
      REAL          L,    L0,    L1,    L2
C...
C...  SUBROUTINE FF CALCULATES THE FRICTION FACTOR
C...
C...  CALCULATE THE REYNOLDS NUMBER
      RE=RHO*ABS(V)*DP/VIS
C...
C...  IF THE REYNOLDS NUMBER IS LESS THAN 0.001, THE FRICTION FACTOR
C...  IS ARBITRARILY SET TO ZERO
      IF(RE.LT.0.001)F=0.
C...
C...  THE FRICTION FACTOR FROM POISEUILLE*S LAW (LAMINAR FLOW)
      IF((RE.GE.0.001).AND.(RE.LT.2000))F=1./RE
C...
C...  THE FRICTION FACTOR FOR TURBULENT FLOW
      IF(RE.GE.2000.)F=0.183/RE**0.2
      RETURN
      END
      SUBROUTINE PP
      COMMON/T/     T, NSTOP, NORUN
     1      /Y/     Z,    V0,    V1,    V2,   Q1T,   Q2T
     2      /F/  DZDT, DV0DT, DV1DT, DV2DT,    Q1,    Q2
     3      /C/   RHO,   VIS,     D,    DP,     L,    L0,    L1,    L2,
     4             ZB,    Z1,    Z2,    PA,     G,    GC,    SP,   C01,
     5            C11,   C21,   C02,   C12,   C22,    C1,    C2,   CP1,
     6            CP2,   CP3,   CP4,    IP
     7      /V/    F0,    F1,    F2,    PR,     P
      REAL          L,    L0,    L1,    L2
C...
C...  SUBROUTINE PP CALCULATES THE PUMP PRESSURE
C...
C...  CALCULATE THE VOLUMETRIC FLOW RATE FOR USE IN THE PUMP EQUATION
      Q0=V0*SP
C...
C...  CALCULATE THE PRESSURE FROM THE PUMP CHARACTERISTIC EQUATION
      PR=1.27E+06+5.27E+06*Q0-2.32E+08*Q0**2
      RETURN
      END
      SUBROUTINE PC
      COMMON/T/     T, NSTOP, NORUN
     1      /Y/     Z,    V0,    V1,    V2,   Q1T,   Q2T
     2      /F/  DZDT, DV0DT, DV1DT, DV2DT,    Q1,    Q2
     3      /C/   RHO,   VIS,     D,    DP,     L,    L0,    L1,    L2,
     4             ZB,    Z1,    Z2,    PA,     G,    GC,    SP,   C01,
     5            C11,   C21,   C02,   C12,   C22,    C1,    C2,   CP1,
     6            CP2,   CP3,   CP4,    IP
     7      /V/    F0,    F1,    F2,    PR,     P
      REAL          L,    L0,    L1,    L2
C...
C...  SUBROUTINE PC COMPUTES THE PRESSURE WHERE THE THREE LINES ARE
C...  CONNECTED
C...
C...  THE FOUR CONSTANTS, CP1, CP2, CP3 AND CP4 WERE PRECOMPUTED IN
C...  SUBROUTINE INITAL FOR EFFICIENCY (SINCE INITAL IS CALLED ONLY
C...  ONCE IN EACH RUN)
      P=(PR/L0+CP1+C1*Z/L0-F0*ABS(V0)*V0*CP2
     1                    +F1*ABS(V1)*V1*CP2
     2                    +F2*ABS(V2)*V2*CP2
     3                    -C1*CP3)*CP4
      RETURN
      END
      FUNCTION DADZ(D,Z)
C...
C...  FUNCTION DADZ COMPUTES THE DERIVATIVE OF THE WETTED CROSS
C...  SECTIONAL AREA OF THE TANK, A, WITH RESPECT TO THE LIQUID
C...  HEIGHT, Z
C...
C...  ONE HALF THE TANK DIAMETER IS USED IN SEVERAL PLACES IN THE EQUA-
C...  TION FOR DA/DZ, AND THEREFORE IT IS EVALUATED ONCE FOR REPEATED
C...  USE
      D2=D/2.
C...
C...  THE FOLLOWING THREE TERMS IN THE DERIVATIVE WERE DERIVED BY
C...  ANALYTICAL DIFFERENTIATION OF THE EQUATION FOR A(Z).  THE PROGRAM-
C...  MING CONTAINS NEEDLESSLY REPETITIVE ARITHMETIC, E.G., THE SQUARE
C...  ROOT IS COMPUTED THREE TIMES INSTEAD OF COMPUTING IT ONCE AND
C...  USING IT THREE TIMES.  THIS INEFFICIENT PROGRAMMING WAS DONE TO
C...  MORE CLEARLY DEMONSTRATE THE CORRESPONDENCE BETWEEN THE EQUATION
C...  FOR DA/DZ AND THE PROGRAMMING.  IN FACT, PROFESSOR C. A. SILEBI
C...  POINTED OUT THAT THE DERIVATIVE DA/DZ CAN BE WRITTEN DOWN FROM
C...  GEOMETRY IN ONE LINE AS DA = DZ*2*SQRT(R**2 - (Z-R)**2)) OR WITH
C...  MINOR REARRANGEMENT, DA/DZ = SQRT(D**2 - (2*Z - D)**2) WHICH IS
C...  IDENTICAL TO THE FOLLOWING EQUATIONS AFTER SIMPLIFICATION (R = D/2)
      TERM1=(D2**2)*(1./D2)*(1./SQRT(1.-((Z-D2)/D2)**2))
      TERM2=SQRT(D2**2-(Z-D2)**2)
      TERM3=-((Z-D2)**2)/SQRT(D2**2-(Z-D2)**2)
      DADZ=TERM1+TERM2+TERM3
      RETURN
      END
      SUBROUTINE PRINT(NI,NO)
      COMMON/T/     T, NSTOP, NORUN
     1      /Y/     Z,    V0,    V1,    V2,   Q1T,   Q2T
     2      /F/  DZDT, DV0DT, DV1DT, DV2DT,    Q1,    Q2
     3      /C/   RHO,   VIS,     D,    DP,     L,    L0,    L1,    L2,
     4             ZB,    Z1,    Z2,    PA,     G,    GC,    SP,   C01,
     5            C11,   C21,   C02,   C12,   C22,    C1,    C2,   CP1,
     6            CP2,   CP3,   CP4,    IP
     7      /V/    F0,    F1,    F2,    PR,     P
C...
C...  DIMENSION THE ARRAYS FOR PLOTTING
      DIMENSION ZP(51), VP(3,51), QP(2,51), TP(51)
      REAL          L,    L0,    L1,    L2
C...
C...  PRINT THE SOLUTION EVERY FIFTH CALL TO PRINT
      IP=IP+1
      IF(((IP-1)/5*5).NE.(IP-1))GO TO 3
      WRITE(NO,2)
2     FORMAT(9X,1HT,9X,1HZ,8X,2HV0,8X,2HV1,8X,2HV2,/,
     1      15X,5HDZ/DT,4X,6HDV0/DT,4X,6HDV1/DT,4X,6HDV2/DT,/)
C...
C...  PRINT THE NUMERICAL SOLUTION AND ITS DERIVATIVES
      WRITE(NO,1)T,     Z,    V0,    V1,    V2,
     1               DZDT, DV0DT, DV1DT, DV2DT
1     FORMAT(F10.2,4F10.3,/,10X,4F10.3,/)
C...
C...  STORE THE SOLUTION FOR PLOTTING
3     ZP(IP)=Z
      VP(1,IP)=V0
      VP(2,IP)=V1
      VP(3,IP)=V2
      QP(1,IP)=Q1T
      QP(2,IP)=Q2T
      TP(IP)=T
C...
C...  PLOT THE SOLUTION
      IF((NSTOP.EQ.0).AND.(IP.LT.51))RETURN
      CALL TPLOTS(1,IP,TP,ZP)
      WRITE(NO,10)
10    FORMAT(1H ,//,45H Z VS T                                       )
      CALL TPLOTS(3,IP,TP,VP)
      WRITE(NO,11)
11    FORMAT(1H ,//,45H 1 - V0, 2 - V1, 3 - V2 VS T                  )
      CALL TPLOTS(2,IP,TP,QP)
      WRITE(NO,12)
12    FORMAT(1H ,//,45H 1 - Q1T, 2 - Q2T VS T                        )
      RETURN
      END
DYNAMICS OF LIQUID TRANSFER FROM A TANK CAR
0.        1000.     20.
    6 1000    1    1  REL 0.001
END OF RUNS
*APP FLOW02
      SUBROUTINE INITAL
C...
C...  DYNAMICS OF A HOLDING TANK WITH TWO LONG LINES AND A PUMP
C...
C...  DEVELOP A COMPUTER SIMULATION FOR THE HYDRAULIC SYSTEM SHOWN
C...  BELOW
C...                            CLOSED
C...                             TANK
C...                         ............
C...                         .   P(T)   .
C...                         ............
C...                         .          .
C...    ......               .          .
C...    .    .    D1, L1     .          .
C...    .PUMP...............+.     A    .
C...    .    . P1            .          .
C...    ......               .          .
C...       +                 .          .
C...       .                 .          .
C...       .                 .          .
C...       . Q1               ....................................+
C...                                              D2, L2
C...
C...  THE OUTLET PRESSURE OF THE PUMP, P1, IS RELATED TO THE FLOW
C...  RATE THROUGH THE PUMP, Q1, BY THE QUADRATIC EQUATION
C...
C...     P1 = A0 + A1*Q1 + A2*(Q1**2)
C...
C...  WHERE A0, A1 AND A2 ARE GIVEN CONSTANTS FOR THE PUMP.  THE OTHER
C...  PARAMETERS OF THE MODEL ARE
C...
C...  D1, D2      DIAMETERS OF THE INLET AND OUTLET LINES OF THE TANK
C...
C...  L1, L2      LENGTHS OF THE INLET AND OUTLET LINES OF THE TANK
C...
C...  L           HEIGHT OF THE TANK.  THE INLET LINE ENTERS THE TANK
C...              AT L/2
C...
C...  A           TANK CROSS SECTIONAL AREA
C...
C...  H(T)        HEIGHT OF LIQUID IN THE TANK
C...
C...  P(T)        PRESSURE ABOVE THE LIQUID IN THE TANK
C...
C...  T           TIME
C...
C...  THE DISCHARGE PRESSURE OF THE OUTLET LINE IS ATMOSPHERIC.
C...
C...  THE DETAILS OF THE MODEL FOLLOW
C...
C...  A TOTAL MASS BALANCE FOR THE FLUID INSIDE THE SURGE VESSEL GIVES
C...
C...     D(H*A)/DT = Q1 - Q2 (OR DH/DT = (1/A)*(Q1 - Q2)), H(0) = H0
C...
C...  IN ORDER TO EVALUTE Q1 AND Q2, WE NEED TO WRITE A MOMENTUM BALANCE
C...  FOR THE FLUID IN EACH SECTION OF PIPE
C...
C...     D(L1*S1*RHO*V1)/DT = P1*S1 - (P + E)*S1
C...
C...                    -(F*V1*ABS(V1)*RHO*L1)/(2*D1*GC)*S1, V1(0) = V10
C...
C...     D(L2*S2*RHO*V2)/DT = (P + (G/GC)*RHO*H)*S2 - PATM*S2
C...
C...                    -(F*V2*ABS(V2)*RHO*L2)/(2*D2*GC)*S2, V2(0) = V20
C...
C...   WHERE
C...
C...          0                             IF H LE 0.5*VTANK/A
C...      E =
C...          (G/GC)*RHO*(H - 0.5*VTANK/A)  IF H GT 0.5*VTANK/A
C...
C...   AND
C...
C...      Q1 = V1*S1, Q2 = V2*S2
C...
C...      P1 = 1.27E+06 + 5.29E+06*Q1 - 2.32E+08*(Q1**2)
C...
C...         (P1 IN NEWTON/M**3 = N/M**3, Q1 IN M**3/SEC)
C...
C...      RHO = 1000 KG/M**3, VIS = 0.001 KG/(M-SEC)
C...
C...      T = 27 C, A = 2 M**2, L = 2 M
C...
C...      L1 = 200 M, D1 = 0.05 M, L2 = 100 M, D2 = 0.05 M
C...
C...      PATM = 1.01E+05 N/M**2 (NOTE - 1 N/M**2 = 1 PASCAL)
C...
C...      R = (1.01E+05)*(22.4E-03)/(273.16) PASCALS-M**3/K
C...
C...  THE INITIAL CONDITIONS FOR THE DYNAMIC MODEL ARE
C...
C...     H(0) = 1 M, V1(0) = V2(0) = 0 M/SEC
C...
C...  AND THE ASSUMED INITIAL PRESSURE IS TAKEN AS
C...
C...     P(0) = 1.0E+05 N/M**2
C...
C...  IN ORDER TO CALCULATE P(T), THE PRESSURE IN THE SURGE VESSEL, WE
C...  NEED AN EQUATION OF STATE
C...
C...      P = (NMOLES*R*T)/(VTANK - H*A)
C...
C...  NMOLES, THE NUMBER OF MOLS OF GAS IN THE SURGE VESSEL, CAN BE
C...  CALCULATED FROM THE INITIAL CONDITION IN THE VESSEL, H(0), AND
C...  THE ASSUMED INITIAL PRESSURE, P(0).
C...
C...  COMMON AREA
      COMMON/T/     T,  NFIN, NORUN
     1      /Y/    V1,    V2,     H
     2      /F/ DV1DT, DV2DT,  DHDT
     3      /C/     L,    L1,    L2,     D,    D1,    D2,    S1,    S2,
     4            RHO,   VIS,    TA,     A, VTANK,     G,    GC,     R,
     5           PATM,NMOLES,    IP
     6      /V/     P,    P1,     E,    F1,    F2,    Q1,    Q2
      REAL          L,    L1,    L2,NMOLES
C...
C...  SET THE MODEL PARAMETERS
      G=9.8
      GC=1.
      RHO=1000.
      VIS=0.001
      TA=273.16+27.
      A=2.
      L=2.
      L1=200.
      L2=100.
      D1=0.05
      D2=0.05
      H0=1.
      V10=0.
      V20=0.
      P=1.0E+05
      PATM=1.01E+05
C...
C...  COMPUTE SOME MODEL PARAMETERS
      PI=3.1415927
      S1=(PI*D1**2)/4.
      S2=(PI*D2**2)/4.
      VTANK=L*A
      R=1.01E+05*22.4E-03/273.16
      NMOLES=P*(VTANK-H0*A)/(R*TA)
C...
C...  SET THE MODEL INITIAL CONDITIONS
      H=H0
      V1=V10
      V2=V20
C...
C...  SET THE MODEL INITIAL DERIVATIVES
      CALL DERV
      IP=0
      RETURN
      END
      SUBROUTINE DERV
      COMMON/T/     T,  NFIN, NORUN
     1      /Y/    V1,    V2,     H
     2      /F/ DV1DT, DV2DT,  DHDT
     3      /C/     L,    L1,    L2,     D,    D1,    D2,    S1,    S2,
     4            RHO,   VIS,    TA,     A, VTANK,     G,    GC,     R,
     5           PATM,NMOLES,    IP
     6      /V/     P,    P1,     E,    F1,    F2,    Q1,    Q2
      REAL          L,    L1,    L2,NMOLES
C...
C...  MODEL ALGEBRA
C...
C...     LINE 1
         RE=D1*ABS(V1)*RHO/VIS
         IF(RE.LT.0.001)F1=0.
         IF((RE.GE.0.001).AND.(RE.LT.2000.))F1=64./RE
         IF(RE.GE.2000.)F1=0.184/RE**0.2
         FRIC1=F1*V1*ABS(V1)*RHO*L1*S1/(2.*D1*GC)
         Q1=V1*S1
         P1=1.27E+06+5.29E+06*Q1-2.32E+08*Q1**2
C...
C...     LINE 2
         RE=D2*ABS(V2)*RHO/VIS
         IF(RE.LT.0.001)F2=0.
         IF((RE.GE.0.001).AND.(RE.LT.2000.))F2=64./RE
         IF(RE.GE.2000.)F2=0.184/RE**0.2
         FRIC2=F2*V2*ABS(V2)*RHO*L2*S2/(2.*D2*GC)
         Q2=V2*S2
C...
C...     TANK
         P=NMOLES*R*TA/(VTANK-H*A)
         IF(H.LE.0.5*VTANK/A)E=0.
         IF(H.GT.0.5*VTANK/A)E=(G/GC)*RHO*(H-0.5*VTANK/A)
C...
C...  MODEL DIFFERENTIAL EQUATIONS
C...
C...     LINE 1
         DV1DT=(1./(L1*S1*RHO))*(P1*S1-(P+E)*S1-FRIC1)
C...
C...     LINE 2
         DV2DT=(1./(L2*S2*RHO))*((P+G*RHO*H/GC)*S2-PATM*S2-FRIC2)
C...
C...     TANK
         DHDT=(1./A)*(Q1-Q2)
      RETURN
      END
      SUBROUTINE PRINT(NI,NO)
      COMMON/T/     T,  NFIN, NORUN
     1      /Y/    V1,    V2,     H
     2      /F/ DV1DT, DV2DT,  DHDT
     3      /C/     L,    L1,    L2,     D,    D1,    D2,    S1,    S2,
     4            RHO,   VIS,    TA,     A, VTANK,     G,    GC,     R,
     5           PATM,NMOLES,    IP
     6      /V/     P,    P1,     E,    F1,    F2,    Q1,    Q2
      REAL          L,    L1,    L2,NMOLES
C...
C...  DIMENSION THE ARRAYS FOR PLOTTING
      DIMENSION TP(51), PP(2,51), HP(51), VP(2,51), QP(2,51)
C...
C...  PRINT THE NUMERICAL SOLUTION EVERY FIFTH CALL TO SUBROUTINE PRINT
      IP=IP+1
      IF(((IP-1)/5*5).NE.(IP-1))GO TO 2
      WRITE(NO,1)T,H,V1,V2,DHDT,DV1DT,DV2DT,F1,F2,E,Q1,Q2,P,P1
1     FORMAT(1H ,//,9X,1HT,9X,1HH,8X,2HV1,8X,2HV2,5X,5HDH/DT,
     1 4X,6HDV1/DT,4X,6HDV2/DT,/,8X,2HF1,8X,2HF2,9X,1HE,8X,2HQ1,
     2 8X,2HQ2,9X,1HP,8X,2HP1,/,7E10.3,/,7E10.3)
C...
C...  STORE THE SOLUTION FOR PLOTTING
2     TP(IP)=T
      PP(1,IP)=P1
      PP(2,IP)=P
      HP(IP)=H
      VP(1,IP)=V1
      VP(2,IP)=V2
      QP(1,IP)=Q1
      QP(2,IP)=Q2
C...
C...  PLOT THE SOLUTION
      IF(IP.LT.51)RETURN
      CALL TPLOTS(2,IP,TP,PP)
      WRITE(NO,11)
11    FORMAT(1H ,//,46H 1 - P, 2 - P1 VS T                           )
      CALL TPLOTS(1,IP,TP,HP)
      WRITE(NO,12)
12    FORMAT(1H ,//,46H H VS T                                       )
      CALL TPLOTS(2,IP,TP,VP)
      WRITE(NO,13)
13    FORMAT(1H ,//,46H 1 - V1, 2 - V2 VS T                          )
      CALL TPLOTS(2,IP,TP,QP)
      WRITE(NO,14)
14    FORMAT(1H ,//,46H 1 - Q1, 2 - Q2 VS T                          )
      IP=IP+1
      RETURN
      END
DYNAMICS OF A HOLDING TANK WITH TWO LONG LINES AND A PUMP
0.        1000.     20.
    3 1000    1    1  REL 0.001
END OF RUNS
*APP FLOW03
      SUBROUTINE INITAL
C...
C...  DRAINAGE FROM A VERTICAL CYLINDRICAL TANK
C...
C...  CONSIDER THE DRAINAGE OF THE LIQUID FROM THE TANK DEPICTED BELOW
C...
C...                Q0 = 10
C...                    .........
C...                            .
C...                          . . .
C...                       .    .    .
C...                     .      +      .
C...                     . .         . .
C...                     .    . . .    .
C...                     .             .
C...                     .             .
C...                     .+.... D ....+.
C...                     .             .
C...                     .             .
C...                     .             .
C...                     .             .
C...                       .    O   .
C...                          . . .
C...                            .
C...                            .
C...                            .....+ Q1 = 0.61*AO*SQRT(2*G*H)
C...
C...  A MATERIAL BALANCE ON THE TANK GIVES
C...
C...     D(A*H)/DT = Q0 - Q1, H(0) = H0
C...
C...  WHERE
C...
C...     H     HEIGHT OF LIQUID IN THE TANK
C...
C...     T     TIME
C...
C...     A     TANK CROSS SECTIONAL AREA
C...
C...     AO    CROSS SECTIONAL AREA OF THE CIRCULAR HOLE AT THE BOTTOM
C...           OF THE TANK
C...
C...     Q0    VOLUMETRIC FLOW RATE INTO THE TANK
C...
C...     Q1    VOLUMETRIC FLOW RATE OUT OF THE TANK
C...
C...     H0    INITIAL VALUE OF H
C...
C...     G     ACCELERATION OF GRAVITY
C...
C...  THE QUESTION OF INTEREST IS THE TIME REQUIRED FOR THE TANK TO
C...  REACH STEADY STATE (Q1 = Q0) STARTING FROM SOME INITIAL CONDITION,
C...  H(0).
C...
C...  COMMON AREA
      COMMON/T/     T, NSTOP, NORUN
     1      /Y/     H
     2      /F/  DHDT
     3      /C/     A,    AO,    Q0,     G
     4      /V/    Q1,    IP
C...
C...  SET THE MODEL PARAMETERS
      PI=3.1415927
C...
C...  THE TANK AND HOLE DIAMETERS ARE 12 AND 0.6, RESPECTIVELY
      A =PI*(12./2.)**2
      AO=PI*(0.6/2.)**2
      Q0=1.
      G=9.8
C...
C...  SET THE MODEL INITIAL CONDITION
      H=12.
C...
C...  COMPUTE THE INITIAL DERIVATIVE
      CALL DERV
      IP=0
      RETURN
      END
      SUBROUTINE DERV
      COMMON/T/     T, NSTOP, NORUN
     1      /Y/     H
     2      /F/  DHDT
     3      /C/     A,    AO,    Q0,     G
     4      /V/    Q1,    IP
C...
C...  MODEL ALGEBRA
      Q1=0.61*AO*SQRT(2.*G*H)
C...
C...  DIFFERENTIAL EQUATION
      DHDT=(1./A)*(Q0-Q1)
      RETURN
      END
      SUBROUTINE PRINT(NI,NO)
      COMMON/T/     T, NSTOP, NORUN
     1      /Y/     H
     2      /F/  DHDT
     3      /C/     A,    AO,    Q0,     G
     4      /V/    Q1,    IP
C...
C...  PRINT A HEADING FOR THE NUMERICAL SOLUTION
      IP=IP+1
      IF(IP.EQ.1)WRITE(NO,1)
1     FORMAT(9X,1HT,11X,1HH,7X,5HDH/DT,10X,2HQ0,10X,2HQ1)
C...
C...  PRINT THE SOLUTION
      WRITE(NO,2)T,H,DHDT,Q0,Q1
2     FORMAT(F10.0,F12.2,F12.5,2F12.2)
      IP=IP+1
      RETURN
      END
DRAINAGE FROM A VERTICAL CYLINDRICAL TANK
0.        4000.     400.
    1 1000    1    1  REL 0.001
END OF RUNS
*APP FLOW04
      SUBROUTINE INITAL
C...
C...  DRAINAGE FROM A HORIZONTAL CYLINDRICAL TANK
C...
C...  CONSIDER THE DRAINAGE FROM A HORIZONTAL CYLINDRICAL TANK DEPICTED
C...  BELOW
C...
C...                    +............ L ............+
C...                    .............................
C...                   . .                           .
C...                  .   .                           .
C...                  .   .                           .
C...                   . .                           .
C...                    ............... .............
C...                                   .
C...                                   .
C...                                   +
C...                                   Q = K*SQRT(Z)
C...
C...  THE RATE OF FLOW FROM THROUGH AN ORIFICE AT THE BOTTOM OF THE
C...  TANK, Q, IS PROPORTIONAL TO THE SQUARE ROOT OF THE HEIGHT OF
C...  LIQUID, Z, IN THE TANK.
C...
C...  A CONTINUITY BALANCE ON THE TANK GIVES
C...
C...     DV/DT = D(L*A)/DT = L*(DA/DZ)*(DZ/DT) = -K*SQRT(Z)       (1)
C...
C...  WHERE
C...
C...     V      VOLUME OF LIQUID IN THE TANK
C...
C...     T      TIME
C...
C...     L      LENGTH OF THE TANK
C...
C...     A      WETTED CROSS SECTIONAL AREA
C...
C...     Z      HEIGHT OF LIQUID IN THE TANK
C...
C...     K      CONSTANT CHARACTERIZING THE OPENING IN THE BOTTOM OF THE
C...            TANK
C...
C...  THE DIFFERENTIAL EQUATION REQUIRES THE RELATIONSHIP A(Z) SO THAT
C...  ONLY ONE DEPENDENT VARIABLE, Z, REMAINS
C...
C...     A = PI*(D/2)**2 -(D**2/8)*(2*ARCCOS((Z - D/2)/(D/2))
C...                                                              (2)
C...       - (8/D**2)*(Z - D/2)*SQRT(D**2/4 - (Z - D/2)**2))
C...
C...  FOR WHICH THE DERIVATIVE DA/DZ IS
C...
C...     DA/DZ = (D**2/4)*(2/D)*(1/SQRT(1 - ((Z - D/2)/(D/2))**2))
C...
C...           + SQRT(D**2/4 - (Z - D/2)**2)                      (3)
C...
C...           - ((Z - D/2)**2)*(1/SQRT(D**2/4 - (Z - D/2)**2))
C...
C...  EQUATION (1) REQUIRES AN INITIAL CONDITION
C...
C...     Z(0) = Z0                                                (4)
C...
C...  ALSO, THE CUMULATIVE VOLUME OF LIQUID FLOWING FROM THE TANK IS
C...  TO BE COMPUTED
C...
C...           T
C...     QT = INT Q*DT                                            (5)
C...           0
C...
C...  COMMON AREA
      COMMON/T/     T, NSTOP, NORUN
     1      /Y/     Z,    QT
     2      /F/  DZDT,     Q
     3      /C/     L,     D,     K,    IP
      REAL          L,     K
C...
C...  SET THE MODEL PARAMETERS
      L=3.
      D=2.
      K=10.
C...
C...  SET THE INITIAL CONDITIONS
      Z=1.9
      QT=0.
C...
C...  COMPUTE THE INITIAL DERIVATIVE
      CALL DERV
      IP=0
      RETURN
      END
      SUBROUTINE DERV
      COMMON/T/     T, NSTOP, NORUN
     1      /Y/     Z,    QT
     2      /F/  DZDT,     Q
     3      /C/     L,     D,     K,    IP
      COMMON/IO/   NI,    NO
      REAL          L,     K
C...
C...  TEST FOR AN EMPTY TANK
      IF(Z.GT.0.)THEN
C...
C...  MODEL ALGEBRA
      Q=K*SQRT(Z)
C...
C...  MODEL DIFFERENTIAL EQUATION
      DZDT=-(1./(L*DADZ(D,Z)))*Q
      RETURN
C...
C...  IF THE TANK IS EMPTY, THE RUN IS TERMINATED
      ELSE
      WRITE(NO,1)T,Z
1     FORMAT(1H ,//8H AT T = ,F8.3,5H Z = ,E11.3)
      STOP
      END IF
      END
      SUBROUTINE PRINT(NI,NO)
      COMMON/T/     T, NSTOP, NORUN
     1      /Y/     Z,    QT
     2      /F/  DZDT,     Q
     3      /C/     L,     D,     K,    IP
      REAL          L,     K
C...
C...  PRINT A HEADING FOR THE NUMERICAL SOLUTION
      IF(IP.EQ.0)WRITE(NO,1)
1     FORMAT(9X,1HT,11X,1HZ,7X,5HDZ/DT,11X,1HQ,10X,2HQT,7X,5HDA/DZ)
C...
C...  PRINT THE NUMERICAL SOLUTION
      DAZ=DADZ(D,Z)
      WRITE(NO,2)T,Z,DZDT,Q,QT,DAZ
2     FORMAT(F10.4,3E12.3,E12.4,E12.3)
      IP=IP+1
      RETURN
      END
      FUNCTION DADZ(D,Z)
C...
C...  FUNCTION DADZ COMPUTES THE DERIVATIVE OF THE WETTED CROSS
C...  SECTIONAL AREA OF THE TANK, A, WITH RESPECT TO THE LIQUID
C...  HEIGHT, Z
C...
C...  ONE HALF THE TANK DIAMETER IS USED IN SEVERAL PLACES IN THE EQUA-
C...  TION FOR DA/DZ, AND THEREFORE IT IS EVALUATED ONCE FOR REPEATED
C...  USE
      D2=D/2.
C...
C...  THE FOLLOWING THREE TERMS IN THE DERIVATIVE WERE DERIVED BY
C...  ANALYTICAL DIFFERENTIATION OF THE EQUATION FOR A(Z).  THE PROGRAM-
C...  MING CONTAINS NEEDLESSLY REPETITIVE ARITHMETIC, E.G., THE SQUARE
C...  ROOT IS COMPUTED THREE TIMES INSTEAD OF COMPUTING IT ONCE AND
C...  USING IT THREE TIMES.  THIS INEFFICIENT PROGRAMMING WAS DONE TO
C...  MORE CLEARLY DEMONSTRATE THE CORRESPONDENCE BETWEEN THE EQUATION
C...  FOR DA/DZ AND THE PROGRAMMING
      TERM1=(D2**2)*(1./D2)*(1./SQRT(1.-((Z-D2)/D2)**2))
      TERM2=SQRT(D2**2-(Z-D2)**2)
      TERM3=-((Z-D2)**2)/SQRT(D2**2-(Z-D2)**2)
      DADZ=TERM1+TERM2+TERM3
C...
C...  AFTER CODING THE EQUATION FOR DA/DZ, PROFESSOR C. A. SILEBI POINT-
C...  ED OUT THAT DA/DZ CAN BE DERIVED FROM DIFFERENTIAL CALCULUS SIMPLY
C...  AS
C...
C...     DA = DZ*2*SQRT(R**2 - (Z - R)**2)
C...
C...  OR
C...
C...     DA/DZ = SQRT(D**2 - (2*Z-D)**2)
C...
C...  WHERE R = D/2.  THIS EQUATION FOR DA/DZ IS THE SAME AS THE EQUA-
C...  TION THAT IS PROGRAMNMED AFTER THE LATTER IS SIMPLIFIED.
      RETURN
      END
DRAINAGE FROM A HORIZONTAL CYLINDRICAL TANK
0.        2.0       0.04
    2 1000    1    1  REL 0.001
END OF RUNS
*APP FLOW05
      SUBROUTINE INITAL
C...
C...  STEADY STATE SIMULATION VIA DYNAMIC ANALYSIS
C...
C...  CONSIDER THE STEADY STATE SIMULATION OF THE FOLLOWING HYDRAULIC
C...  SYSTEM CONSISTING OF A SURGE TANK, TWO LONG LINES AND A PUMP
C...  FEEDING THE SYSTEM
C...                            CLOSED
C...                             TANK
C...                         ............
C...                         .     P    .
C...                         ............ H
C...                         .          .
C...    ......               .          .
C...    .    .    D1, L1     .          .
C...    .PUMP...............+.     A    .
C...    .    . P1            .          .
C...    ......               .          .
C...       +                 .          .
C...       .                 .          .
C...       .                 .          .
C...       . Q1               ....................................+
C...                                              D2, L2
C...
C...  THE VARIABLES OF INTEREST IN SIMULATING THIS SYSTEM ARE THE FLOW
C...  RATE THROUGH THE TWO LINES, Q1 AND Q2 (WHICH WILL BE EQUAL), THE
C...  HEIGHT OF LIQUID IN THE TANK, H, AND THE PRESSURE OF THE GAS AT
C...  THE TOP OF THE TANK, P.
C...
C...  THE OUTLET PRESSURE OF THE PUMP, P1, IS RELATED TO THE FLOW
C...  RATE THROUGH THE PUMP, Q1, BY THE QUADRATIC EQUATION
C...
C...     P1 = A0 + A1*Q1 + A2*(Q1**2)
C...
C...  WHERE A0, A1 AND A2 ARE GIVEN CONSTANTS FOR THE PUMP.  THE OTHER
C...  PARAMETERS OF THE MODEL ARE
C...
C...  D1, D2      DIAMETERS OF THE INLET AND OUTLET LINES OF THE TANK
C...
C...  L1, L2      LENGTHS OF THE INLET AND OUTLET LINES OF THE TANK
C...
C...  L           HEIGHT OF THE TANK.  THE INLET LINE ENTERS THE TANK
C...              AT L/2
C...
C...  A           TANK CROSS SECTIONAL AREA
C...
C...  H           HEIGHT OF LIQUID IN THE TANK
C...
C...  P           PRESSURE ABOVE THE LIQUID IN THE TANK
C...
C...  THE DISCHARGE PRESSURE OF THE OUTLET LINE IS ATMOSPHERIC.
C...
C...  THE DETAILS OF THE MODEL FOLLOW
C...
C...  A TOTAL MASS BALANCE FOR THE FLUID INSIDE THE SURGE TANK GIVES
C...
C...     Q1 = Q2                                                  (1)
C...
C...  FORCE BALANCES WRITTEN ON THE TWO LINES GIVE
C...
C...     0 = P1*S1 - (P + E)*S1
C...                                                              (2)
C...                    -(F*V1*ABS(V1)*RHO*L1)/(2*D1*GC)*S1
C...
C...     0 = (P + (G/GC)*RHO*H)*S2 - PATM*S2
C...                                                              (3)
C...                    -(F*V2*ABS(V2)*RHO*L2)/(2*D2*GC)*S2
C...
C...   WHERE
C...
C...          0                             IF H LE 0.5*VTANK/A
C...      E =
C...          (G/GC)*RHO*(H - 0.5*VTANK/A)  IF H GT 0.5*VTANK/A
C...
C...   AND
C...
C...      Q1 = V1*S1, Q2 = V2*S2                               (4)(5)
C...
C...  THE DISCHARGE PRESSURE-FLOW RATE RELATIONSHIP FOR THE PUMP IS
C...
C...      P1 = 1.27E+06 + 5.29E+06*Q1 - 7.06E+04*(Q1**2)          (6)
C...
C...         (P1 IN NEWTON/M**3 = N/M**3, Q1 IN M**3/SEC)
C...
C...  THE IDEAL GAS LAW IS ASSUMED TO APPLY TO THE GAS IN THE SURGE
C...  TANK
C...
C...      P = (NMOLES*R*T)/(VTANK - H*A)                          (7)
C...
C...  WHERE NMOLES IS THE NUMBER OF MOLES OF GAS IN THE TANK.
C...
C...  THE MODEL THEREFORE HAS SEVEN EQUATIONS FOR THE SEVEN UNKNOWNS,
C...  V1, V2, Q1, Q2, H, P AND P1.  HOWEVER, SIMULTANEOUS SOLUTION OF
C...  OF THE SEVEN EQUATIONS CAN BE REPLACED BY THE SOMEWHAT SIMPLER
C...  ITERATIVE PROCEDURE OF
C...
C...     (1)  ASSUME Q1
C...
C...     (2)  CALCULATE Q2 FROM EQUATION (1)
C...
C...     (3)  CALCULATE V1 AND V2 FROM EQUATIONS (4) AND (5)
C...
C...     (4)  CALCULATE P1 FROM EQUATION (6)
C...
C...     (5)  CALCULATE H AND P FROM EQUATIONS (2) AND (3)
C...
C...     (6)  CHECK P FROM EQUATION (7)
C...
C...     (7)  RETURN TO (1) IF P FROM (5) AND (6) DO NOT AGREE
C...
C...  WHILE THIS ITERATIVE PROCEDURE IS NOT COMPLICATED, THE COMPLEXITY
C...  OF THE CALCULATION WILL INCREASE RAPIDLY IF A SYSTEM WITH MORE
C...  COMPONENTS (PIPES, TANKS, PUMPS, VALVES) IS ANALYZED.  THEREFORE,
C...  A DIFFERENT CALCULATIONAL APPROACH WHICH BASICALLY AVOIDS MULTI-
C...  DIMENSIONAL SEARCHES OR ITERATIVE PROCEDURES WOULD BE GENERALLY
C...  USEFUL.
C...
C...  ONE APPROACH IS TO SOLVE AN ASSOCIATED DYNAMIC MODEL TO STEADY
C...  STATE.  THIS APPROACH IS DEMONSTRATED BY CONVERTING THE PRECEDING
C...  STEADY STATE ALGEBRAIC EQUATIONS TO UNSTEADY STATE (DYANMIC)
C...  DIFFERENTIAL EQUATIONS.
C...
C...  A DYNAMIC MATERIAL BALANCE FOR THE TANK GIVES
C...
C...     D(H*A)/DT = Q1 - Q2 (OR DH/DT = (1/A)*(Q1 - Q2)), H(0) = H0
C...
C...  IN ORDER TO EVALUTE Q1 AND Q2, WE NEED TO WRITE A MOMENTUM BALANCE
C...  FOR THE FLUID IN EACH SECTION OF PIPE
C...
C...     D(L1*S1*RHO*V1)/DT = P1*S1 - (P + E)*S1
C...
C...                    -(F*V1*ABS(V1)*RHO*L1)/(2*D1*GC)*S1, V1(0) = V10
C...
C...     D(L2*S2*RHO*V2)/DT = (P + (G/GC)*RHO*H)*S2 - PATM*S2
C...
C...                    -(F*V2*ABS(V2)*RHO*L2)/(2*D2*GC)*S2, V2(0) = V20
C...
C...   WHERE
C...
C...          0                             IF H LE 0.5*VTANK/A
C...      E =
C...          (G/GC)*RHO*(H - 0.5*VTANK/A)  IF H GT 0.5*VTANK/A
C...
C...   AND
C...
C...      Q1 = V1*S1, Q2 = V2*S2
C...
C...      P1 = 1.27E+06 + 5.29E+06*Q1 - 7.06E+04*(Q1**2)
C...
C...         (P1 IN NEWTON/M**3 = N/M**3, Q1 IN M**3/SEC)
C...
C...  IN ORDER TO CALCULATE P(T), THE PRESSURE IN THE SURGE TANK, WE
C...  NEED AN EQUATION OF STATE
C...
C...      P = (NMOLES*R*T)/(VTANK - H*A)
C...
C...  NMOLES, THE NUMBER OF MOLS OF GAS IN THE SURGE TANK, CAN BE
C...  CALCULATED FROM THE INITIAL CONDITION IN THE TANK, H(0), AND
C...  AN ASSUMED INITIAL PRESSURE, P(0).
C...
C...  THE MODEL PARAMETERS ARE
C...
C...      RHO = 1000 KG/M**3, VIS = 0.001 KG/(M-SEC)
C...
C...      T = 27 C, A = 2 M**2, L = 2 M
C...
C...      L1 = 200 M, D1 = 0.05 M, L2 = 100 M, D2 = 0.05 M
C...
C...      PATM = 1.01E+05 N/M**2 (NOTE - 1 N/M**2 = 1 PASCAL)
C...
C...      R = (1.01E+05)*(22.4E-03)/(273.16) PASCALS-M**3/K
C...
C...  THE INITIAL CONDITIONS FOR THE DYNAMIC MODEL ARE
C...
C...      H(0) = 1 M, V1(0) = V2(0) = 0 M/SEC
C...
C...  AND THE ASSUMED INITIAL PRESSURE, WHICH DEFINES NMOLES, IS
C...
C...      P(0) = 1.0E+05 N/M**2
C...
C...  THE DYNAMIC EQUATIONS CAN THEN BE INTEGRATED TO THE DESIRED
C...  STEADY STATE SOLUTION
C...
C...  COMMON AREA
      COMMON/T/     T,  NFIN, NORUN
     1      /Y/    V1,    V2,     H
     2      /F/ DV1DT, DV2DT,  DHDT
     3      /C/     L,    L1,    L2,     D,    D1,    D2,    S1,    S2,
     4            RHO,   VIS,    TA,     A, VTANK,     G,    GC,     R,
     5           PATM,NMOLES,    IP
     6      /V/     P,    P1,     E,    F1,    F2,    Q1,    Q2
      COMMON/IO/   NI,    NO
      REAL          L,    L1,    L2,NMOLES
C...
C...  SET THE MODEL PARAMETERS
      G=9.8
      GC=1.
      RHO=1000.
      VIS=0.001
      TA=273.16+27.
      A=2.
      L=2.
      L1=200.
      L2=100.
      D1=0.05
      D2=0.05
      H0=1.
      V10=0.
      V20=0.
      P=1.0E+05
      PATM=1.01E+05
C...
C...  COMPUTE SOME MODEL PARAMETERS
      PI=3.1415927
      S1=(PI*D1**2)/4.
      S2=(PI*D2**2)/4.
      VTANK=L*A
      R=1.01E+05*22.4E-03/273.16
      NMOLES=P*(VTANK-H0*A)/(R*TA)
C...
C...  SET THE MODEL INITIAL CONDITIONS
      H=H0
      V1=V10
      V2=V20
C...
C...  SET THE MODEL INITIAL DERIVATIVES
      CALL DERV
      IP=0
C...
C...  PRINT THE INITIAL NUMBER OF MOLES OF GAS IN THE TANK
      WRITE(NO,1)NMOLES
1     FORMAT(1H ,//,24H INITIAL MOLES OF GAS = ,E10.3)
      RETURN
      END
      SUBROUTINE DERV
      COMMON/T/     T,  NFIN, NORUN
     1      /Y/    V1,    V2,     H
     2      /F/ DV1DT, DV2DT,  DHDT
     3      /C/     L,    L1,    L2,     D,    D1,    D2,    S1,    S2,
     4            RHO,   VIS,    TA,     A, VTANK,     G,    GC,     R,
     5           PATM,NMOLES,    IP
     6      /V/     P,    P1,     E,    F1,    F2,    Q1,    Q2
      REAL          L,    L1,    L2,NMOLES
C...
C...  MODEL ALGEBRA
C...
C...     LINE 1
         RE=D1*ABS(V1)*RHO/VIS
         IF(RE.LT.0.001)F1=0.
         IF((RE.GE.0.001).AND.(RE.LT.2000.))F1=64./RE
         IF(RE.GE.2000.)F1=0.184/RE**0.2
         FRIC1=F1*V1*ABS(V1)*RHO*L1*S1/(2.*D1*GC)
         Q1=V1*S1
         P1=1.27E+06+5.29E+06*Q1-7.06E+04*Q1**2
C...
C...     LINE 2
         RE=D2*ABS(V2)*RHO/VIS
         IF(RE.LT.0.001)F2=0.
         IF((RE.GE.0.001).AND.(RE.LT.2000.))F2=64./RE
         IF(RE.GE.2000.)F2=0.184/RE**0.2
         FRIC2=F2*V2*ABS(V2)*RHO*L2*S2/(2.*D2*GC)
         Q2=V2*S2
C...
C...     TANK
         P=NMOLES*R*TA/(VTANK-H*A)
         IF(H.LE.0.5*VTANK/A)E=0.
         IF(H.GT.0.5*VTANK/A)E=(G/GC)*RHO*(H-0.5*VTANK/A)
C...
C...  MODEL DIFFERENTIAL EQUATIONS
C...
C...     LINE 1
         DV1DT=(1./(L1*S1*RHO))*(P1*S1-(P+E)*S1-FRIC1)
C...
C...     LINE 2
         DV2DT=(1./(L2*S2*RHO))*((P+G*RHO*H/GC)*S2-PATM*S2-FRIC2)
C...
C...     TANK
         DHDT=(1./A)*(Q1-Q2)
      RETURN
      END
      SUBROUTINE PRINT(NI,NO)
      COMMON/T/     T,  NFIN, NORUN
     1      /Y/    V1,    V2,     H
     2      /F/ DV1DT, DV2DT,  DHDT
     3      /C/     L,    L1,    L2,     D,    D1,    D2,    S1,    S2,
     4            RHO,   VIS,    TA,     A, VTANK,     G,    GC,     R,
     5           PATM,NMOLES,    IP
     6      /V/     P,    P1,     E,    F1,    F2,    Q1,    Q2
      REAL          L,    L1,    L2,NMOLES
C...
C...  DIMENSION THE ARRAYS FOR PLOTTING
      DIMENSION TP(51), PP(2,51), HP(51), VP(2,51), QP(2,51)
C...
C...  PRINT THE NUMERICAL SOLUTION EVERY FIFTH CALL TO SUBROUTINE PRINT
      IP=IP+1
      IF(((IP-1)/5*5).NE.(IP-1))GO TO 2
      WRITE(NO,1)T,H,V1,V2,DHDT,DV1DT,DV2DT,F1,F2,E,Q1,Q2,P,P1
1     FORMAT(1H ,//,9X,1HT,9X,1HH,8X,2HV1,8X,2HV2,5X,5HDH/DT,
     1 4X,6HDV1/DT,4X,6HDV2/DT,/,8X,2HF1,8X,2HF2,9X,1HE,8X,2HQ1,
     2 8X,2HQ2,9X,1HP,8X,2HP1,/,7E10.3,/,7E10.3)
C...
C...  STORE THE SOLUTION FOR PLOTTING
2     TP(IP)=T
      PP(1,IP)=P1
      PP(2,IP)=P
      HP(IP)=H
      VP(1,IP)=V1
      VP(2,IP)=V2
      QP(1,IP)=Q1
      QP(2,IP)=Q2
C...
C...  PLOT THE SOLUTION
      IF(IP.LT.51)RETURN
      CALL TPLOTS(2,IP,TP,PP)
      WRITE(NO,11)
11    FORMAT(1H ,//,46H 1 - P, 2 - P1 VS T                           )
      CALL TPLOTS(1,IP,TP,HP)
      WRITE(NO,12)
12    FORMAT(1H ,//,46H H VS T                                       )
      CALL TPLOTS(2,IP,TP,VP)
      WRITE(NO,13)
13    FORMAT(1H ,//,46H 1 - V1, 2 - V2 VS T                          )
      CALL TPLOTS(2,IP,TP,QP)
      WRITE(NO,14)
14    FORMAT(1H ,//,46H 1 - Q1, 2 - Q2 VS T                          )
      IP=IP+1
      RETURN
      END
STEADY STATE SIMULATION VIA DYNAMIC ANALYSIS
0.        1000.     20.
    3 1000    1    1  REL 0.001
END OF RUNS
*APP FLOW06
      SUBROUTINE INITAL
C...
C...  LIQUID TRANSFER BETWEEN TANKS VIA A CENTRIFUGAL PUMP
C...
C...  A CENTRIFUGAL PUMP IS USED TO TRANSFER A LIQUID FROM ONE TANK TO
C...  ANOTHER, WITH BOTH TANKS AT THE SAME LEVEL, AS INDICATED BELOW*
C...
C...         .    P1   .                            .    P3    .
C...         ...........       P2                   ............
C...         .         .     ......................+.          .
C...         .         .  .....+ .     LONG LINE    .          .
C...         ...........  .  .....                  ............
C...              .       .   PUMP
C...              .........
C...
C...  THE PUMP RAISES THE PRESSURE OF THE LIQUID FROM P1 (ATMOSPHERIC)
C...  TO P2, BUT THIS PRESSURE IS GRADUALLY LOST BECAUSE OF THE FRICTION
C...  INSIDE THE LONG PIPE AND, AT THE EXIT, P3 IS BACK DOWN TO ATMOS-
C...  PHERIC PRESSURE.
C...
C...  THE PRESSURE RISE IN PSIG ACROSS THE PUMP IS GIVEN APPROXIMATELY
C...  BY THE EMPIRICAL RELATION
C...
C...     P2 - P1 = A - B*(Q**1.5)
C...
C...  WHERE A AND B ARE CONSTANTS THAT DEPEND ON THE PARTICULAR PUMP
C...  BEING USED, AND Q IS THE FLOW RATE IN GPM.  THE PRESSURE DROP
C...  IN A HORIZONTAL PIPE OF LENGTH L FEET AND INTERNAL DIAMETER D
C...  IN IS GIVEN BY
C...
C...     P2 - P3 = 2.16E-04*FM*RHO*L*(Q**2)/(D**5)
C...
C...  WHERE RHO IS THE DENSITY (LBM/FT**3) OF THE LIQUID BEING PUMPED.
C...  FOR THE PRESENT PURPOSES, THE MOODY FRICTION FACTOR, FM, IS
C...  TREATED AS A CONSTANT ALTHOUGH IT REALLY DEPENDS ON THE PIPE
C...  ROUGHNESS AND ON THE REYNOLDS NUMBER.
C...
C...  THE NUMERICAL VALUES OF THE CONSTANTS ARE
C...
C...                               CASE 1                CASE 2
C...
C...     D (IN)                    1.049                 2.469
C...
C...     L (FT)                    50.0                  210.6
C...
C...     RHO (LBM/FT**3)
C...         KEROSENE              51.4                  ----
C...         WATER                 ----                  62.4
C...
C...     FM (DIMENSIONLESS)        0.032                 0.026
C...
C...     A (PSI)                   16.7                  38.5
C...
C...     B (PSI/(GPM)**1.5)        0.052                 0.0296
C...
C...  THE PROGRAM OUTPUT IS TO CONSIST OF THE FLOW RATE, Q, AND THE
C...  INTERMEDIATE PRESSURE, P2.
C...
C...  *
C...   CARNAHAN, B., ET AL, APPLIED NUMERICAL METHODS,, JOHN WILEY AND
C...   SONS, INC., NEW YORK, 1969, PROB. 3.39, P205.
C...
C...  THE NONLINEAR ALGEBRAIC EQUATIONS DEFINING THE FLOW THROUGH THE
C...  CONNECTING LINE AND LINE PRESSURE ARE SOLVED VIA AN ASSOCIATED
C...  DIFFERENTIAL EQUATION BY DAVIDENKO*S METHOD (A DIFFERENTIAL FORM
C...  OF NEWTON*S METHOD).  ALTHOUGH ONLY A SINGLE NONLINEAR ALGEBRAIC
C...  EQUATION IS SOLVED IN THIS PROBLEM, DAVIDENKO*S METHOD CAN EASILY
C...  BE EXTENDED TO SYSTEMS OF NONLINEAR EQUATIONS, IN DIRECT ANALOGY
C...  WITH THE MULTI-DIMENSIONAL NEWTON*S METHOD.  DETAILS ARE AVAIL-
C...  ABLE FROM W. E. SCHIESSER, MOUNTAINTOP, BUILDING A (111), LEHIGH
C...  UUNIVERSITY, BETHLEHEM, PA 18015 USA.
C...
C...  SUBROUTINE INITAL SETS THE INITIAL CONDITION FOR THE DAVIDENKO
C...  DIFFERENTIAL EQUATION
C...
      COMMON/T/T,NFIN,NORUN/Y/Q/F/DQDT
      COMMON/PARM/
     1          D,     XL,    RHO,     FM,      A,      B
      Q=100.
      IF(NORUN.EQ.1)GO TO 1
      D=2.469
      XL=210.6
      RHO=62.4
      FM=0.026
      A=38.5
      B=0.0296
C...
C...  CALL SUBROUTINE DERV TO COMPUTE THE INITIAL DERIVATIVE DQ/DT
1     CALL DERV
      RETURN
      END
      SUBROUTINE DERV
C...
C...  SUBROUTINE DERV COMPUTES THE DERIVATIVE OF THE DAVIDENKO DIFFER-
C...  ENTIAL EQUATION
C...
      COMMON/T/T,NFIN,NORUN/Y/Q/F/DQDT
      DQDT=-F(Q)/DFDQ(Q)
      RETURN
      END
      FUNCTION F(Q)
C...
C...  FUNCTION F(Q) COMPUTES THE FUNCTION TO BE ZEROED
C...
      COMMON/PARM/
     1          D,     XL,    RHO,     FM,      A,      B
      P1=14.7
      TERM1=A-B*Q**1.5+P1
      P3=14.7
      TERM2=2.16E-04*FM*RHO*XL*Q*Q/D**5+P3
      F=TERM1-TERM2
      RETURN
      END
      FUNCTION DFDQ(Q)
C...
C...  FUNCTION DFDQ COMPUTES THE DERIVATIVE OF THE FUNCTION TO BE
C...  ZEROED
C...
      COMMON/PARM/
     1          D,     XL,    RHO,     FM,      A,      B
      TERM1=-B*1.5*Q**0.5
      TERM2=2.16E-04*FM*RHO*XL*2.*Q/D**5
      DFDQ=TERM1-TERM2
      RETURN
      END
      BLOCK DATA
C...
C...  BLOCK DATA SETS THE PROBLEM PARAMETERS AND PASSES THEM THROUGH
C...  COMMON/PARM/ TO OTHER SUBROUTINES  /
C...
      COMMON/PARM/
     1          D,     XL,    RHO,     FM,      A,      B
      DATA      D,     XL,    RHO,     FM,      A,      B/
     1      1.049,   50.0,   51.4,  0.032,   16.7,  0.052/
      END
      SUBROUTINE PRINT(NI,NO)
C...
C...  SUBROUTINE PRINT PRINTS THE NUMERICAL SOLUTION.  THE LEFT AND
C...  RIGHT SIDES OF THE NONLINEAR ALGEBRAIC EQUATIONS DEFINING THE FLOW
C...  ARE COMPUTED AND PRINTED, AS WELL AS THE SOLUTION (FLOW), IN
C...  SUBROUTINE PRINT
C...
      COMMON/T/T,NFIN,NORUN/Y/Q/F/DQDT
      COMMON/PARM/
     1          D,     XL,    RHO,     FM,      A,      B
      P1=14.7
      TERM1=A-B*Q**1.5+P1
      P3=14.7
      TERM2=2.16E-04*FM*RHO*XL*Q*Q/D**5+P3
      WRITE(NO,1)T,Q,DQDT,TERM1,TERM2
1     FORMAT(10H      T = ,E11.3,10H      Q = ,E11.3,10H  DQ/DT = ,E11.3
     1      ,10H     P2 = ,E11.3,10H     P2 = ,E11.3)
      RETURN
      END
CARNAHAN ET AL, APPLIED NUMERICAL METHODS, PROB. 3.39, FIRST CASE
0.        10.       1.
    1 1000    1    1  REL 0.001
CARNAHAN ET AL, APPLIED NUMERICAL METHODS, PROB. 3.39, SECOND CASE
0.        10.       1.
    1 1000    1    1  REL 0.001
END OF RUNS
*APP FLOW07
      SUBROUTINE INITAL
C...
C...  ISENTROPIC DISCHARGE OF A PERFECT GAS FROM A DUCT - FIRST
C...  APPROACH
C...
C...  THE FOLLOWING PARTIAL DIFFERENTIAL EQUATIONS (PDES) HAVE BEEN
C...  GIVEN FOR THE ISENTROPIC DISCHARGE OF A PERFECT GAS FROM A DUCT*
C...
C...     U  = -EXP(A*V)*V  - U*U                                  (1)
C...      T              X      X
C...
C...     V  = -U*V  - U                                           (2)
C...      T       X    X
C...
C...  WITH THE BOUNDARY CONDITIONS
C...
C...     U(0,T) = 0                                               (3)
C...
C...     V(1,T) = 0 IF U(1,0) GE 0
C...                                                              (4)
C...     V(1,T) = (1/A)*ALOG*(1 - (A/2)*U(1,T)**2), U(1,0) LT 0
C...
C...  AND INITIAL CONDITIONS
C...
C...     U(X,0) = 0, V(X,0) = V0                               (5)(6)
C...
C...  *VON ROSENBERG, D. U., METHODS FOR THE NUMERICAL SOLUTION OF
C...  PARTIAL DIFFERENTIAL EQUATIONS, AMERICAN ELSEVIER PUBLISHING
C...  COMPANY, INC., 1969, PP 72-73, 78-79.
C...
      COMMON/T/T,NFIN,NRUN/Y/U(21),V(21)/F/UT(21),VT(21)
      COMMON/PARM/A,V0,DX,N,IP
C...
C...  SET PARAMETERS A AND V0, NUMBER OF SPATIAL GRID POINTS, SPATIAL
C...  INTEGRATION INTERVAL, PRINT CONTROL VARIABLE
      A=0.4
      V0=0.741
      N=21
      DX=1./FLOAT(N-1)
      IP=0
C...
C...  INITIAL CONFITIONS (5), (6)
      DO 1 I=1,N
      U(I)=0.
1     V(I)=V0
      RETURN
      END
      SUBROUTINE DERV
      COMMON/T/T,NFIN,NRUN/Y/U(21),V(21)/F/UT(21),VT(21)
      COMMON/PARM/A,V0,DX,N
C...
C...  THE OUTPUT UNIT NUMBER IS REQUIRED TO PRINT AN ERROR MESSAGE
      COMMON/IO/NI,NO
C...
C...  STEP THROUGH N-1 INCREMENTS FOR EQUATION (1), INCLUDING BOUNDARY
C...  CONDITIONS (3)
      U(1)=0.
      UT(1)=0.
      DO 1 I=2,N
C...
C...  EQUATION (1)
      UT(I)=-0.5*(EXP(A*V(I))+EXP(A*V(I-1)))*(V(I)-V(I-1))/DX
     1      -0.5*(U(I)+U(I-1))*(U(I)-U(I-1))/DX
1     CONTINUE
C...
C...  STEP THROUGH N-1 INCREMENTS IN X FOR EQUATION (2), INCLUDING
C...  BOUNDARY CONDITION (4)
      V(N)=0.
      VT(N)=0.
      IF(U(N).GE.0.)GO TO 6
C...
C...  FOR RUN NO. 1, ONLY THE FIRST EQUATION OF BOUNDARY CONDITION
C...  (4) IS USED.  OTHERWISE, IF U(1,T) LT 0, THE RUN IS TERMINATED
      IF(NRUN.NE.1)GO TO 4
      WRITE(NO,7)T,U(N)
7     FORMAT(1H ,//,8H AT T = ,F8.3,10H U(1,T) = ,E11.3,/,
     1      25H SO THE RUN IS TERMINATED)
      NFIN=1
      RETURN
C...
C...
C...  FOR RUN NO. 2, THE SECOND EQUATION OF BOUNDARY CONDITION (4)
C...  IS USED
4     V(N)=(1./A)*ALOG(ABS(1.-A*(U(N)**2)/2.))
6     NM1=N-1
      DO 5 I=1,NM1
C...
C...  EQUATION (2)
      VT(I)=-0.5*(U(I+1)+U(I))*(V(I+1)-V(I))/DX
     1      -(U(I+1)-U(I))/DX
5     CONTINUE
      RETURN
      END
      SUBROUTINE PRINT(NI,NO)
      COMMON/T/T,NFIN,NRUN/Y/U(21),V(21)/F/UT(21),VT(21)
      COMMON/PARM/A,V0,DX,N
C...
C...  PRINT HEADING
      IF(IP.EQ.0)WRITE(NO,2)A,V0
2     FORMAT(2X,4HA = ,E9.2,2X,5HV0 = ,E9.2)
      IP=IP+1
C...
C...  PRINT SOLUTION
1     WRITE(NO,3)T
3     FORMAT(/,2X,4HT = ,E9.2,/,
     111H     X=0   ,11H    X=0.2  ,11H    X=0.4  ,
     211H    X=0.6  ,11H    X=0.8  ,11H    X=1.0  )
      WRITE(NO,4)(U(I),I=1,N,4),(V(I),I=1,N,4)
4     FORMAT(6E11.3)
      RETURN
      END
VON ROSENBERG, D. U., METHODS FOR NUM SOLN OF PDES, PP. 72-74, PP. 78-81
0.        2.0       0.5
   42 1000    1    1  ABS 0.001
VON ROSENBERG, D. U., METHODS FOR NUM SOLN OF PDES, PP. 72-74, PP. 78-81
0.        2.0       0.5
   42 1000    1    1  ABS 0.001
END OF RUNS
*APP FLOW08
      SUBROUTINE INITAL
C...
C...  ISENTROPIC DISCHARGE OF A PERFECT GAS FROM A DUCT - SECOND
C...  APPROACH
C...
C...  THE FOLLOWING PARTIAL DIFFERENTIAL EQUATIONS (PDES) HAVE BEEN
C...  GIVEN FOR THE ISENTROPIC DISCHARGE OF A PERFECT GAS FROM A DUCT*
C...
C...     U  = -EXP(A*V)*V  - U*U                                  (1)
C...      T              X      X
C...
C...     V  = -U*V  - U                                           (2)
C...      T       X    X
C...
C...  WITH THE BOUNDARY CONDITIONS
C...
C...     U(0,T) = 0                                               (3)
C...
C...     V(1,T) = 0 IF U(1,0) GE 0
C...                                                              (4)
C...     V(1,T) = (1/A)*ALOG*(1 - (A/2)*U(1,T)**2), U(1,0) LT 0
C...
C...  AND INITIAL CONDITIONS
C...
C...     U(X,0) = 0, V(X,0) = V0                               (5)(6)
C...
C...  *VON ROSENBERG, D. U., METHODS FOR THE NUMERICAL SOLUTION OF
C...  PARTIAL DIFFERENTIAL EQUATIONS, AMERICAN ELSEVIER PUBLISHING
C...  COMPANY, INC., 1969, PP 72-73, 78-79.
C...
C...  THIS SECOND APPROACH DIFFERS FROM THE FIRST APPROACH (CODED IN
C...  SEPARATE SUBROUTINES INITAL, DERV AND PRINT) IN THE FOLLOWING
C...  WAYS
C...
C...     (1)  FIRST APPROACH
C...
C...          (1.1)  THE APPROXIMATIONS FOR THE DERIVATIVES UX AND VX
C...                 ARE PROGRAMMED EXPLICITLY AS TWO-POINT (FIRST-
C...                 ORDER) FINITE DIFFERENCES.
C...
C...          (1.2)  THE NONLINEAR COEFFICIENTS IN EQUATION (1) ARE
C...                 AVERAGED OVER GRID POINTS I-1 AND I, AND THE NON-
C...                 COEFFICIENTS IN EQUATION (2) ARE AVERAGED OVER
C...                 GRID POINTS I AND I+1.  ALTHOUGH THIS TYPE OF
C...                 AVERAGING IS COMMONPLACE, IT APPEARS TO BE BASIC-
C...                 ALLY INCORRECT, AT LEAST IN THE PRESENT CONTEXT,
C...                 SINCE THE CORRESPONDING TIME DERIVATIVES, UT(I)
C...                 AND VT(I), ARE OBVIOUSLY EVALUATED AT GRID POINT
C...                 I, AND NOT AT AN AVERAGED SPATIAL POSITION (BETWEEN
C...                 I-1 AND I, OR I AND I+1).
C...
C...     (2)  SECOND APPROACH
C...
C...          (2.1)  THE APPROXIMATIONS FOR THE DERIVATIVES UX AND VX
C...                 ARE COMPUTED BY TWO-POINT UPWIND APPROXIMATIONS
C...                 IN RUNS 1 AND 2 (BY CALLS TO SUBROUTINE DSS012),
C...                 AND BY FIVE-POINT BIASED UPWIND APPROXIMATIONS IN
C...                 RUNS 3 AND 4 (BY CALLS TO SUBROUTINE DSS020).
C...
C...          (2.2)  THE NONLINEAR COEFFICIENTS IN EQUATIONS (1) AND (2)
C...                 ARE COMPUTED AT GRID POINT I.  THIS SEEMS MORE
C...                 APPROPRIATE THAN THE AVERAGING USED IN THE FIRST
C...                 APPROACH (AND HAS THE ADDITIONAL ADVANTAGE THAT THE
C...                 CODING OF EQUATIONS (1) AND (2) MORE CLOSELY RESEM-
C...                 BLES THE EQUATIONS THEMSELVES).
C...
C...  IN ANY CASE, THE NUMERICAL SOLUTIONS DIFFER SUBSTANTIALLY IN THE
C...  TWO APPROACHES, WHICH LEADS TO THE COMMON SITUATION OF TRYING TO
C...  DECIDE WHICH SOLUTION IS THE BEST.  THE LOGICAL CHOICE IS THE
C...  SOLUTION FROM RUNS 3 AND 4 OF THE SECOND APPROACH, SINCE (1) THE
C...  SPATIAL DERIVATIVES ARE COMPUTED BY THE MOST ACCURATE DIFFERENT-
C...  IATION FORMULAS AND (2) THE AVERAGING OF THE NONLINEAR COEFFI-
C...  CIENTS IS AVOIDED.
C...
      COMMON/T/     T,  NFIN,  NRUN
     1      /Y/ U(21), V(21)
     2      /F/UT(21),VT(21)
     3      /S/UX(21),VX(21)
     4      /C/     A,    V0,     N,    IP
C...
C...  SET PARAMETERS A AND V0, NUMBER OF SPATIAL GRID POINTS, SPATIAL
C...  INTEGRATION INTERVAL, PRINT CONTROL VARIABLE
      A=0.4
      V0=0.741
      N=21
      IP=0
C...
C...  INITIAL CONFITIONS (5), (6)
      DO 1 I=1,N
      U(I)=0.
1     V(I)=V0
      RETURN
      END
      SUBROUTINE DERV
      COMMON/T/     T,  NFIN,  NRUN
     1      /Y/ U(21), V(21)
     2      /F/UT(21),VT(21)
     3      /S/UX(21),VX(21)
     4      /C/     A,    V0,     N,    IP
C...
C...  FOR RUNS 1 AND 2, SUBROUTINE DERV1 IS CALLED, WHICH IN TURN CALLS
C...  SUBROUTINE DSS012 FOR THE COMPUTATION OF THE SPATIAL DERIVATIVES
C...  IN EQUATIONS (1) AND (2)
      IF(NRUN.LE.2)THEN
         CALL DERV1
         RETURN
C...
C...  FOR RUNS 3 AND 4, SUBROUTINE DERV2 IS CALLED, WHICH IN TURN CALLS
C...  SUBROUTINE DSS020 FOR THE COMPUTATION OF THE SPATIAL DERIVATIVES
C...  IN EQUATIONS (1) AND (2)
      ELSE
         CALL DERV2
      END IF
      RETURN
      END
      SUBROUTINE DERV1
      COMMON/T/     T,  NFIN,  NRUN
     1      /Y/ U(21), V(21)
     2      /F/UT(21),VT(21)
     3      /S/UX(21),VX(21)
     4      /C/     A,    V0,     N,    IP
C...
C...  THE OUTPUT UNIT NUMBER IS REQUIRED TO PRINT AN ERROR MESSAGE
      COMMON/IO/NI,NO
C...
C...  STEP THROUGH N-1 INCREMENTS FOR EQUATION (1), INCLUDING BOUNDARY
C...  CONDITIONS (3)
C...
C...  FOR RUN NO. 1, ONLY THE FIRST EQUATION OF BOUNDARY CONDITION (4)
C...  IS USED
      IF(NRUN.EQ.1)THEN
         IF(U(N).GE.0.)THEN
            V(N)=0.
C...
C...     IF U(1,T) LT 0, THE RUN IS TERMINATED
         ELSE
            WRITE(NO,2)T,U(N)
2           FORMAT(1H ,//,8H AT T = ,F8.3,10H U(1,T) = ,E11.3,/,
     1      25H SO THE RUN IS TERMINATED)
            NRUN=1
         END IF
C...
C...  FOR RUN NO. 2, BOTH EQUATIONS OF BOUNDARY CONDITION (4) ARE USED
      ELSE
         IF(U(N).GE.0.)THEN
            V(N)=0.
C...
C...     IF U(1,T) LT 0, THE SECOND EQUATION OF BOUNDARY CONDITION (4)
C...     IS USED
         ELSE
            V(N)=(1./A)*(ALOG(1.-(A/2.)*U(N)**2))
         END IF
      END IF
C...
C...  COMPUTE THE SPATIAL DERIVATIVES, UX, VX
      CALL DSS012(0.,1.,N,U,UX,+1.)
      CALL DSS012(0.,1.,N,V,VX,-1.)
C...
C...  EQUATIONS (1), (2)
      DO 1 I=1,N
      UT(I)=-EXP(A*V(I))*VX(I)-U(I)*UX(I)
      VT(I)=-U(I)*VX(I)-UX(I)
1     CONTINUE
C...
C...  THE TEMPORAL DERIVATIVES AT THE BOUNDARIES ARE ZEROED (SINCE
C...  U(0,T) AND V(1,T) ARE SET BY BOUNDARY CONDITIONS (3) AND (4))
      UT(1)=0.
      VT(N)=0.
      RETURN
      END
      SUBROUTINE DERV2
      COMMON/T/     T,  NFIN,  NRUN
     1      /Y/ U(21), V(21)
     2      /F/UT(21),VT(21)
     3      /S/UX(21),VX(21)
     4      /C/     A,    V0,     N,    IP
C...
C...  THE OUTPUT UNIT NUMBER IS REQUIRED TO PRINT AN ERROR MESSAGE
      COMMON/IO/NI,NO
C...
C...  STEP THROUGH N-1 INCREMENTS FOR EQUATION (1), INCLUDING BOUNDARY
C...  CONDITIONS (3)
C...
C...  FOR RUN NO. 3, ONLY THE FIRST EQUATION OF BOUNDARY CONDITION (4)
C...  IS USED
      IF(NRUN.EQ.3)THEN
         IF(U(N).GE.0.)THEN
            V(N)=0.
C...
C...     IF U(1,T) LT 0, THE RUN IS TERMINATED
         ELSE
            WRITE(NO,2)T,U(N)
2           FORMAT(1H ,//,8H AT T = ,F8.3,10H U(1,T) = ,E11.3,/,
     1      25H SO THE RUN IS TERMINATED)
            NRUN=1
         END IF
C...
C...  FOR RUN NO. 4, BOTH EQUATIONS OF BOUNDARY CONDITION (4) ARE USED
      ELSE
         IF(U(N).GE.0.)THEN
            V(N)=0.
C...
C...     IF U(1,T) LT 0, THE SECOND EQUATION OF BOUNDARY CONDITION (4)
C...     IS USED
         ELSE
            V(N)=(1./A)*(ALOG(1.-(A/2.)*U(N)**2))
         END IF
      END IF
C...
C...  COMPUTE THE SPATIAL DERIVATIVES, UX, VX
      CALL DSS020(0.,1.,N,U,UX,+1.)
      CALL DSS020(0.,1.,N,V,VX,-1.)
C...
C...  EQUATIONS (1), (2)
      DO 1 I=1,N
      UT(I)=-EXP(A*V(I))*VX(I)-U(I)*UX(I)
      VT(I)=-U(I)*VX(I)-UX(I)
1     CONTINUE
C...
C...  THE TEMPORAL DERIVATIVES AT THE BOUNDARIES ARE ZEROED (SINCE
C...  U(0,T) AND V(1,T) ARE SET BY BOUNDARY CONDITIONS (3) AND (4))
      UT(1)=0.
      VT(N)=0.
      RETURN
      END
      SUBROUTINE PRINT(NI,NO)
      COMMON/T/     T,  NFIN,  NRUN
     1      /Y/ U(21), V(21)
     2      /F/UT(21),VT(21)
     3      /S/UX(21),VX(21)
     4      /C/     A,    V0,     N,    IP
C...
C...  PRINT HEADING
      IF(IP.EQ.0)WRITE(NO,2)A,V0
2     FORMAT(2X,4HA = ,E9.2,2X,5HV0 = ,E9.2)
      IP=IP+1
C...
C...  PRINT SOLUTION
1     WRITE(NO,3)T
3     FORMAT(/,2X,4HT = ,E9.2,/,
     111H     X=0   ,11H    X=0.2  ,11H    X=0.4  ,
     211H    X=0.6  ,11H    X=0.8  ,11H    X=1.0  )
      WRITE(NO,4)(U(I),I=1,N,4),(V(I),I=1,N,4)
4     FORMAT(6E11.3)
      RETURN
      END
TWO-POINT BIASED UPWIND APPROXIMATION OF UX AND VX (DSS012)
0.        2.0       0.5
   42 1000    1    1  ABS 0.001
TWO-POINT BIASED UPWIND APPROXIMATION OF UX AND VX (DSS012)
0.        2.0       0.5
   42 1000    1    1  ABS 0.001
FIVE-POINT BIASED UPWIND APPROXIMATION OF UX AND VX (DSS020)
0.        2.0       0.5
   42 1000    1    1  ABS 0.001
FIVE-POINT BIASED UPWIND APPROXIMATION OF UX AND VX (DSS020)
0.        2.0       0.5
   42 1000    1    1  ABS 0.001
END OF RUNS
*APP FLOW09
      SUBROUTINE INITAL
C...
C...  ISENTROPIC FLOW THROUGH A CONVERGING-DIVERGING NOZZLE
C...
C...  FOR THE ISENTROPIC FLOW OF A PERFECT GAS FROM A RESERVOIR THROUGH
C...  A CONVERGING-DIVERGING NOZZLE, OPERATING WITH SONIC VELOCITY AT
C...  THE THROAT, THE FOLLOWING EQUATION RELATES VARIOUS PRESSURES AND
C...  AREAS*
C...
C...  AT**2/A**2 = ((GAMMA + 1)/2)**((GAMMA + 1)/(GAMMA - 1))*
C....
C...               (2/(GAMMA - 1))*((P/P1)**(2/GAMMA)                (1)
C...
C...               - (P/P1)**((GAMMA + 1)/GAMMA))
C...
C...  WHERE
C...
C...     P       PRESSURE AT A POINT WHERE THE CROSS-SECTIONAL AREA OF
C...             OF THE NOZZLE IS A
C...
C...     P1      RESERVOIR PRESSURE
C...
C...     AT      THROAT AREA
C...
C...     GAMMA   RATIO OF THE SPECIFIC HEAT AT CONSTANT PRESSURE TO THAT
C...             AT CONSTANT VOLUME
C...
C...  EQUATION (1) HAS TWO POSSIBLE SOLUTIONS, I.E., P, WHICH ARE TO
C...  COMPUTED FOR THE DATA AT = 0.1, GAMMA = 1.41, P1 = 100, A = 0.12.
C...
C...  *CARNAHAN, B., ET AL, APPLIED NUMERICAL METHODS, JOHN WILEY AND
C...  AND SONS, INC., NEW YORK, 1969, PROB. 3.35, P204.
C...
C...  EQUATION (1) IS PROGRAMMED FOR SOLUTION BY DAVIDENKO*S METHOD,
C...  A DIFFERENTIAL FORM OF NEWTON*S METHOD.
C...
C...  SUBROUTINE INITAL SETS THE INITIAL CONDITION FOR THE DAVIDENKO
C...  DIFFERENTIAL EQUATION
C...
      COMMON/T/T,NFIN,NORUN/Y/P/F/DPDT
      IF(NORUN.EQ.1)P=5.
      IF(NORUN.EQ.2)P=90.
C...
C...  CALL SUBROUTINE DERV TO COMPUTE THE INITIAL DERIVATIVE DP/DT
      CALL DERV
      RETURN
      END
      SUBROUTINE DERV
C...
C...  SUBROUTINE DERV COMPUTES THE DERIVATIVE OF THE DAVIDENKO DIFFER-
C...  ENTIAL EQUATION
C...
      COMMON/T/T,NFIN,NORUN/Y/P/F/DPDT
      DPDT=-F(P)/DFDP(P)
      RETURN
      END
      FUNCTION F(P)
C...
C...  FUNCTION F(P) COMPUTES THE FUNCTION TO BE ZEROED
C...
      COMMON/PARM/
     1         AT,  GAMMA,     P1,      A
      TERM1=((GAMMA+1.)/2.)**((GAMMA+1.)/(GAMMA-1.))
      TERM2=(2./(GAMMA-1.))
      TERM3=(P/P1)**(2./GAMMA)-(P/P1)**((GAMMA+1.)/GAMMA)
      TERM4=(AT/A)**2
      F=TERM1*TERM2*TERM3-TERM4
      RETURN
      END
      FUNCTION DFDP(P)
C...
C...  FUNCTION DFDP COMPUTES THE DERIVATIVE OF THE FUNCTION TO BE
C...  ZEROED
C...
      COMMON/PARM/
     1         AT,  GAMMA,     P1,      A
      TERM1=((GAMMA+1.)/2.)**((GAMMA+1.)/(GAMMA-1.))
      TERM2=(2./(GAMMA-1.))
      TERM3=(2./GAMMA)*P**(2./GAMMA-1.)
      TERM4=P1**(-2./GAMMA)
      TERM5=((GAMMA+1.)/GAMMA)*P**((GAMMA+1.)/GAMMA-1.)
      TERM6=P1**(-(GAMMA+1.)/GAMMA)
      DFDP=TERM1*TERM2*(TERM3*TERM4-TERM5*TERM6)
      RETURN
      END
      BLOCK DATA
C...
C...  BLOCK DATA SETS THE PROBLEM PARAMETERS AND PASSES THEM THROUGH
C...  COMMON/PARM/ TO OTHER SUBROUTINES
C...
      COMMON/PARM/
     1         AT,  GAMMA,     P1,      A
      DATA     AT,  GAMMA,     P1,      A/
     1        0.1,   1.41,  100.0,   0.12/
      END
      SUBROUTINE PRINT(NI,NO)
C...
C...  SUBROUTINE PRINT PRINTS THE NUMERICAL SOLUTION
C...
      COMMON/T/T,NFIN,NORUN/Y/P/F/DPDT
      WRITE(NO,1)T,P,DPDT
1     FORMAT(10H      T = ,E11.3,10H     EP = ,E11.3,10H  DP/DT = ,E11.3
     1)
      RETURN
      END
CARNAHAN, ET AL, APPLIED NUMERICAL METHODS, PROB. 3.34, FIRST ROOT
0.        10.       1.
    1 1000    1    1  REL 0.001
CARNAHAN, ET AL, APPLIED NUMERICAL METHODS, PROB. 3.34, SECOND ROOT
0.        10.       1.
    1 1000    1    1  REL 0.001
END OF RUNS
*APP FLOW10
      SUBROUTINE INITAL
C...
C...  DYNAMICS OF A GRAVITY-FLOW TANK
C...
C...  18400 GPM OF WATER ARE BEING PUMPED TO TWO CYLINDRICAL TANKS, EACH
C...  7 FT HIGH AND 12 FT ID, WITH 43 0/0 AND 57 0/0 OF THE FLOW GOING
C...  INTO EACH TANK.  WATER FLOWS BY GRAVITY FROM THE TANKS THROUGH
C...  3,000 FT OF A 3 FT ID PIPE CONNECTED TO EACH TANK.  THE SYSTEM
C...  HAS BEEN OPERATING AT STEADY STATE.  HOWEVER, IT IS NECESSARY TO
C...  INCREASE THE FLOW RATE TO 31,400 GPM WITH AN EQUAL FLOW GOING
C...  INTO EACH TANK.
C...
C...     (1)  SIMULATE THE DYNAMIC BEHAVIOR OF EACH TANK, USING VARIABLE
C...          STEP ALGORITHM 1 AND A FIXED STEP EULER ALGORITHM WITH DT
C...          = 1.0 AND THEN REPEATED WITH DT = 0.5.  COMPARE THE THREE
C...          SOLUTIONS WHICH SHOULD BE PRINTED EVERY 10 SECONDS.
C...
C...     (2)  PLOT THE DT = 1.0 SOLUTION AS H(T) AND V(T) FOR EACH TANK
C...          VS. TIME FOR 0 LE T LE 400.
C...
C...     (3)  REPEAT PARTS (1) AND (2) USING AS INITIAL CONDITIONS
C...          H1(0) = H2(0) = 4.72 FT, V1(0) = V2(0) = 4.97 FT/SEC.
C...
C...  THE DIFFERENTIAL EQUATIONS WHICH DESCRIBE EACH TANK ARE DISCUSSED
C...  IN DETAIL IN THE REFERNCE CITED BELOW* AND IN THE FIRST LINE OF
C...  DATA.  BRIEFLY, THESE DIFFERENTIAL EQUATIONS ARE
C...
C...     DV/DT = (G/L)*H - (KF*GC/(RHO*AP))*(V**2)                   (1)
C...
C...     DH/DT = (1/AT)*(F0 - F)   9(2)
C...
C...  THE FRICTION FACTOR KF IS GIVEN BY
C...
C...     KF = PI*DP*RHO*F/(8.*GC)                                    (3)
C...
C...  THE PARAMETERS IN EQUATIONS (1) TO (3) ARE DEFINED NUMERICALLY IN
C...  SUBROUTINE INITAL AND THE BLOCK DATA ROUTINE.
C...
C...  *LUYBEN, W. L., PROCESS MODELING, SIMULATION AND CONTROL FOR
C...  CHEMICAL ENGINEERS, MCGRAW-HILL BOOK COMPANY, NEW YORK, 1973,
C...  EXAMPLE 4-2, PP 104-107.
C...
      COMMON     /T/     T, NSTOP, NORUN
      COMMON     /Y/    V1,    H1,    V2,    H2
      COMMON     /F/ DV1DT, DH1DT, DV2DT, DH2DT
      COMMON /EULER/   V1E,   H1E,   V2E,   H2E
      COMMON     /C/    DP,    AP,     L,    AT,     G,    GC,   RHO,
     1                  FF,    KF,    C1,    C2,    C3,    C4,    F0,
     2                  IP
      REAL               L,    KF
C...
C...  COMPUTE THE FRICTION FACTOR
      KF=3.1415927*DP*RHO*FF/(8.*GC)
C...
C...  COMPUTE THE CONSTANTS C1, C2, C3 AND C4 USED IN THE DIFFERENTIAL
C...  EQUATIONS
      C1=G/L
      C2=KF*GC/(RHO*AP)
      C3=1./AT
      C4=AP/AT
C...
C...  SET THE FLOW RATE INTO TANKS 1 AND 2
C...  (1 CU FT = 7.481 GALLONS)
      F0=0.5*31400./(7.481*60.0)
C...
C...  INITIALIZE THE COUNTER FOR PLOTTED OUTPUT
      IP=0
C...
C...  SET THE INITIAL CONDITIONS FOR TANK 1
      V1=18400.*0.43/(AP*7.481*60.0)
      H1=C2*(V1**2)/C1
C...
C...  SET THE INITIAL CONDITIONS FOR TANK 2
      V2=(0.57/0.43)*V1
      H2=C2*(V2**2)/C1
C...
C...  RESET THE INITIAL CONDITIONS FOR PART (3)
      GO TO (1,1,2,2),NORUN
2     V1=4.97
      H1=4.72
      V2=4.97
      H2=4.72
C...
C...  SET THE INITIAL CONDITIONS FOR THE EULER INTEGRATION
1     V1E=V1
      H1E=H1
      V2E=V2
      H2E=H2
C...
C...  CALL SUBROUTINE DERV TO INITIALIZE THE DERIVATIVES IN COMMON/F/
C...  FOR PRINTING IN SUBROUTINE PRINT
      CALL DERV
      RETURN
      END
      SUBROUTINE DERV
      COMMON     /T/     T, NSTOP, NORUN
      COMMON     /Y/    V1,    H1,    V2,    H2
      COMMON     /F/ DV1DT, DH1DT, DV2DT, DH2DT
      COMMON /EULER/   V1E,   H1E,   V2E,   H2E
      COMMON     /C/    DP,    AP,     L,    AT,     G,    GC,   RHO,
     1                  FF,    KF,    C1,    C2,    C3,    C4,    F0,
     2                  IP
      REAL               L,    KF
C...
C...  DIFFERENTIAL EQUATIONS FOR TANK 1
      DV1DT=C1*H1-C2*(V1**2)
      DH1DT=C3*F0-C4*V1
C...
C...  DIFFERENTIAL EQUATIONS FOR TANK 2
      DV2DT=C1*H2-C2*(V2**2)
      DH2DT=C3*F0-C4*V2
      RETURN
      END
      BLOCK DATA
      COMMON     /C/    DP,    AP,     L,    AT,     G,    GC,   RHO,
     1                  FF,    KF,    C1,    C2,    C3,    C4,    F0,
     2                  IP
      REAL               L,    KF
C...
C...  SET THE PROBLEM PARAMETERS
      DATA              DP,    AP,     L,    AT,     G,    GC,   RHO,
     1                  FF/
     2                 3.0,  7.06, 3000.,  113.,  32.2,  32.2,  62.3,
     3              0.0123/
      END
      SUBROUTINE PRINT(NI,NO)
      COMMON     /T/     T, NSTOP, NORUN
      COMMON     /Y/    V1,    H1,    V2,    H2
      COMMON     /F/ DV1DT, DH1DT, DV2DT, DH2DT
      COMMON /EULER/   V1E,   H1E,   V2E,   H2E
      COMMON     /C/    DP,    AP,     L,    AT,     G,    GC,   RHO,
     1                  FF,    KF,    C1,    C2,    C3,    C4,    F0,
     2                  IP
      REAL               L,    KF
C...
C...  DIMENSION THE ARRAYS FOR STORING THE SOLUTION TO BE PLOTTED AT
C...  END OF THE RUN
      DIMENSION TPLOT(41), VPLOT(2,41), HPLOT(2,41)
      GO TO(1,2,1,2),NORUN
C...
C...  EULER INTEGRATION WITH DT = 1.0
1     DT=1.0
      NSTEPS=10
      IF(IP.EQ.0)GO TO 3
      GO TO 4
C...
C...  EULER INTEGRATION WITH DT = 0.5
2     DT=0.5
      NSTEPS=20
      IF(IP.EQ.0)GO TO 3
C...
C...  STEP THROUGH NSTEPS EULER STEPS TO GET TO THE NEXT SOLUTION POINT
4     DO 5 I=1,NSTEPS
      V1EN=V1E+(C1*H1E-C2*(V1E**2))*DT
      H1EN=H1E+(C3*F0-C4*V1E)*DT
      V2EN=V2E+(C1*H2E-C2*(V2E**2))*DT
      H2EN=H2E+(C3*F0-C4*V2E)*DT
      V1E=V1EN
      H1E=H1EN
      V2E=V2EN
      H2E=H2EN
5     CONTINUE
C...
C...  COMPUTE THE DIFFERENCE BETWEEN THE SOLUTIONS FOR ALGORITHM 1 AND
C...  THE FIXED STEP EULER METHOD
3     V1D=V1E-V1
      H1D=H1E-H1
      V2D=V2E-V2
      H2D=H2E-H2
C...
C...  PRINT A HEADING FOR THE NUMERICAL SOLUTIONS
      IF(IP.NE.0)GO TO 8
      WRITE(NO,7)
7     FORMAT(6X,4HTIME,/,
     1 10X,2HV1,9X,3HV1E,9X,3HV1D,7X,5HDV1DT,
     2 10X,2HH1,9X,3HH1E,9X,3HH1D,7X,5HDH1DT,/,
     3 10X,2HV2,9X,3HV2E,9X,3HV2D,7X,5HDV2DT,
     4 10X,2HH2,9X,3HH2E,9X,3HH2D,7X,5HDH2DT,/)
C...
C...  PRINT THE NUMERICAL SOLUTIONS
8     WRITE(NO,6)        T,
     1                  V1,   V1E,   V1D, DV1DT,
     2                  H1,   H1E,   H1D, DH1DT,
     3                  V2,   V2E,   V2D, DV2DT,
     4                  H2,   H2E,   H2D, DH2DT
6     FORMAT(1H ,/,F10.0,/,(8E12.3))
C...
C...  STORE THE EULER SOLUTION FOR SUBSEQUENT PLOTTING
      IP=IP+1
      IF(NORUN.NE.1)RETURN
      TPLOT(IP)=T
      VPLOT(1,IP)=V1E
      VPLOT(2,IP)=V2E
      HPLOT(1,IP)=H1E
      HPLOT(2,IP)=H2E
      IF(IP.NE.41)RETURN
      CALL PLOTS(2,IP,TPLOT,VPLOT)
      WRITE(NO,9)
9     FORMAT(1H ,//,48H V1(T) AND V2(T) VS T                           )
      CALL PLOTS(2,IP,TPLOT,HPLOT)
      WRITE(NO,10)
10    FORMAT(1H ,//,48H H1(T) AND H2(T) VS T                           )
      RETURN
      END
LUYBEN, W. L., PROCESS MODELING, SIMULATION AND CONTROL FOR CHES, EX 4-2
0.        400.      10.
    4 1000    1    1  REL 0.001
LUYBEN, W. L., PROCESS MODELING, SIMULATION AND CONTROL FOR CHES, EX 4-2
0.        400.      10.
    4 1000    1    1  REL 0.001
LUYBEN, W. L., PROCESS MODELING, SIMULATION AND CONTROL FOR CHES, EX 4-2
0.        400.      10.
    4 1000    1    1  REL 0.001
LUYBEN, W. L., PROCESS MODELING, SIMULATION AND CONTROL FOR CHES, EX 4-2
0.        400.      10.
    4 1000    1    1  REL 0.001
END OF RUNS
*APP FLOW11
      SUBROUTINE INITAL
C...
C...  TRANSIENT RESPONSE OF A FIRST-ORDER HYDRAULIC SYSTEM
C...
C...  THE HYDRUALIC SYSTEM IS COMPLETELY DESCRIBED IN PROBLEMS 3-7 AND
C...  4-5 OF THE REFERENCE CITED BELOW* AND IN THE FIRST LINE OF DATA.
C...  THEREFORE, ONLY THE EQUATIONS ARE SUMMARIZED BELOW
C...
C...     DP/DT = 1/(0.01*V)*(W1 - W2), P(0) = 2500 PSIG           (1)(2)
C...
C...     W2 = ((P - P2)/R2)**0.5, W3 = ((P2 - PA)/R3)**0.5        (3)(4)
C...
C...  WHERE
C...
C...     P    TANK PRESSURE (PSIG)
C...
C...     W1   MASS FLOW RATES THROUGH RESISTANCES R1, R2, AND R3,
C...     W2   RESPECTIVELY (LBM/SEC)
C...     W3
C...
C...     PA   ATMOSPHERIC PRESSURE (= 0 PSIG)
C...
C...     V    TANK VOLUME (= 15 FT**3)
C...
C...  *LUYBEN, W. L., PROCESS MODELING, SIMULATION AND CONTROL FOR
C...  CHEMICAL ENGINEERS, MCGRAW-HILL BOOK COMPANY, NEW YORK, 1973,
C...  EXAMPLE 4-2, PP 104-107.
C...
      COMMON     /T/     T, NSTOP, NORUN
     1           /Y/     P
     2           /F/  DPDT
     3           /C/    R2,    R3,    W1,    W2,     V,    IP
C...
C...  CALCULATE RESISTANCES R2 AND R3 FROM THE GIVEN STEADY STATE FLOWS
C...  AND PRESSURES
      R2=(2500.-1000.)/5.**2
      R3=(1000.-   0.)/5.**2
C...
C...  CALCULATE THE NEW (TRANSIENT) FLOW, W1
      IF(NORUN.EQ.1)W1=5.*(1.25)
      IF(NORUN.EQ.2)W1=5.*(0.75)
C...
C...  INITIALIZE THE COUNTER FOR PLOTTED POINTS USED IN SUBROUTINE PRINT
C...  AND THE TANK VOLUME
      IP=0
      V=15.
C...
C...  SET INITIAL CONDITION (2)
      P=2500.
C...
C...  INITIALIZE THE DERIVATIVE DP/DT FOR PRINTING AND PLOTTING IN
C...  SUBROUTINE PRINT
      CALL DERV
      RETURN
      END
      SUBROUTINE DERV
      COMMON     /T/     T, NSTOP, NORUN
     1           /Y/     P
     2           /F/  DPDT
     3           /C/    R2,    R3,    W1,    W2,     V,    IP
C...
C...  CALCULATE THE FLOW W2 REQUIRED IN DIFFERENTIAL EQUATION (1) (NOTE
C...  THAT THE INTERMEDIATE PRESSURE P2 HAS BEEN ELIMINATED BETWEEN
C...  EQUATIONS (3) AND (4) WHICH CAN EASILY BE DONE BECAUSE EVEN IN THE
C...  TRANSIENT STATE, W2 = W3)
      W2=SQRT((P-0.)/(R2+R3))
C...
C...  DIFFERENTIAL EQUATION (1)
      DPDT=1./(0.01*V)*(W1-W2)
      RETURN
      END
      SUBROUTINE PRINT(NI,NO)
      COMMON     /T/     T, NSTOP, NORUN
     1           /Y/     P
     2           /F/  DPDT
     3           /C/    R2,    R3,    W1,    W2,     V,    IP
C...
C...  DIMENSION THE ARRAYS FOR THE PLOTTED SOLUTION
      DIMENSION TP(51),PP(51),WP(2,51)
C...
C...  PRINT A HEADING FOR THE NUMERICAL SOLUTION
      IF(IP.EQ.0)WRITE(NO,1)
1     FORMAT(9X,1HT,11X,1HP,10X,2HW1,10X,2HW2,7X,5HDP/DT)
C...
C...  PRINT THE NUMERICAL SOLUTION
      WRITE(NO,2)T,P,W1,W2,DPDT
2     FORMAT(F10.1,4E12.3)
C...
C...  STORE THE NUMERICAL SOLUTION FOR PLOTTING
      IP=IP+1
      TP(IP)=T
      PP(IP)=P
      WP(1,IP)=W1
      WP(2,IP)=W2
C...
C...  PLOT THE NUMERICAL SOLUTION
      IF(IP.LT.51)RETURN
      CALL PLOTS(1,IP,TP,PP)
      WRITE(NO,3)
3     FORMAT(1H ,//,48H P(T) (PSIG) VS T (SEC)                         )
      CALL PLOTS(2,IP,TP,WP)
      WRITE(NO,4)
4     FORMAT(1H ,//,48H W1(T) (1) AND W2(T) (2) (LBM/SEC) VS T (SEC)   )
      RETURN
      END
LUYBEN, W L, PROCESS MODELING, SIMULATION AND CONTROL FOR CHES, PROB 4-5
0.        1000.     20.
    1 1000    1    1  REL 0.001
LUYBEN, W L, PROCESS MODELING, SIMULATION AND CONTROL FOR CHES, PROB 4-5
0.        1000.     20.
    1 1000    1    1  REL 0.001
END OF RUNS
*APP FLOW12
      SUBROUTINE INITAL
C...
C...  TRANSIENT RESPONSE OF A PNEUMATIC SYSTEM WITH A CENTRIFUGAL
C...  COMPRESSOR
C...
C...  THE PNEUMATIC SYSTEM IS COMPLETELY DESCRIBED IN PROBLEM 4-6 OF THE
C...  REFERENCE CITED BELOW* AND IN THE FIRST LINE OF DATA.  THEREFORE,
C...  ONLY THE EQUATIONS FOR CALCULATING THE COMPRESSOR CONSTANTS A0,
C...  A1 AND A2 ARE SUMMARIZED BELOW
C...
C...  *LUYBEN, W. L., PROCESS MODELING, SIMULATION AND CONTROL FOR
C...  CHEMICAL ENGINEERS, MCGRAW-HILL BOOK COMPANY, NEW YORK, 1973,
C...  PROB. 4-6, P119.
C...
C...     187 = A0 +  50*A1 +  50**2*A2
C...
C...     170 = A0 + 100*A1 + 100**2*A2
C...
C...       0 =  IA1 +   2*50*A2
C...
      COMMON     /T/     T, NSTOP, NORUN
     1           /Y/    P1,    P2,    P3,    EI
     2           /F/ DP1DT, DP2DT, DP3DT, DEIDT
     3           /C/    A0,    A1,    A2,    KC,  TAUI,   MRT,    IP,
     4                  W0,    W1,    W2,    W3,     E,     X,    V1,
     5                  V2,    V3
      REAL              KC,   MRT
C...
C...  SET THE MODEL PARAMETERS
      MRT=29./(10.73*(460.+100.))
C...
C...  THREE FLOWS ARE OF INTEREST IN THIS PROBLEM
C...
C...     W3 = 100000     (STEADY STATE FLOW WHICH ZEROES THE DERIVATIVES
C...                      DP1DT, DP2DT, DP3DT, DEIDT IN COMMON/F/)
C...
C...     W3 = 100000*0.8 (A 20 PERCENT DECREASE IN FLOW W3)
C...
C...     W3 = 100000*1.2 (A 20 PERCENT INCREASE IN FLOW W3)
C...
C...  THE RESPONSES FOR THE LAST TWO CASES ARE NOT SYMMETRICAL BECAUSE
C...  OF THE NONLINEARITIES OF THE PROBLEM SYSTEM.  THUS A CONTROLLER
C...  WHICH PERFORMS SATISFACTORILY FOR A FLOW INCREASE (I.E., A PARTI-
C...  CULAR CHOICE OF THE CONTROLLER GAIN KC AND INTEGRAL TIME TAUI) MAY
C...  NOT BE SATISFACTORY FOR A FLOW DECREASE.
C...
      W3=100000.*1.2
      V1=10.
      V2=10.
      V3=(3.1415927*(8.**2)/4.)*20.
      A2=17./(3.*50000.**2-100000.**2)
      A1=-2.*A2*50000.
      A0=187.0-50000.*A1-50000.**2*A2
C...
C...  SET THE CONTROLLER PARAMETERS FOR A SERIES OF RUNS
      GO TO(1,2,3),NORUN
1     KC=0.
      TAUI=1.0E+10
      GO TO 10
2     KC=0.1
      TAUI=1.0E+10
      GO TO 10
3     KC=0.1
      TAUI=0.05
10    IP=0
C...
C...  SET THE INITIAL CONDITIONS
      P1=50.0
      P2=220.0
      P3=200.0
      EI=1.0E-10
C...
C...  COMPUTE THE INITIAL DERIVATIVES
      CALL DERV
      RETURN
      END
      SUBROUTINE DERV
      COMMON     /T/     T, NSTOP, NORUN
     1           /Y/    P1,    P2,    P3,    EI
     2           /F/ DP1DT, DP2DT, DP3DT, DEIDT
     3           /C/    A0,    A1,    A2,    KC,  TAUI,   MRT,    IP,
     4                  W0,    W1,    W2,    W3,     E,     X,    V1,
     5                  V2,    V3
      REAL              KC,   MRT
      E=200.-P3
      X=0.5+KC*(E+EI)
      W0=40000.*X*SQRT(75.-P1)
      W1=(-A1-SQRT(A1**2 - 4.*A2*(A0+P1-P2)))/(2.*A2)
      W2=SQRT(1.0E+10*(P2-P3)/20.)
      DP1DT=1./(V1*MRT)*(W0-W1)
      DP2DT=1./(V2*MRT)*(W1-W2)
      DP3DT=1./(V3*MRT)*(W2-W3)
      DEIDT=1./TAUI*E
      RETURN
      END
      SUBROUTINE PRINT(NI,NO)
      COMMON     /T/     T, NSTOP, NORUN
     1           /Y/    P1,    P2,    P3,    EI
     2           /F/ DP1DT, DP2DT, DP3DT, DEIDT
     3           /C/    A0,    A1,    A2,    KC,  TAUI,   MRT,    IP,
     4                  W0,    W1,    W2,    W3,     E,     X,    V1,
     5                  V2,    V3
      REAL              KC,   MRT
C...
C...  DIMENSION THE ARRAYS FOR PLOTTING THE SOLUTION
      DIMENSION TP(51),EP(3,51)
C...
C...  PRINT A HEADING FOR THE NUMERICAL SOLUTION
      IF(IP.EQ.0)WRITE(NO,1)A2,A1,A0
1     FORMAT(1H ,//,6H A2 = ,E10.2,5X,6H A1 = ,E10.3,5X,6H A0 = ,E10.3,/
     1/,5X,5H TIME,/,10X,2HP1,10X,2HP2,10X,2HP3,7X,5HDP1DT,7X,5HDP2DT,7X
     2,5HDP3DT,10X,2HW0,10X,2HW1,10X,2HW2,10X,2HW3,11X,1HE)
C...
C...  PRINT THE NUMERICAL SOLUTION INITIALLY AND IN EVERY FIFTH CALL TO
C...  SUBROUTINE PRINT
      IF(((IP/5*5).NE.IP).AND.(IP.NE.0))GO TO 4
      WRITE(NO,3)T,P1,P2,P3,DP1DT,DP2DT,DP3DT,W0,W1,W2,W3,E
3     FORMAT(1H ,F10.3,/,11E12.3)
C...
C...  STORE THE NUMERICAL SOLUTION FOR PLOTTING
4     IP=IP+1
      TP(IP)=T
      EP(NORUN,IP)=E
C...
C...  PLOT THE NUMERICAL SOLUTION
      IF(IP.LT.51)RETURN
      IF(NORUN.LT.3)RETURN
      CALL PLOTS(NORUN,IP,TP,EP)
      WRITE(NO,2)
2     FORMAT(1H ,//,48H E(T) VS T FOR KC AND TAUI SET IN INITAL        )
      RETURN
      END
LUYBEN, W L, PROCESS MODELING, SIMULATION AND CONTROL FOR CHES, PROB 4-6
0.        0.1       0.002
    4 1000    1    1  REL 0.001
REPEATS                                                                  H
    2
END OF RUNS
*APP FLOW13
      SUBROUTINE INITAL
C...
C...  APPROXIMATION OF THE ADVECTION EQUATION BY CENTRAL AND NONCENTRAL
C...  (UPWIND) FINITE DIFFERENCES
C...
C...  PURE CONVECTION THROUGH A TUBE WITH A UNIFORM VELOCITY PROFILE CAN
C...  BE DEPICTED AS
C...
C...
C...          .............................................
C...                         V......+.  .
C...                         V......+.  .
C...                         V......+.DX. C(X,T)
C...                         V......+.  .
C...                         V......+.  .
C...          .............................................
C...         X=0                                        X=XL
C...
C...  IF A MASS OR ENERGY BALANCE IS WRITTEN FOR A DIFFERENTIAL SECTION
C...  OF THE TUBE, THE WELL-KNOWN ADVECTION EQUATION RESULTS
C...
C...     C  + V*C  = 0                                               (1)
C...      T      X
C...
C...  SINCE EQUATION (1) IS FIRST-ORDER IN THE SPATIAL VARIABLE, X, AND
C...  THE TEMPORAL VARIABLE, T, IT REQUIRES ONE BOUNDARY CONDITION AND
C...  ONE INITIAL CONDITION
C...
C...     C(0,T) = F(T), C(X,0) = G(X)                             (2)(3)
C...
C...  IN THE FOLLOWING ANALYSIS, WE CONSIDER THE SPECIAL CASE
C...
C...     F(T) = 1, G(X) = 0                                       (4)(5)
C...
C...  FOR WHICH THE EXACT SOLUTION TO EQUATIONS (1) TO (3) IS
C...
C...     C(X,T) = 0, X GT V*T
C...                                                                 (6)
C...     C(X,T) = 1, X LT V*T
C...
C...  EQUATIONS (6) REPRESENT A TRAVELLING STEP FUNCTION WHICH INDICATES
C...  THE FUNDAMENTAL DIFFICULTY IN OBTAINING A NUMERICAL SOLUTION TO
C...  EQUATIONS (1) TO (3), I.E., AT X = V*T, THE SLOPE OF THE SOLUTION
C...  IS INFINITE.  THUS ABOUT THE BEST WE CAN EXPECT IS A NUMERICAL
C...  APPROXIMATION TO EQUATION (6) OF ACCEPTABLE ACCURACY.
C...
C...  THE SPATIAL DERIVATIVE IN EQUATION (1), C  IS REPLACED BY A FINITE
C...                                           X
C...  DIFFERENCE APPROXIMATION OVER A GRID OF N (= 21) POINTS IN X.  A
C...  SYSTEM OF N INITIAL-VALUE ORDINARY DIFFERENTIAL EQUATIONS IN T
C...  RESULTS, ONE DIFFERENTIAL EQUATION FOR EACH GRID POINT.  THIS
C...  SYSTEM OF ODES IS THEN INTEGRATED SIMULTANEOUSLY TO OBTAIN THE
C...  NUMERICAL SOLUTION TO EQUATIONS (1) TO (3).  TWO APPRROXIMATIONS
C...  TO THE SPATIAL DERIVATIVE IN EQUATION (1) ARE USED
C...
C...     (1)  TWO-POINT UPWIND DIFFERENCE
C...
C...          THIS APPROXIMATION IS EQUIVALENT TO ASSUMING THAT EACH
C...          SECTION OF THE TUBE ALONG THE GRID IN X IS PERFECTLY
C...          MIXED, I.E., THIS IS THE WELL-KNOWN METHOD OF USING A
C...          SERIES OF STIRRED TANK APPROXIMATIONS.
C...
C...     (2)  THREE-POINT CENTRAL DIFFERENCE
C...
C...          THE FINITE DIFFERENCE APPROXIMATIONS USED AT THE GRID
C...          POINTS IN X ARE IMPLEMENTED IN SUBROUTINE DSS002.
C...
      COMMON/T/      T,  NSTOP,  NORUN
     1      /Y/  C(21)
     2      /F/ CT(21)
     3     /SD/ CX(21)
     4      /C/      V,     XL,      N,     DX,    SSE,     IP
C...
C...  SET THE VELOCITY, LENGTH OF THE SYSTEM, NUMBER OF SPATIAL GRID
C...  POINTS, LENGTH OF THE GRID INTERVAL, SUM OF SQUARES OF ERRORS OF
C...  THE NUMERICAL SOLUTION, COUNTER FOR THE PLOTTED SOLUTION USED IN
C...  SUBROUTINE PRINT
      V=1.
      XL=1.
      N=21
      DX=XL/FLOAT(N-1)
      SSE=0.
      IP=0
C...
C...  INITIAL CONDITION (5)
      DO 1 I=1,N
      C(I)=1.0E-10
1     CONTINUE
C...
C...  INITIALIZE THE TEMPORAL DERIVATIVES IN COMMON/F/
      CALL DERV
      RETURN
      END
      SUBROUTINE DERV
      COMMON/T/      T,  NSTOP,  NORUN
     1      /Y/  C(21)
     2      /F/ CT(21)
     3     /SD/ CX(21)
     4      /C/      V,     XL,      N,     DX,    SSE,     IP
      GO TO (1,2),NORUN
C...
C...  CASE 1 - TWO-POINT UPWIND DIFFERENCES
1     C(1)=1.
      CT(1)=0.
      DO 11 I=2,N
      CT(I)=-V*(C(I)-C(I-1))/DX
11    CONTINUE
      RETURN
C...
C...  CASE 2 - THREE-POINT CENTRAL DIFFERENCES
2     C(1)=1.
      CT(1)=0.
      CALL DSS002(0.,XL,N,C,CX)
      DO 12 I=2,N
      CT(I)=-V*CX(I)
12    CONTINUE
      RETURN
      END
      SUBROUTINE PRINT(NI,NO)
      COMMON/T/      T,  NSTOP,  NORUN
     1      /Y/  C(21)
     2      /F/ CT(21)
     3     /SD/ CX(21)
     4      /C/      V,     XL,      N,     DX,    SSE,     IP
C...
C...  DIMENSION THE ARRAYS FOR PLOTTING THE SOLUTION
      DIMENSION TP(51),CP(2,51),EP(2,51)
C...
C...  PRINT A HEADING FOR NUMERICAL SOLUTION
      IF(IP.EQ.0)WRITE(NO,1)
1     FORMAT(9X,1HT,6X,6HC(0,T),6X,6HC(1,T))
      WRITE(NO,2)T,C(1),C(N)
2     FORMAT(F10.2,2F12.3)
C...
C...  STORE THE SOLUTION FOR PLOTTING
      IP=IP+1
      TP(IP)=T
      CP(NORUN,IP)=C(N)
C...
C...  COMPUTE THE ERROR IN THE NUMERICAL SOLUTION FOR PLOTTING
      X=1.
      IF(X.GE.V*T)E=C(N)
      IF(X.LT.V*T)E=C(N)-1.
      SSE=SSE+E**2
      EP(NORUN,IP)=E
C...
C...  TEST FOR THE END OF A RUN
      IF(IP.LT.51)RETURN
C...
C...  PRINT THE SUM OF SQUARES OF ERRORS OF THE NUMERICAL SOLUTION AT
C...  THE END OF THE RUN TO GIVE AN OVERALL FIGURE OF MERIT FOR THE
C...  APPROXIMATION OF THE SPATIAL DERIVATIVE IN EQUATION (1)
      WRITE(NO,5)SSE
5     FORMAT(1H ,//,48H SUM OF SQUARES OF ERROR IN NUMERICAL SOLUTION =,
     1 E10.3)
C...
C...  PLOT THE NUMERICAL SOLUTION
      IF(NORUN.LT.2)RETURN
      CALL PLOTS(2,IP,TP,CP)
      WRITE(NO,3)
3     FORMAT(1H ,//,48H C(1,T) VS T, 1 - 2 PT UPWIND, 2 - 3 PT CENTRAL )
      CALL PLOTS(2,IP,TP,EP)
      WRITE(NO,4)
4     FORMAT(1H ,//,48H E(1,T) VS T, 1 - 2 PT UPWIND, 2 - 3 PT CENTRAL )
      RETURN
      END
METHOD OF LINES SOLUTION OF THE ADVECTION EQUATION, TWO-POINT UPWIND
0.        2.0       0.04
   21 1000    8    1  REL 0.001
METHOD OF LINES SOLUTION OF THE ADVECTION EQUATION, THREE-POINT CENTRAL
0.        2.0       0.04
   21 1000    8    1  REL 0.001
END OF RUNS
*APP FLOW14
      SUBROUTINE INITAL
C...
C...  DYNAMICS OF TWO TANKS CONNECTED BY A LONG LINE WITH FEED AND
C...  DISCHARGE LINES
C...
C...  THE FOLLOWING SYSTEM OF EQUATIONS MODELS TWO HOLDING TANKS
C...  CONNECTED BY A LONG LINE WITH A FEED LINE TO THE FIRST TANK
C...  AND A DISCHARGE LINE WITH A VALVE FROM THE SECOND TANK
C...
C...  MATERIAL BALANCE FOR TANK 1
C...
C...     DH1/DT = (1/A1)*(F0 - F1), F1 = V1*AP
C...
C...  MATERIAL BALANCE FOR TANK 2
C...
C...     DH2/DT = (1/A2)*(F1 - F2), F2 = CV*X*(H2**0.5)
C...
C...  MOMENTUM BALANCE FOR THE FLUID IN THE CONNECTING LINE
C...
C...     (1/GC)*D(AP*L*RHO*V1)/DT =
C...
C...         RHO*(G/GC)*H1*AP - RHO*(G/GC)*H2*AP - FK
C...
C...     FK = F*RHO*L*AP*V1*ABS(V1)*V1/(2*GC*DP)
C...
C...     F = 64/RE, RE LE 2000, F = 0.18/RE**0.2, RE GT 2000
C...
C...     RE = DP*ABS(V1)*RHO/VIS
C...
C...  THE INITIAL CONDITIONS FOR THIS THIRD-ORDER SYSTEM ARE
C...
C...     H1(0) = 2 M, H2(0) = 5 M, V1 = 0 M/S
C...
C...  THE MODEL VARIABLES AND PARAMETERS ARE
C...
C...     H1      HEIGHT OF LIQUID IN THE FIRST TANK (M)
C...
C...     H2      HEIGHT OF LIQUID IN THE SECOND TANK (M)
C...
C...     V1      AVERAGE FLUID VELOCITY IN THE CONNECTING LINE (M/S)
C...
C...     T       TIME (S)
C...
C...     F0      ENTERING FLOW RATE TO THE FIRST TANK (0.2 M**3/S)
C...
C...     F1      FLOW RATE FROM THE FIRST TANK (M**3/S)
C...
C...     F2      FLOW RATE FROM THE SECOND TANK (M**3/S)
C...
C...     AP      CONNECTING LINE CROSS SSCTIONAL AREA (M**2)
C...
C...     DP      CONNECTING LINE DIAMETER (0.3 M)
C...
C...     D1      DIAMETER OF THE FIRST TANK (2.5 M)
C...
C...     D2      DIAMETER OF THE SECOND TANK (3.0 M)
C...
C...     A1      CROSS SECTIONAL AREA OF THE FIRST TANK (M**2)
C...
C...     A2      CROSS SECTIONAL AREA OF THE SECOND TANK (M**2)
C...
C...     RHO     FLUID DENSITY (1000 KG/M**3)
C...
C...     VIS     FLUID VISOCITY (0.001 KG/M-S)
C...
C...     CV      VALVE CONSTANT (0.1 M**3/S-M**0.5)
C...
C...     X       VALVE STEM POSITION (1 DIMENSIONLESS)
C...
C...     L       CONNECTING LINE LENGTH (100 M)
C...
C...     G       ACCELERATION OF GRAVITY (9.8 M/S**2)
C...
C...     GC      CONVERSION FACTOR (1 KG-M/N-S**2)
C...
C...     F       FRICTION FACTOR (DIMENSIONLESS)
C...
C...  THE NUMERICAL SOLUTION TO THIS SYSTEM OF ALGEBRAIC AND DIFFER-
C...  ENTIAL EQUATIONS IS PRINTED AND PLOTTED IN SUBROUTINE PRINT
C...
      COMMON/T/     T
     1      /Y/    H1,    H2,    V1
     2      /F/ DH1DT, DH2DT, DV1DT
     3      /C/    D1,    D2,    A1,    A2,    F0,    F1,    F2,
     4             CV,     X,    AP,     L,    DP,   RHO,   VIS,
     5              G,    GC,     F,    RE,    C1,    C2,    IP
      REAL L
C...
C...  DEFINE THE MODEL PARAMETERS
      D1=2.5
      D2=3.0
      F0=0.2
      CV=0.1
      X=1.0
      L=100.
      DP=0.30
      RHO=1000.
      VIS=0.001
      G=9.8
      GC=1.0
C...
C...  PRECOMPUTE SOME CONSTANTS
      PI=3.1415927
      A1=PI*(D1**2)/4.
      A2=PI*(D2**2)/4.
      AP=PI*(DP**2)/4.
      C1=G/L
      C2=1./(2.*DP)
C...
C...  SET THE MODEL INITIAL CONDITIONS
      H1=2.
      H2=5.
      V1=0.
C...
C...  INITIALIZE A COUNTER FOR THE PLOTTED SOLUTION
      IP=0
C...
C...  INITIALIZE THE MODEL DERIVATIVES
      CALL DERV
      RETURN
      END
      SUBROUTINE DERV
      COMMON/T/     T
     1      /Y/    H1,    H2,    V1
     2      /F/ DH1DT, DH2DT, DV1DT
     3      /C/    D1,    D2,    A1,    A2,    F0,    F1,    F2,
     4             CV,     X,    AP,     L,    DP,   RHO,   VIS,
     5              G,    GC,     F,    RE,    C1,    C2,    IP
      REAL L
C...
C...  MODEL ALGEBRA
      RE=DP*ABS(V1)*RHO/VIS
      IF( RE.LT.0.01)F=6400.
      IF((RE.GE.0.01).AND.(RE.LE.2000.))F=64./RE
      IF( RE.GT.2000.)F=0.18/RE**0.2
      F1=AP*V1
      F2=CV*X*SQRT(H2)
C...
C...  MODEL DIFFERENTIAL EQUATIONS
      DH1DT=(1./A1)*(F0-F1)
      DH2DT=(1./A2)*(F1-F2)
      DV1DT=C1*(H1-H2)-C2*F*V1*ABS(V1)
      RETURN
      END
      SUBROUTINE PRINT(NI,NO)
      COMMON/T/     T
     1      /Y/    H1,    H2,    V1
     2      /F/ DH1DT, DH2DT, DV1DT
     3      /C/    D1,    D2,    A1,    A2,    F0,    F1,    F2,
     4             CV,     X,    AP,     L,    DP,   RHO,   VIS,
     5              G,    GC,     F,    RE,    C1,    C2,    IP
      REAL L
C...
C...  DIMENSION THE ARRAYS FOR THE PLOTTED SOLUTION
      DIMENSION  TP(51), H1P(51), H2P(51), V1P(51), REP(51)
C...
C...  PRINT A HEADING FOR THE NUMERICAL SOLUTION
      IP=IP+1
      IF(IP.EQ.1)WRITE(NO,1)
1     FORMAT(9X,1HT,8X,2HH1,8X,2HH2,8X,2HV1,8X,2HRE,8X,2HF1,8X,2HF2)
C...
C...  PRINT THE NUMERICAL SOLUTON EVERY FIFTH CALL TO SUBROUTINE PRINT
      IF(((IP-1)/5*5).EQ.(IP-1))THEN
         WRITE(NO,2)T,H1,H2,V1,RE,F1,F2
2        FORMAT(F10.1,3F10.3,E10.3,2F10.4)
      END IF
C...
C...  STORE THE SOLUTION FOR SUBSEQUENT PLOTTING
      TP(IP)=T
      H1P(IP)=H1
      H2P(IP)=H2
      V1P(IP)=V1
      REP(IP)=RE
C...
C...  PLOT THE NUMERICAL SOLUTION
      IF(IP.LT.51)RETURN
      CALL SPLOTS(1,IP,TP,H1P)
      WRITE(NO,11)
11    FORMAT(1H ,//,8H H1 VS T)
      CALL SPLOTS(1,IP,TP,H2P)
      WRITE(NO,12)
12    FORMAT(1H ,//,8H H2 VS T)
      CALL SPLOTS(1,IP,TP,V1P)
      WRITE(NO,13)
13    FORMAT(1H ,//,8H V1 VS T)
      CALL SPLOTS(1,IP,TP,REP)
      WRITE(NO,14)
14    FORMAT(1H ,//,8H RE VS T)
C...
C...  ****************************************************************
C...
C...  THE FOLLOWING CALLS TO A CONTINUOUS PLOTTER ARE MACHINE DEPENDENT,
C...  AND MUST CONVERTED FOR OTHER COMPUTERS OR CHANGED TO COMMENTS
C...
C...  CALL QIKSAX(3,3)
C...  CALL QIKPLT(TP,H1P,IP,3H*T*,7H*H1(T)*,12H*H1(T) VS T*,1)
C...  CALL QIKSAX(3,3)
C...  CALL QIKPLT(TP,H2P,IP,3H*T*,7H*H2(T)*,12H*H2(T) VS T*,1)
C...  CALL QIKSAX(3,3)
C...  CALL QIKPLT(TP,V1P,IP,3H*T*,7H*V1(T)*,12H*V1(T) VS T*,1)
C...  CALL QIKSAX(3,3)
C...  CALL QIKPLT(TP,REP,IP,3H*T*,4H*RE*,9H*RE VS T*,1)
C...
C...  ****************************************************************
C...
      RETURN
      END
TWO HOLDING TANKS WITH LONG CONNECTING LINE, INLET AND DISCHARGE LINES
0.        500.      10.
    3 1000    1    1  REL 0.001
END OF RUNS
*APP FLOW15
      SUBROUTINE INITAL
C...
C...  TRANSIENTS IN A HYDRAULIC SYSTEM WITH A LONG LINE
C...
C...  8,000 GPM OF WATER ARE BEING PUMPED TO A CYLINDRICAL TANK, 7 FT
C...  HIGH AND 12 FT ID.  WATER FLOWS OUT OF THE TANK BY GRAVITY THROUGH
C...  3,000 FT OF A HORIZONTAL 3 FT ID PIPE CONNECTED TO THE BOTTOM OF
C...  THE TANK.  THE SYSTEM HAS BEEN OPERATING AT STEADY STATE, AND IT
C...  IS NOW PLANNED TO INCREASE THE FLOW RATE TO 16,000 GPM.  ONE OF
C...  THE OPERATORS SUGGESTED THAT THIS COULD BE DONE IN A SINGLE STEP
C...  CHANGE SINCE THIS SYSTEM WAS OPERATING AT THIS FLOW RATE BEFORE.
C...  HOWEVER, ONE OF THE YOUNG ENGINEERS ARGUED THAT THIS COULD PRODUCE
C...  A SPILL AND PROPOSED A TWO-STEP OPERATION WHEREBY THE FLOW RATE
C...  WOULD FIRST BE INCREASED TO 12,000 GPM AND AFTER 5 MIN IT WOULD
C...  AGAIN BE INCREASED TO 16,000 GPM, THEREBY PREVENTING A SPILL.  THE
C...  PROBLEM THEN IS TO SIMULATE BOTH PROPOSED OPERATIONS TO DETERMINE
C...  WHICH, IF EITHER, WOULD PREVENT A SPILL.  THE DESCRIPTIVE EQUA-
C...  TIONS ARE
C...
C...          D(RHO*ST*H)/DT = F0*RHO - RHO*V*SP
C...
C...          (1/GC)*D(RHO*L*SP*V)/DT = RHO*(G/GC)*SP*H
C...
C...                                  - F*SP*RHO*L*V*ABS(V)/(2*GC*D)
C...
C...          F = 0.0056 + 0.5/ABS(RE)**0.32
C...
C...  WHERE
C...
C...     L       LENGTH OF THE PIPE
C...
C...     SP      PIPE CROSS-SECTIONAL AREA
C...
C...     V       AVERAGE FLUID VELOCITY IN THE PIPE
C...
C...     RHO  DFLUID DENSITY
C...
C...     F0      FLUID ENTERING VOLUMETRIC FLOW RATE
C...
C...     ST      TANK CROSS-SECTIONAL AREA
C...
C...     H       LIQUID HEIGHT IN THE TANK
C...
C...     F       FRICTION FACTOR
C...
C...     RE      REYNOLDS NUMBER
C...
      COMMON/T/     T, NSTOP, NORUN
     1      /Y/     V,     H
     2      /F/  DVDT,  DHDT
     3      /C/   RHO,    ST,    SP,    XL,    G,    GC,     D,    RE,
     4              F,    F0,   VIS
C...
C...  SET THE MODEL PARAMETERS
      RHO=62.5
      VIS=6.72E-04
      ST=3.1415927*(12.**2)/4.
      SP=3.1415927*(3.**2)/4.
      XL=3000.
      G=32.2
      GC=32.2
      D=3.
C...
C...  SET THE INITIAL STEADY STATE CONDITIONS
      V=(0.13368*8000.)/(SP*60.)
      RE=(RHO*V*D)/VIS
      F=0.0056+0.5/ABS(RE)**0.32
      H=(F*XL*V*ABS(V))/(2.*G*D)
C...
C...  INITIALIZE THE REST OF THE MODEL
      CALL DERV
      RETURN
      END
      SUBROUTINE DERV
      COMMON/T/     T, NSTOP, NORUN
     1      /Y/     V,     H
     2      /F/  DVDT,  DHDT
     3      /C/   RHO,    ST,    SP,    XL,    G,    GC,     D,    RE,
     4              F,    F0,   VIS
C...
C...  ALGEBRAIC VARIABLES
      RE=(RHO*V*D)/VIS
      F=0.0056+0.5/ABS(RE)**0.32
      GO TO(1,2),NORUN
C...
C...  INITIAL FLOW OF 16000 GPM
1     IF(T.EQ.0.)F0=0.13368*8000./60.
      IF(T.GT.0.)F0=0.13368*16000./60.
      GO TO 10
C...
C...  INITIAL FLOW OF 12000 FOLLOWED BY FLOW OF 16000 AT T = 300 SEC
2     IF(T.EQ.0.)F0=0.13368*8000./60.
      IF(T.GT.0.)F0=0.13368*12000./60.
      IF(T.GT.300.)F0=0.13368*16000./60.
C...
C...  DIFFERENTIAL EQUATIONS
10    DHDT=(1./ST)*(F0-V*SP)
      DVDT=(GC/(XL*SP))*(G*SP*H/GC - F*SP*XL*V*ABS(V)/(2.*GC*D))
      RETURN
      END
      SUBROUTINE PRINT(NI,NO)
      COMMON/T/     T, NSTOP, NORUN
     1      /Y/     V,     H
     2      /F/  DVDT,  DHDT
     3      /C/   RHO,    ST,    SP,    XL,    G,    GC,     D,    RE,
     4              F,    F0,   VIS
C...
C...  PRINT A HEADING FOR THE NUMERICAL SOLUTION
      IF(T.LT.1.)WRITE(NO,1)
1     FORMAT(9X,1HT,11X,1HV,11X,1HH,8X,4HDVDT,8X,4HDHDT,10X,2HF0,10X,
     1 2HRE,11X,1HF)
C...
C...  PRINT THE NUMERICAL SOLUTION
      FGPM=F0*60./0.13368
      WRITE(NO,2)T,V,H,DVDT,DHDT,FGPM,RE,F
2     FORMAT(F10.1,7E12.3)
      RETURN
      END
TRANSIENTS IN A HYDRAULIC SYSTEM WITH A LONG LINE
0.        1000.     10.
    2 1000    2    1  REL 0.001
TRANSIENTS IN A HYDRAULIC SYSTEM WITH A LONG LINE
0.        1000.     10.
    2 1000    2    1  REL 0.001
END OF RUNS
*APP FLOW16
      SUBROUTINE INITAL
C...
C...  ADVECTION EQUATION WITH VARIABLE VELOCITY
C...
C...  A 6-IN. ID PIPE, 300 FT LONG, CONNECTS TWO PROCESS UNITS.  THE
C...  LIQUID FLOWS THROUGH THE PIPE IN ESSENTIALLY PLUG-FLOW CONDITIONS,
C...  SO THE PIPE ACTS AS A PURE TIME DELAY OR DEAD TIME.  THIS DEAD
C...  TIME VARIES WITH THE FLOW RATE THROUGH THE PIPE.  FROM TIME EQUALS
C...  ZERO, THE FLOW RATE IS 1,000 GPM FOR 2 MIN.  THEN IT DROPS TO 500
C...  GPM AND HOLDS CONSTANT FOR 3 MIN.  THEN IT JUMPS TO 2,000 GPM FOR
C...  2 MIN AND FINALLY RETURNS TO 1,000 GPM.  LIQUID DENSITY IS 50 LBM/
C...  FT**3.
C...
C...  WHILE THESE FLOW RATE CHANGES ARE OCCURRING, THE TEMPERATURE OF
C...  THE FLUID ENTERING THE PIPE VARIES SINUSOIDALLY
C...
C...     TIN(T) = 100 + 10*SIN(W*T)
C...
C...  WHERE
C...
C...     TIN     INLET TEMPERATURE, F
C...
C...     W       1 RADIAN/MINUTE
C...
C...  THE OUTLET TEMPERATURE OF THE PIPE IS TO BE COMPUTED AS A FUNCTION
C...  OF TIME.
C...
C...  THE MATHEMATICAL MODEL FOR THE PIPE IS THE ADVECTION EQUATION WITH
C...  A VARIABLE VELOCITY
C...
C...     U  + V(T)*U  = 0
C...      T         X
C...
C...  WHERE
C...
C...     U       FLUID TEMPERATURE AT X AND T
C...
C...     T       TIME (MIN)
C...
C...     X       DISTANCE DOWN THE PIPE (FT)
C...
C...  THE DERIVATIVE U  IS APPROXIMATED BY
C...                  X
C...
C...     (1)  TWO-POINT UPWIND DIFFERENCES (STIRRED TANKS IN SERIES) VIA  G
C...          SUBROUTINE DSS012
C...
C...     (2)  THREE-POINT CENTERED DIFFERENCES VIA SUBROUTINE DSS002
C...
C...     (3)  FOUR-POINT BIASED UPWIND DIFFERENECS VIA SUBROUTINE DSS018  G
C...
C...  THESE THREE APPROXIMATIONS ARE USED IN THREE SUCCESSIVE RUNS
C...  (NORUN = 1, 2, 3).  IN ALL CASES, 30 SECTIONS ARE USED IN THE
C...  FINITE DIFFERENCE GRID
C...
      COMMON/T/         T,      NFIN,     NORUN
     1      /Y/     U(31)
     2      /F/    UT(31)
     3      /S/    UX(31)
     4      /C/         N,         W,         V,        AP,        IP,
     5                 XL
C...
C...  SET THE MODEL PARAMETERS
      N=31
      W=1.
      AP=3.1415927*((6./12.)**2)/4.
      XL=300.
      IP=0
C...
C...  SET THE MODEL INITIAL CONDITION
      DO 1 I=1,N
      U(I)=100.
1     CONTINUE
C...
C...  INITIALIZE THE REMAINDER OF THE MODEL
      CALL DERV
      RETURN
      END
      SUBROUTINE DERV
      COMMON/T/         T,      NFIN,     NORUN
     1      /Y/     U(31)
     2      /F/    UT(31)
     3      /S/    UX(31)
     4      /C/         N,         W,         V,        AP,        IP,
     5                 XL
C...
C...  BOUNDARY CONDITION
      U(1)=100.+10.*SIN(W*T)
      UT(1)=0.
C...
C...  VARIABLE VELOCITY
      IF((T.GE.0.).AND.(T.LT.2.))V=1000./(7.481*AP)
      IF((T.GE.2.).AND.(T.LT.5.))V= 500./(7.481*AP)
      IF((T.GE.5.).AND.(T.LT.7.))V=2000./(7.481*AP)
      IF (T.GE.7.)               V=1000./(7.481*AP)
C...
C...  SPATIAL DERIVATIVE
      IF(NORUN.EQ.1)CALL DSS012(0.,XL,N,U,UX,1.)
      IF(NORUN.EQ.2)CALL DSS002(0.,XL,N,U,UX)
      IF(NORUN.EQ.3)CALL DSS018(0.,XL,N,U,UX,1.)
C...
C...  ASSEMBLE THE PDE
      DO 1 I=2,N
      UT(I)=-V*UX(I)
1     CONTINUE
      RETURN
      END
      SUBROUTINE PRINT(NI,NO)
      COMMON/T/         T,      NFIN,     NORUN
     1      /Y/     U(31)
     2      /F/    UT(31)
     3      /S/    UX(31)
     4      /C/         N,         W,         V,        AP,        IP,
     5                 XL
C...
C...  DIMENSION THE ARRAYS FOR PLOTTING
      DIMENSION    TP(101), UP(2,101)
C...
C...  PRINT A HEADING FOR THE NUMERICAL SOLUTION
      IF(IP.EQ.0)WRITE(NO,1)
1     FORMAT(9X,1HT,6X,6HU(0,T),5X,7HU(XL,T))
      WRITE(NO,2)T,U(1),U(N)
2     FORMAT(F10.2,2F12.2)
C...
C...  STORE THE SOLUTION FOR PLOTTING
      IP=IP+1
      UP(1,IP)=U(1)
      UP(2,IP)=U(N)
      TP(IP)=T
C...
C...  PLOT THE NUMERICAL SOLUTION AT THE END OF THE RUN
      IF(IP.LT.101)RETURN
      CALL PLOTS(2,IP,TP,UP)
C...
C...  LABEL THE PLOT
      WRITE(NO,3)
3     FORMAT(1H ,//,24H 1 - U(0,T), 2 - U(XL,T))
      RETURN
      END
LUYBEN, W L, PROCESS MODEL, SIMUL, CONTROL FOR CHE*S, PROB. 5-9
0.        15.       .15
   31 1000    1    1  REL 0.001
LUYBEN, W L, PROCESS MODEL, SIMUL, CONTROL FOR CHE*S, PROB. 5-9
0.        15.       .15
   31 1000    1    1  REL 0.001
LUYBEN, W L, PROCESS MODEL, SIMUL, CONTROL FOR CHE*S, PROB. 5-9
0.        15.       .15
   31 1000    1    1  REL 0.001
END OF RUNS
*APP FLOW17
      SUBROUTINE INITAL
C...
C...  NUMERICAL INSTABILITY DUE TO INCORRECT MODELING OF FLOW REVERSALS
C...
C...  THE FRICTIONAL FORCE ON A FLUID FLOWING THROUGH A PIPE IS A VECTOR
C...  QUANTITY WITH BOTH MAGNITUDE AND DIRECTION.  IF THE DIRECTION OF
C...  THE FRICTIONAL FORCE IS NOT PROPERLY TAKEN INTO ACCOUNT IN A
C...  MOMENTUM BALANCE FOR THE FLUID, THE MATHEMATICAL MODEL FOR THE
C...  FLUID MOTION CAN BE UNSTABLE.
C...
C...  TO ILLUSTRATE THIS POINT, CONSIDER THE FLOW BETWEEN TWO TANKS
C...  CONNECTED BY A LONG PIPE.  THE CONTINUITY (MASS) BALANCES FOR THE
C...  TWO TANKS ARE
C...
C...     DH1/DT = (1/S1)*(-Q)                                        (1)
C...
C...     DH2/DT = (1/S2)*(+Q)                                        (2)
C...
C...  WHERE
C...
C...     H1      HEIGHT OF LIQUID IN TANK 1
C...
C...     H2      HEIGHT OF LIQUID IN TANK 2
C...
C...     Q       VOLUMETRIC FLOW RATE THROUGH THE LINE CONNECTING TANKS
C...             1 AND 2
C...
C...     S1      CROSS SECTIONAL AREA OF TANK 1
C...
C...     S2      CROSS SECTIONAL AREA OF TANK 2
C...
C...  A MOMENTUM BALANCE ON THE FLUID LINE GIVES
C...
C...     DV/DT = (GC/(SP*XL*RHO))*((RHO*G/GC)*SP*(H1 - H2) - FR)     (3)
C...
C...  WHERE
C...
C...     V       FLUID VELOCITY
C...
C...     GC      CONVERSION FACTOR BETWEEN FORCE AND MASS UNITS
C...
C...     SP      PIPE CROSS SECTIONAL AREA
C...
C...     XL      PIPE LENGTH
C...
C...     RHO     FLUID DENSITY
C...
C...     FR      FLUID MOTION
C...
C...  THE FLUID FRICTION TERM, FR, IS COMPUTED THROUGH THE USE OF THE
C...  EMPIRICAL FRICTION FACTOR, WHICH IN TURN DEPENDS ON THE REYNOLDS
C...  NUMBER, RE
C...
C...     RE = V*D*RHO/VIS                                            (4)
C...
C...  WHERE
C...
C...     VIS     FLUID VISCOSITY
C...
C...     D       PIPE DIAMETER
C...
C...  THE FRICTION FACTOR, F, IS THEN GIVEN BY
C...
C...     F = 64/RE, RE LT 2000                                       (5)
C...
C...     F = 0.184/RE**0.2, RE GE 2000                               (6)
C...
C...  THE FRICTION FACTOR IS GENERALLY DEFINED AS
C...
C...     FR = F*SP*RHO*(V**2)/(2*GC*XL/D)                            (7)
C...
C...  HOWEVER, EQUATION (7) DOES NOT GIVE THE FRICTIONAL FORCE, FR, THE
C...  CORRECT SIGN FOR NEGATIVE VELOCITY, V.  IN FACT, IT GIVES A NEGA-
C...  TIVE FRICTIONAL FORCE WHEN V IS NEGATIVE.  THE FRICTIONAL FORCE IS
C...  THEN IN THE DIRECTION OF FLOW AND THIS MAKES EQUATIONS (1), (2)
C...  AND (3) UNSTABLE.
C...
C...  AN ALTERNATIVE TO EQUATION (7) IS
C...
C...     FR = F*SP*RHO*V*ABS(V)/(2*GC*XL/D)                          (8)
C...
C...  THE TERM V*ABS(V) GIVES THE FRICTIONAL FORCE THE CORRECT DIRECTION
C...  (SIGN) REGARDLESS OF THE SIGN OF V.
C...
C...  BOTH EQUATIONS (7) AND (8) ARE PROGRAMMED BELOW FOR TWO SETS OF
C...  INITIAL CONDITIONS
C...
C...     H1(0) = 15, H2(0) = 10, V(0) = 0                            (9)
C...
C...     H1(0) = 10, H2(0) = 15, V(0) = 0                           (10)
C...
C...  INITIAL CONDITION (9) GIVES A POSITIVE V(T) FROM EQUATION (3)
C...  INITIALLY SINCE H1 GT H2 (THE FLOW INITIALLY IS FROM TANK 1 TO
C...  TANK 2).  INITIAL CONDITION (10) GIVES A NEGATIVE V(T) FROM EQUA-
C...  TION (3) INITIALLY.  FOR EACH INITIAL CONDITION, (7) AND (8) ARE
C...  USED IN SUBROUTINE DERV (I.E., A TOTAL FOUR RUNS).  THE READER
C...  SHOULD DECIDE BEFORE RUNNING THE PROGRAM WHICH OF THE FOUR CASES
C...  GIVES UNSTABLE SOLUTIONS, AND FOR THESE CASES, APPROXIMATELY WHEN
C...  THE INSTABILITY OCCURS.  NOTE IN SUBROUTINE PRINT IF AN INSTABIL-
C...  ITY DEVELOPES, AS MANIFEST BY A NEGATIVE LIQUID HEIGHT OR A LIQUID
C...  HEIGHT EXCEEDING 20 IN EITHER TANK, THE RUN IS TERMINATED.
C...
      COMMON/T/      T,   NFIN,  NORUN
     1      /Y/     H1,     H2,      V
     2      /F/  DH1DT,  DH2DT,   DVDT
     3      /C/     S1,     S2,      D,    RHO,    VIS,     GC,     SP,
     4              XL,      G,     RE,      F,     IP
C...
C...  SET THE MODEL PARAMETERS
      S1=100.
      S2=50.
      D=4./12.
      RHO=62.5
      VIS=6.72E-04
      GC=32.2
      SP=3.1415927*(D**2)/4.
      XL=200.
      G=32.2
C...
C...  SELECT EITHER INITIAL CONDITION (9) (NORUN = 1) OR INITIAL CON-
C...  DITION (10) (NORUN = 2)
      GO TO(1,1,2,2),NORUN
1     H1=15.
      H2=10.
      GO TO 10
2     H1=10.
      H2=15.
10    V=1.0E-06
C...
C...  INITIAL THE REMAINING MODEL VARIABLES AND THE DERIVATIVES
      CALL DERV
      IP=0
      RETURN
      END
      SUBROUTINE DERV
C...
C...  SUBROUTINE DERV COMPUTES THE DERIVATIVES DH1/DT, DH2/DT AND DV/DT
C...  DEFINED BY EQUATIONS (1), (2) AND (3)
C...
      COMMON/T/      T,   NFIN,  NORUN
     1      /Y/     H1,     H2,      V
     2      /F/  DH1DT,  DH2DT,   DVDT
     3      /C/     S1,     S2,      D,    RHO,    VIS,     GC,     SP,
     4              XL,      G,     RE,      F,     IP
C...
C...  EQUATIONS (1) AND (2)
      Q=SP*V
      DH1DT=(1./S1)*(-Q)
      DH2DT=(1./S2)*(+Q)
C...
C...  COMPUTE THE FRICTION FACTOR FROM EQUATION (5) AND (6)
      RE=ABS(V)*D*RHO/VIS
      IF(RE.LT.2000.)F=64./RE
      IF(RE.GE.2000.)F=0.184/RE**0.2
C...
C...  COMPUTE THE FRICTIONAL FORCE BY EQUATION (7) (NORUN = 1 OR 3) OR
C...  EQUATION (8) (NORUN = 2 OR 4).  IN BOTH CASES, THE FRICTIONAL
C...  FORCE IS ALREADY SUBSTITUTED IN EQUATION (3)
      IF((NORUN.EQ.1).OR.(NORUN.EQ.3))
     1   DVDT=(GC/(SP*XL*RHO))*((RHO*G/GC)*SP*(H1-H2)-(F*SP*RHO*V*ABS(V)
     2     /(2.*GC)*(XL/D)))
      IF((NORUN.EQ.2).OR.(NORUN.EQ.4))
     1   DVDT=(GC/(SP*XL*RHO))*((RHO*G/GC)*SP*(H1-H2)-(F*SP*RHO*(V**2)
     2     /(2.*GC)*(XL/D)))
C...
C...  THE COMBINATION OF V**2 WITH V LT 0 IS UNSTABLE (NORUN = 4) SO A
C...  STOP IS EXECUTED HERE.  IF THIS STOP IS OMITTED, A MACHINE OVER-
C...  FLOW QUICKLY DEVELOPES BECAUSE OF THE INSTABILITY
      IF((NORUN.EQ.4).AND.(T.GT.0.))NFIN=1
      RETURN
      END
      SUBROUTINE PRINT(NI,NO)
C...
C...  SUBROUTINE PRINT PRINTS AND PLOTS THE NUMERICAL SOLUTIONS, H1(T),
C...  H2(T) AND V(T), FROM EQUATIONS (1), (2) AND (3) RESPECTIVELY
C...
      COMMON/T/      T,   NFIN,  NORUN
     1      /Y/     H1,     H2,      V
     2      /F/  DH1DT,  DH2DT,   DVDT
     3      /C/     S1,     S2,      D,    RHO,    VIS,     GC,     SP,
     4              XL,      G,     RE,      F,     IP
C...
C...  DIMENSION THE ARRAYS TO STORE THE PLOTTED SOLUTIONS
      DIMENSION      HP(2,102),        VP(101),        TP(101)
C...
C...  AT THE BEGINNING OF EACH RUN, PRINT A HEADING FOR THE NUMERICAL
C...  SOLUTION
      IF(IP.EQ.0)WRITE(NO,2)
2     FORMAT(11X,1HT,10X,2HH1,7X,5HDH1DT,10X,2HH2,7X,5HDH2DT,11X,1HV,8X,  G
     1 4HDVDT,10X,2HRE,11X,1HF,3X,9HHEAD/FRIC)
C...
C...  COMPUTE THE RATIO OF THE HEAD TO FRICTIONAL FORCE, AND PRINT THE
C...  NUMERICAL SOLUTION
      RATIO=G*(H1-H2)/((-F*V*ABS(V)/2.)*(XL/D))
      WRITE(NO,1)T,H1,DH1DT,H2,DH2DT,V,DVDT,RE,F,RATIO
1     FORMAT(10E12.3)
C...
C...  STORE THE NUMERICAL SOLUTION FOR SUBSEQUENT PLOTTING
      IP=IP+1
      HP(1,IP)=H1
      HP(2,IP)=H2
      VP(IP)=V
      TP(IP)=T
C...
C...  TEST FOR A NUMERICAL INSTABILITY, AND IF DETECTED, TERMINATE THE
C...  CURRENT RUN
      IF((H1.GT.20.).OR.(H2.GT.20.))NFIN=1
      IF((H1.LT.0.0).OR.(H2.LT.0.0))NFIN=1
C...
C...  AT THE END OF THE RUN, PLOT THE NUMERICAL SOLUTION AFTER DEFINING
C...  A MAXIMUM H1 AND H2 TO SCALE THE PLOTS.  IN EACH CASE, A LABEL IS
C...  ADDED TO THE PLOT
      IF((IP.LT.101).AND.(NFIN.EQ.0))RETURN
      HP(1,IP+1)=20.
      HP(2,IP+1)=20.
      CALL PLOTS(2,IP+1,TP,HP)
      WRITE(NO,11)
11    FORMAT(1H ,//,48H H1(T), H2(T) VS T                              )
      CALL PLOTS(1,IP,TP,VP)
      WRITE(NO,12)
12    FORMAT(1H ,//,48H V(T) VS T                                      )
      RETURN
      END
TRANSIENTS OF A TWO-TANK HYDRAULIC SYSTEM, V*ABS(V)
0.        1000.     10.
    3  500    1    1  REL 0.001
TRANSIENTS OF A TWO-TANK HYDRAULIC SYSTEM, V**2
0.        1000.     10.
    3  500    1    1  REL 0.001
TRANSIENTS OF A TWO-TANK HYDRAULIC SYSTEM, V*ABS(V)
0.        1000.     10.
    3  500    1    1  REL 0.001
TRANSIENTS OF A TWO-TANK HYDRAULIC SYSTEM, V**2
0.        1000.     10.
    3  500    1    1  REL 0.001
END OF RUNS
*APP FLOW18
      SUBROUTINE INITAL
C...
C...  NONLINEAR ADVECTION EQUATION
C...
C...  THE FOLLOWING NONLINEAR ADVECTION EQUATION
C...
C...          U  = ((1/2)U**2)  = 0                                  (1)
C...           T              X
C...
C...  IS TO BE INTEGRATED SUBJECT TO THE INITIAL AND BOUNDARY CONDITIONS
C...
C...          U(X,0) = X, U(0,T) = 0                              (2)(3)
C...
C...  FOR T = 0, 1, 2, 3, 4, 5.  THE ANALYTICAL SOLUTION
C...
C...          U(X,T) = X/(1 + T)                                     (4)   G
C...
C...  IS AVAILABLE FOR EVALUATION OF THE NUMERICAL SOLUTION.
C...
C...  THIS PROBLEM IS TAKEN FROM RICHTMYER, R. D., AND K. W. MORTON,
C...  DIFFERENCE METHODS FOR INITIAL-VALUE PROBLEMS, INTERSCIENCE PUB-
C...  LISHERS, N.Y., 2ND ED., P 128
C...
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/     U(21)
     2      /F/    UT(21)
     3      /S/    UX(21),    US(21)
     4      /C/        XL,        XU,        DX,         N
C...
C...  SET THE PROBLEM PARAMETERS
      N=21
      XL=0.                                                                  D
      XU=1.                                                                  D
      DX=(XU-XL)/FLOAT(N-1)
C...
C...  INITIAL CONDITION (2)
      DO 1 I=1,N
      U(I)=DX*FLOAT(I-1)
1     CONTINUE
C...
C...  INITIALIZE THE CALCULATIONS IN DERV
      CALL DERV
      RETURN
      END
      SUBROUTINE DERV
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/     U(21)
     2      /F/    UT(21)
     3      /S/    UX(21),    US(21)
     4      /C/        XL,        XU,        DX,         N
C...
C...  BOUNDARY CONDITION (3)
      U(1)=0.
C...
C...  IMPLEMENT THE RHS OF EQUATION (1) IN TWO WAYS
      GO TO(1,2),NORUN
C...
C...     (1)  NORUN = 1, (U**2)
C...                           X
1        DO 11 I=1,N
         US(I)=U(I)**2
11       CONTINUE
C...
C...     COMPUTE THE DERIVATIVE IN X
         CALL DSS004(XL,XU,N,US,UX)
C...
C...     ASSEMBLE EQUATION (1)
         DO 12 I=1,N
         UT(I)=-0.5*UX(I)
12       CONTINUE
         UT(1)=0.
         RETURN
C...
C...     (2)  NORUN = 2, U*U
C...                        X
C...     COMPUTE THE DERIVATIVE IN X
2        CALL DSS004(XL,XU,N,U,UX)
C...
C...     ASSEMBLE EQUATION (1)
         DO 21 I=1,N
         UT(I)=-U(I)*UX(I)
21       CONTINUE
         UT(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),    US(21)
     4      /C/        XL,        XU,        DX,         N
C...
C...  PRINT A HEADING FOR THE NUMERICAL AND EXACT SOLUTIONS
      IF(T.GT.0.5)GO TO 2
      WRITE(NO,1)
1     FORMAT(9X,1HT,9X,1HX,4X,11HU(X,T) ANAL,5X,10HU(X,T) NUM,11X,4HDIFF  G
     1)
      WRITE(NO,6)
6     FORMAT(1H ,/)
C...
C...  COMPUTE THE EXACT SOLUTION AND THE DIFFERENCE BETWEEN THE NUMERI-
C...  CAL AND EXACT SOLUTIONS
2     DO 3 I=1,N,2
      X=DX*FLOAT(I-1)
      UANAL=X/(1.+T)
      DIFF=U(I)-UANAL
C...
C...  PRINT THE TWO SOLUTIONS
      IF(I.EQ.1)WRITE(NO,4)T,X,UANAL,U(I),DIFF
      IF(I.NE.1)WRITE(NO,5)  X,UANAL,U(I),DIFF
4     FORMAT(2F10.1,3F15.4)
5     FORMAT(10X,F10.1,3F15.4)
3     CONTINUE
      WRITE(NO,6)
      RETURN
      END
NONLINEAR ADVECTION EQUATION, U**2
0.        5.0       1.0
   21 1000    1    1  REL 0.0001
NONLINEAR ADVECTION EQUATION, U*UX
0.        5.0       1.0
   21 1000    1    1  REL 0.0001
END OF RUNS
*APP FLOW19
      SUBROUTINE INITAL
C...
C...  DYNAMICS OF TWO TANKS CONNECTED BY A LONG LINE
C...
C...  TWO CYLINDRICAL TANKS ARE CONNECTED BY A LONG LINE AT THEIR
C...  BASE.  THE SPECIFICATIONS FOR THE SYSTEM ARE
C...
C...     TANK 1 - HEIGHT = 6 METERS
C...              DIAMETER = 3 METERS
C...
C...     TANK 2 - HEIGHT = 6 METERS
C...              DIAMETER = 4 METERS
C...
C...     LINE - LENGTH = 50 METERS
C...            DIAMETER = 15 CM
C...
C...  TANKS 1 AND 2 INITIALLY CONTAIN WATER AT DEPTHS OF 5 METERS
C...  AND 2 METERS, RESPECTIVELY.  THE HEIGHT OF THE WATER IN THE
C...  TWO TANKS AND THE FLOW RATE THROUGH THE LINE IS CALCULATED
C...  AS A FUNCTION OF TIME BY THE INTEGRATION OF THE THREE
C...  DIFFERENTIAL EQUATIONS
C...
C...     D(A1*H1*RHO)/DT = -RHO*Q                                    (1)
C...
C...     D(A2*H2*RHO)/DT =  RHO*Q                                    (2)
C...
C...     (1/GC)*D(AL*XL*RHO*V)/DT = FH - FF                          (3)
C...
C...  WHERE
C...
C...     A1        CROSS SECTIONAL AREA OF TANK 1 (M**3)
C...
C...     A2        CROSS SECTIONAL AREA OF TANK 2 (M**3)
C...
C...     AL        LINE CROSS SECTIONAL AREA (M**2)
C...
C...     XL        LINE LENGTH (M)
C...
C...     H1        HEIGHT OF LIQUID IN TANK 1 (M)
C...
C...     H2        HEIGHT OF LIQUID IN TANK 2 (M)
C...
C...     V         VELOCITY OF FLOW THROUGH THE LINE (M/SEC)
C...
C...     T         TIME (SEC)
C...
C...     RHO       LIQUID DENSITY (KG/M**3)
C...
C...     Q         LIQUID VOLUMETRIC FLOW RATE (M**3/SEC)
C...
C...     G         ACCELERATION OF GRAVITY (M/SEC**2)
C...
C...     GC        CONVERSION FACTOR (KG-M/N-SEC**2)
C...
C...     FH        HYDROSTATIC FORCE (N)
C...
C...     FF        FRICTIONAL FORCE (N)
C...
C...  THE HYDROSTATIC FORCE IN THE MOMENTUM BALANCE, EQUATION (3), IS
C...  GIVEN BY
C...
C...     FH = RHO*(G/GC)*(H1 - H2)*AL                                (4)
C...
C...  THE FRICTIONAL FORCE IN EQUATION (3) IS GIVEN BY
C...
C...     FF = (-DP)*AL = (F*RHO*V**2*XL)/(2*GC*DL)*AL                (5)
C...
C...  WHERE
C...
C...     -DP       PRESSURE DROP IN THE LINE (N/M**2)
C...
C...     F         FRICTION FACTOR (DIMENSIONLESS)
C...
C...     DL        LINE DIAMETER (M)
C...
C...  THE FRICTION FACTOR, IN TURN, IS A FUNCTION OF THE REYNOLDS
C...  NUMBER
C...
C...     F = 64/RE, RE LT 2000 (POISEUILLE*S LAW)                    (6)
C...
C...     F = 0.184/RE**0.2, RE GT 2000                               (7)
C...
C...     RE = DL*RHO*V/VIS                                           (8)
C...
C...  WHERE
C...
C...     VIS       FLUID VISCOSITY (KG/M-SEC)
C...
C...  THE INITIAL CONDITIONS FOR EQUATIONS (1), (2) AND (3) ARE
C...
C...     H1(0) = 5, H2(0) = 2, V(0) = 0                              (9)
C...
      COMMON/T/      T,  NSTOP,  NORUN
     1      /Y/     H1,     H2,      V
     2      /F/  DH1DT,  DH2DT,   DVDT
     3      /C/     D1,     D2,     DL,     A1,     A2,     AL,
     4              XL,    RHO,    VIS,      Q,      F,      G,
     5              RE,     FF,     HF,     IP
C...
C...  SET THE MODEL PARAMETERS
      RHO=1000.
      VIS=0.001
      D1=3.
      D2=4.
      DL=15./100.
      XL=50.
      G=9.8
C...
C...  CALCULATE THE MODEL CONSTANTS
      PI=4.*ATAN(1.)
      A1=PI*D1**2/4.
      A2=PI*D2**2/4.
      AL=PI*DL**2/4.
C...
C...  SET A COUNTER FOR THE PLOTTED SOLUTION
      IP=0
C...
C...  SET THE MODEL INITIAL CONDITIONS
      H1=5.
      H2=2.
      V=0.
C...
C...  INITIALIZE THE MODEL DERIVATIVE CALCULATIONS
      CALL DERV
      RETURN
      END
      SUBROUTINE DERV
      COMMON/T/      T,  NSTOP,  NORUN
     1      /Y/     H1,     H2,      V
     2      /F/  DH1DT,  DH2DT,   DVDT
     3      /C/     D1,     D2,     DL,     A1,     A2,     AL,
     4              XL,    RHO,    VIS,      Q,      F,      G,
     5              RE,     FF,     HF,     IP
C...
C...  MODEL ALGEBRA
      RE=DL*RHO*ABS(V)/VIS
      IF( RE.LT.0.01)F=0.
      IF((RE.GT.0.01).AND.(RE.LT.2000.))F=64./RE
      IF( RE.GE.2000.)F=0.184/RE**0.2
      HF=(G/XL)*(H1-H2)
      FF=F*V*ABS(V)/(2.*DL)
      Q=V*AL
C...
C...  MODEL DIFFERENTIAL EQUATIONS
      DH1DT=-(1./A1)*Q
      DH2DT= (1./A2)*Q
      DVDT=HF-FF
      RETURN
      END
      SUBROUTINE PRINT(NI,NO)
      COMMON/T/      T,  NSTOP,  NORUN
     1      /Y/     H1,     H2,      V
     2      /F/  DH1DT,  DH2DT,   DVDT
     3      /C/     D1,     D2,     DL,     A1,     A2,     AL,
     4              XL,    RHO,    VIS,      Q,      F,      G,
     5              RE,     FF,     HF,     IP
C...
C...  DIMENSION THE ARRAYS FOR STORING THE PLOTTED SOLUTION
      DIMENSION TP(21),HP(2,21),VP(21)
C...
C...  PRINT A HEADING FOR THE NUMERICAL SOLUTION
      IF(IP.EQ.0)WRITE(NO,1)
1     FORMAT(9X,1HT,8X,2HH1,8X,2HH2,9X,1HV,5X,5HDH1DT,5X,5HDH2DT,6X,
     1 4HDVDT,8X,2HRE,8X,2HHF,8X,2HFF)
C...
C...  PRINT THE NUMERICAL SOLUTION
      WRITE(NO,2)T,H1,H2,V,DH1DT,DH2DT,DVDT,RE,HF,FF
2     FORMAT(F10.0,3F10.3,3F10.5,3E10.2)
C...
C...  STORE THE SOLUTION FOR SUBSEQUENT PLOTTING
      IP=IP+1
      TP(IP)=T
      HP(1,IP)=H1
      HP(2,IP)=H2
      VP(IP)=V
C...
C...  PLOT THE NUMERICAL SOLUTION
      IF(IP.LT.21)RETURN
      CALL TPLOTS(1,IP,TP,VP)
      WRITE(NO,3)
3     FORMAT(1H ,//10H V(T) VS T)
      CALL TPLOTS(2,IP,TP,HP)
      WRITE(NO,4)
4     FORMAT(1H ,//,10H 1 - H1(T),3X,15H 2 - H2(T) VS T)
      RETURN
      END
TWO TANKS CONNECTED BY A LONG LINE
0.        1000.     50.
    3 1000    1    1  REL 0.001
END OF RUNS
*APP FLOW20
      SUBROUTINE INITAL
C...
C...  DYNAMICS OF TWO TANKS CONNECTED BY A LONG LINE WITH PROPORTIONAL
C...  CONTROL OF THE LIQUID HEIGHT IN THE SECOND TANK
C...
C...  THIS PROBLEM IS AN EXTENSION OF THE PROBLEM ENTITLED  DYNAMICS
C...  OF TWO TANKS CONNECTED BY A LONG LINE.  A FEED LINE HAS BEEN ADDED
C...  TO THE FIRST TANK AND AN EXIT LINE HAS BEEN ADDED TO THE SECOND
C...  WHICH HAS A CONTROL VALVE.  THE PROBLEM REQUIREMENT IS TO DETER-
C...  MINE THE CONTROLLER GAIN WHICH WILL KEEP THE OFFSET IN THE SECOND
C...  TANK BELOW A PRESCRIBED LEVEL.  THE DETAILS OF THE PROBLEM ARE
C...  GIVEN IN COMMENTS BELOW BEFORE COMMON/T/.  THE FOLLOWING COMMENTS
C...  ARE FOR THE ORIGINAL PROBLEM
C...
C...  TWO CYLINDRICAL TANKS ARE CONNECTED BY A LONG LINE AT THEIR
C...  BASE.  THE SPECIFICATIONS FOR THE SYSTEM ARE
C...
C...     TANK 1 - HEIGHT = 6 METERS
C...              DIAMETER = 3 METERS
C...
C...     TANK 2 - HEIGHT = 6 METERS
C...              DIAMETER = 4 METERS
C...
C...     LINE - LENGTH = 50 METERS
C...            DIAMETER = 15 CM
C...
C...  TANKS 1 AND 2 INITIALLY CONTAIN WATER AT DEPTHS OF 5 METERS
C...  AND 2 METERS, RESPECTIVELY.  THE HEIGHT OF THE WATER IN THE
C...  TWO TANKS AND THE FLOW RATE THROUGH THE LINE IS CALCULATED
C...  AS A FUNCTION OF TIME BY THE INTEGRATION OF THE THREE
C...  DIFFERENTIAL EQUATIONS
C...
C...     D(A1*H1*RHO)/DT = -RHO*Q                                    (1)
C...
C...     D(A2*H2*RHO)/DT =  RHO*Q                                    (2)
C...
C...     (1/GC)*D(AL*XL*RHO*V)/DT = FH - FF                          (3)
C...
C...  WHERE
C...
C...     A1        CROSS SECTIONAL AREA OF TANK 1 (M**3)
C...
C...     A2        CROSS SECTIONAL AREA OF TANK 2 (M**3)
C...
C...     AL        LINE CROSS SECTIONAL AREA (M**2)
C...
C...     XL        LINE LENGTH (M)
C...
C...     H1        HEIGHT OF LIQUID IN TANK 1 (M)
C...
C...     H2        HEIGHT OF LIQUID IN TANK 2 (M)
C...
C...     V         VELOCITY OF FLOW THROUGH THE LINE (M/SEC)
C...
C...     T         TIME (SEC)
C...
C...     RHO       LIQUID DENSITY (KG/M**3)
C...
C...     Q         LIQUID VOLUMETRIC FLOW RATE (M**3/SEC)
C...
C...     G         ACCELERATION OF GRAVITY (M/SEC**2)
C...
C...     GC        CONVERSION FACTOR (KG-M/N-SEC**2)
C...
C...     FH        HYDROSTATIC FORCE (N)
C...
C...     FF        FRICTIONAL FORCE (N)
C...
C...  THE HYDROSTATIC FORCE IN THE MOMENTUM BALANCE, EQUATION (3), IS
C...  GIVEN BY
C...
C...     FH = RHO*(G/GC)*(H1 - H2)*AL                                (4)
C...
C...  THE FRICTIONAL FORCE IN EQUATION (3) IS GIVEN BY
C...
C...     FF = (-DP)*AL = (F*RHO*V**2*XL)/(2*GC*DL)*AL                (5)
C...
C...  WHERE
C...
C...     -DP       PRESSURE DROP IN THE LINE (N/M**2)
C...
C...     F         FRICTION FACTOR (DIMENSIONLESS)
C...
C...     DL        LINE DIAMETER (M)
C...
C...  THE FRICTION FACTOR, IN TURN, IS A FUNCTION OF THE REYNOLDS
C...  NUMBER
C...
C...     F = 64/RE, RE LT 2000 (POISEUILLE*S LAW)                    (6)
C...
C...     F = 0.184/RE**0.2, RE GT 2000                               (7)
C...
C...     RE = DL*RHO*V/VIS                                           (8)
C...
C...  WHERE
C...
C...     VIS       FLUID VISCOSITY (KG/M-SEC)
C...
C...  THE INITIAL CONDITIONS FOR EQUATIONS (1), (2) AND (3) ARE
C...
C...     H1(0) = 5, H2(0) = 2, V(0) = 0                              (9)
C...
C...  ****************************************************************
C...
C...  THE FOLLOWING COMMENTS DEFINE THE EXTENSION OF THE PROBLEM TO
C...  INCLUDE A FEED LINE TO THE FIRST TANK AND EXIT LINE FROM THE
C...  SECOND TANK WITH A PROPORTIONAL CONTROLLER.  THE EQUATION FOR THE
C...  FIRST TANK BECOMES
C...
C...     D(A1*H1*RHO)/DT = RHO*(Q0 - Q1)                            (10)
C...
C...  SIMILARLY, THE EQUATION FOR THE SECOND TANK IS
C...
C...     D(A2*H2*RHO)/DT = RHO*(Q1 - Q2)                            (11)
C...
C...  WITH THE EXITING FLOW RATE FROM THE SECOND TANK CONTROLLED
C...  ACCORDING TO THE EQUATIONS (FOR THE VALVE AND CONTROLLER,
C...  RESPECTIVELY)
C...
C...     Q2 = CV*X*H2**0.5                                          (12)
C...
C...     X = 0.5 + KC*(H2 - H2SET)                                  (13)
C...
C...  WHERE
C...
C...     Q0        FLOW RATE TO THE FIRST TANK (M**3/SEC)
C...
C...     Q1        FLOW RATE FROM THE FIRST TANK (M**3/SEC)
C...
C...     Q2        FLOW RATE FROM THE SECOND TANK (M**3/SEC)
C...
C...     CV        VALVE CONSTANT (M**3/SEC-M**0.5)
C...
C...     X         VALVE STEM POSITION (DIMENSIONLESS)
C...
C...     KC        CONTROLLER GAIN (1/M)
C...
C...  ****************************************************************
C...
      COMMON/T/      T,  NSTOP,  NORUN
     1      /Y/     H1,     H2,      V
     2      /F/  DH1DT,  DH2DT,   DVDT
     3      /C/     D1,     D2,     DL,     A1,     A2,     AL,
     4              XL,    RHO,    VIS,     Q0,     Q1,     Q2,
     5              CV,      X,      F,      G,     RE,     FF,
     6              HF,     KC,  H2SET,     IP
C...
C...  ACCESS THE INPUT/OUTPUT DEVICE NUMBERS SO THE CONTROLLER GAIN
C...  CAN BE PRINTED BELOW
      COMMON/IO/    NI,     NO
C...
C...  REAL THE CONTROLLER GAIN FOR SUBSEQUENT CALCULATIONS
      REAL KC
C...
C...  SET THE MODEL PARAMETERS
      RHO=1000.
      VIS=0.001
      D1=3.
      D2=4.
      DL=15./100.
      XL=50.
      G=9.8
      Q0=0.06491
      CV=0.0918
      H2SET=2.
C...
C...  CALCULATE THE MODEL CONSTANTS
      PI=4.*ATAN(1.)
      A1=PI*D1**2/4.
      A2=PI*D2**2/4.
      AL=PI*DL**2/4.
C...
C...  THE CONTROLLER GAIN IS CALCULATED BY ELIMINATING X BETWEEN
C...  EQUATIONS (12) AND (13) WITH Q2 = 0.0750, THE STEADY STATE
C...  FLOW THROUGH THE SYSTEM AND FROM THE SECOND TANK.  THE
C...  CORRESPONDING MAXIMUM OFFSET IN THE SECOND TANK IS H2 - H2SET
C...  = 0.2
      KC=(0.0750/(0.0918*SQRT(2.2))-0.5)/0.2
C...
C...  THREE RUNS ARE PROGRAMMED FOR KC CORRESPONDING TO A MAXIMUM
C...  OFFSET H2 - H2SET = 0.2, AND 1.5, 2.0 TIMES THIS GAIN
      IF(NORUN.EQ.2)KC=1.5*KC
      IF(NORUN.EQ.3)KC=2.0*KC
C...
C...  PRINT THE CONTROLLER GAIN
      WRITE(NO,1)KC
1     FORMAT(6H KC = ,F7.3,//)
C...
C...  SET A COUNTER FOR THE PLOTTED SOLUTION
      IP=0
C...
C...  SET THE MODEL INITIAL CONDITIONS
      H1=5.
      H2=2.
      V=Q0/AL
C...
C...  INITIALIZE THE MODEL DERIVATIVE CALCULATIONS
      CALL DERV
      RETURN
      END
      SUBROUTINE DERV
      COMMON/T/      T,  NSTOP,  NORUN
     1      /Y/     H1,     H2,      V
     2      /F/  DH1DT,  DH2DT,   DVDT
     3      /C/     D1,     D2,     DL,     A1,     A2,     AL,
     4              XL,    RHO,    VIS,     Q0,     Q1,     Q2,
     5              CV,      X,      F,      G,     RE,     FF,
     6              HF,     KC,  H2SET,     IP
      REAL KC
C...
C...  DISTURBANCE IN THE ENTERING FLOW RATE
      IF(T.GE.200.)Q0=0.0750
C...
C...  MODEL ALGEBRA
      RE=DL*RHO*ABS(V)/VIS
      IF( RE.LT.0.01)F=0.
      IF((RE.GT.0.01).AND.(RE.LT.2000.))F=64./RE
      IF( RE.GE.2000.)F=0.184/RE**0.2
      HF=(G/XL)*(H1-H2)
      FF=F*V*ABS(V)/(2.*DL)
      Q1=V*AL
      X=0.5+KC*(H2-H2SET)
      Q2=CV*X*SQRT(H2)
C...
C...  MODEL DIFFERENTIAL EQUATIONS
      DH1DT=(1./A1)*(Q0-Q1)
      DH2DT=(1./A2)*(Q1-Q2)
      DVDT=HF-FF
      RETURN
      END
      SUBROUTINE PRINT(NI,NO)
      COMMON/T/      T,  NSTOP,  NORUN
     1      /Y/     H1,     H2,      V
     2      /F/  DH1DT,  DH2DT,   DVDT
     3      /C/     D1,     D2,     DL,     A1,     A2,     AL,
     4              XL,    RHO,    VIS,     Q0,     Q1,     Q2,
     5              CV,      X,      F,      G,     RE,     FF,
     6              HF,     KC,  H2SET,     IP
      REAL KC
C...
C...  DIMENSION THE ARRAYS FOR STORING THE PLOTTED SOLUTION
      DIMENSION TP(41),H2OP(3,41),XP(3,41)
C...
C...  PRINT A HEADING FOR THE NUMERICAL SOLUTION
      IF(IP.EQ.0)WRITE(NO,1)
1     FORMAT(9X,1HT,8X,2HH1,8X,2HH2,8X,2HQ0,8X,2HQ1,8X,2HQ2,
     1 4X,6HDH1/DT,4X,6HDH2/DT,2X,8HH2-H2SET,9X,1HX)
C...
C...  PRINT THE NUMERICAL SOLUTION
      H2O=H2-H2SET
      WRITE(NO,2)T,H1,H2,Q0,Q1,Q2,DH1DT,DH2DT,H2O,X
2     FORMAT(F10.0,2F10.3,7F10.5)
C...
C...  STORE THE SOLUTION FOR SUBSEQUENT PLOTTING
      IP=IP+1
      TP(IP)=T
      H2OP(NORUN,IP)=H2O
      XP(NORUN,IP)=X
C...
C...  PLOT THE NUMERICAL SOLUTION
      IF(IP.LT.41)RETURN
      IF(NORUN.LT.3)RETURN
      CALL TPLOTS(NORUN,IP,TP,H2OP)
      WRITE(NO,3)
3     FORMAT(1H ,//,18H (H2 - H2SET) VS T)
      CALL TPLOTS(NORUN,IP,TP,XP)
      WRITE(NO,4)
4     FORMAT(1H ,//,7H X VS T)
      RETURN
      END
TWO TANKS CONNECTED BY A LONG LINE WITH PROPORTIONAL CONTROL
0.        4000.     100.
    3 1000    1    1  REL 0.001
TWO TANKS CONNECTED BY A LONG LINE WITH PROPORTIONAL CONTROL
0.        4000.     100.
    3 1000    1    1  REL 0.001
TWO TANKS CONNECTED BY A LONG LINE WITH PROPORTIONAL CONTROL
0.        4000.     100.
    3 1000    1    1  REL 0.001
END OF RUNS
*APP FLOW21
      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     LIQUID 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 FLOW22
      SUBROUTINE INITAL
C...
C...  LIQUID LEVEL CONTROL OF TWO CASCADED TANKS
C...
C...  THIS PROBLEM INVOLVES THE PROPORTIONAL-INTEGRAL (PI) CONTROL
C...  OF THE LIQUID LEVELS IN TWO CASCADED TANKS.  THE LIQUID LEVEL
C...  IS MEASURED IN THE SECOND TANK, AND THE FLOW INTO THE FIRST
C...  TANK IS THEREBY REGULATED.  THE DESCRIPTIVE EQUATIONS ARE
C...
C...  TANK NO. 1
C...
C...     A1*DH1/DT = F0 - F1
C...
C...  TANK NO. 2
C...
C...     A2*DH2/DT = F1 - F2
C...
C...  VALVES INTO TANK 1, BETWEEN TANKS 1 AND 2, OUT OF TANK 2
C...
C...     F0 = CV0*X0*SQRT(H0)
C...
C...     F1 = CV1*X1*SQRT(H1)
C...
C...     F2 = CV2*X2*SQRT(H2)
C...
C...  CONTROLLER EQUATIONS
C...
C...     E = H2SET - H2
C...
C...     X0 = X0S + KC*(E + (1/TI)*INT(E))
C...
C...  WHERE
C...
C...     H1        HEIGHT OF THE LIQUID IN TANKS 1 AND 2, RESPECTIVELY,
C...     H2        (CM)
C...
C...     A1        CROSS SECTIONAL AREAS OF TANKS 1 AND 2, RESPECTIVELY,
C...     A2        (CM**2)
C...
C...     F0        FLOW INTO TANKS 1 AND 2, RESPECTIVELY, FLOW OUT OF
C...     F1        TANK 2 (CU CM/SEC)
C...     F2
C...
C...     H0        UPSTEAM HEAD AVAILABLE FOR FLOW INTO TANK 1 (CM)
C...
C...     CV0       VALVE CONSTANTS (CU CM/SEC-CM**0.5)
C...     CV1
C...     CV2
C...
C...     X0        VALVE STEM POSITIONS (DIMENSIONLESS AND LIMITED TO
C...     X1        THE INTERVAL 0 TO 1)
C...     X2
C...
C...     E         ERROR IN THE HEIGHT H2 (CM)
C...
C...     H2SET     SET POINT FOR H2 (CM)
C...
C...     X0S       STEADY STATE VALVE STEM POSITION (DIMENSIONLESS)
C...
C...     KC        CONTROLLER GAIN (1/CM), INTEGRAL TIME (SEC), RE-
C...     TI        SPECTIVELY
C...
C...  COMMON AREAS FOR DSS/2, MODEL CONSTANTS AND VARIABLES
      COMMON/T/     T,  NFIN,  NRUN
     1      /Y/    H1,    H2,    EI
     2      /F/ DH1DT, DH2DT,     E
     3      /C/    A1,    A2,   CV0,   CV1,   CV2,   X0S,    X1,
     4             X2,    TI,   AKC, H2SET,    H0,    F0,    F1,
     5             F2,    X0
C...
C...  SET THE MODEL PARAMETERS
      A1=10000.
      A2=10000.
      CV0=3000.
      CV1=3000.
      CV2=3000.
      X0S=0.5
      X1=1.
      X2=1.
      H0=400.
C...
C...  SEVERAL RUNS ARE PROGRAMMED TO INVESTIGATE THE CONTROLLER PERFOR-
C...  MANCE
      GO TO(1,2,3,4,5,6),NRUN
C...
C...  WITH NO CONTROL (AKC = 0), THE SYSTEM WILL REACH THE STEADY STATE
C...  H1 = H2 = 100.  TI AND H2SET ARE DEFINED SIMPLY TO AVOID UNDEFINED
C...  VARIABLES WHEN THE CONTROLLER EQUATION IS USED IN SUBROUTINE DERV.
C...  FOR H1 = H2 = 100, THE FLOWS THROUGH THE THREE VALVES ARE F0 = F1
C...  F2 = 30000.  SINCE ALL THREE FLOWS ARE EQUAL, FROM THE ORDINARY
C...  DIFFERENTIAL EQUATIONS (ODE*S), DH1/DT = DH2/DT = 0 CORRESPONDING
C...  TO THE STEADY STATE H1 = H2 = 100
1     AKC=0.
      TI=100.
      H2SET=100.
      GO TO 10
C...
C...  WITH CONTROL, THE SYSTEM WILL ALSO REACH THE STEADY STATE H1 = H2
C...  = 100 IF H2SET = 100.  NOTE THEREFORE THAT FOR CASES 1 AND 2 (NRUN
C...  = 1, 2), THE SYSTEM WILL REACH THE SAME STEADY STATE, WITH OR
C...  WITHOUT CONTROL.  IN THIS SENSE, THE SYSTEM SELF-REGULATES TO
C...  H1 = H2 = 100 REGARDLESS OF THE INITIAL CONITION (WHICH IN THIS
C...  CASE IS H1(0) = 100, H2(0) = 75)
2     AKC=0.03
      TI=100.
      H2SET=100.
      GO TO 10
C...
C...  PROPORTIONAL CONTROL ONLY WITH H2SET = 125 DEMONSTRATES OFFSET
C...  (THE ERROR AT STEADY STATE).  INTEGRAL CONTROL IS ESSENTIALLY
C...  REMOVED BY SETTING TI TO A LARGE VALUE (THE INTEGRAL ACTION IS
C...  PROPORTIONAL TO 1/TI IN THE CONTROLLER EQUATION), AND THE CORRES-
C...  PONDING OFFSET IS 1.80 CM
3     AKC=0.03
      TI=100000.
      H2SET=125.
      GO TO 10
C...
C...  PROPORTIONAL PLUS INTEGRAL (PI) CONTROL DEMONSTRATES THE ELIMI-
C...  NATION OF THE OFFSET OF THE THIRD CASE (I.E., NRUN = 3) BY THE
C...  INTEGRAL ACTION.  THE CONTROLLER PARAMETERS KC AND TI ARE SELECTED
C...  FOR AN UNDERDAMPED RESPONSE (SEE E VS T PLOTTED IN SUBROUTINE
C...  PRINT)
4     AKC=0.03
      TI=100.
      H2SET=125.
      GO TO 10
C...
C...  PROPORTIONAL PLUS INTEGRAL (PI) CONTROL DEMONSTRATES THE ELIMI-
C...  NATION OF THE OFFSET OF THE THIRD CASE (I.E., NRUN = 3) BY THE
C...  INTEGRAL ACTION.  THE CONTROLLER PARAMETERS KC AND TI ARE SELECTED
C...  FOR AN OVERDAMPED RESPONSE (SEE E VS T PLOTTED IN SUBROUTINE
C...  PRINT)
5     AKC=0.0003
      TI=100.
      H2SET=125.
      GO TO 10
C...
C...  PROPORTIONAL PLUS INTEGRAL (PI) CONTROL DEMONSTRATES THE ELIMI-
C...  NATION OF THE OFFSET OF THE THIRD CASE (I.E., NRUN = 3) BY THE
C...  INTEGRAL ACTION.  THE CONTROLLER PARAMETERS KC AND TI ARE SELECTED
C...  FOR A NEAR CRITICALLY DAMPED RESPONSE (SEE E VS T PLOTTED IN SUB-
C...  ROUTINE PRINT)
6     AKC=0.001
      TI=100.
      H2SET=125.
      GO TO 10
10    CONTINUE
C...
C...  SET THE MODEL INITIAL CONDITIONS
      H1=100.
      H2=75.
      EI=0.
C...
C...  INITIALIZE THE CALCULATIONS IN DERV
      CALL DERV
      RETURN
      END
      SUBROUTINE DERV
      COMMON/T/     T,  NFIN,  NRUN
     1      /Y/    H1,    H2,    EI
     2      /F/ DH1DT, DH2DT,     E
     3      /C/    A1,    A2,   CV0,   CV1,   CV2,   X0S,    X1,
     4             X2,    TI,   AKC, H2SET,    H0,    F0,    F1,
     5             F2,    X0
C...
C...  MODEL ALGEBRA
C...
C...     CONTROLLER EQUATIONS
         E=H2SET-H2
         X0=X0S+AKC*(E+(1./TI)*EI)
         IF(X0.LT.0.)X0=0.
         IF(X0.GT.1.)X0=1.
C...
C...     VALVE EQUATIONS
         F0=CV0*X0*SQRT(H0)
         F1=CV1*X1*SQRT(H1)
         F2=CV2*X2*SQRT(H2)
C...
C...  MODEL DIFFERENTIAL EQUATIONS
      DH1DT=(1./A1)*(F0-F1)
      DH2DT=(1./A2)*(F1-F2)
C...
C...  NOTE THAT E IS THE THIRD DERIVATIVE, AND IT IS ALREADY CALCULATED
      RETURN
      END
      SUBROUTINE PRINT(NI,NO)
      COMMON/T/     T,  NFIN,  NRUN
     1      /Y/    H1,    H2,    EI
     2      /F/ DH1DT, DH2DT,     E
     3      /C/    A1,    A2,   CV0,   CV1,   CV2,   X0S,    X1,
     4             X2,    TI,   AKC, H2SET,    H0,    F0,    F1,
     5             F2,    X0
C...
C...  DIMENSION THE ARRAYS FOR THE PLOTTED SOLUTION
      DIMENSION H2P(51), EP(51), TP(51)
C...
C...  INITIALIZE A COUNTER FOR THE PLOTTED SOLUTION
      DATA IP/0/
C...
C...  PRINT A HEADING FOR THE NUMERICAL SOLUTION
      IF(T.LT.0.5)WRITE(NO,1)
1     FORMAT(7X,1HT,6X,2HH1,6X,2HH2,6X,2HX0,6X,2HF0,6X,2HF1,6X,2HF2,
     1 7X,1HE,6X,2HEI)
C...
C...  PRINT THE NUMERICAL SOLUTION EVERY FIFTH CALL TO SUBROUTINE
C...  PRINT
      IP=IP+1
      IF(((IP-1)/5*5).NE.(IP-1))GO TO 3
      WRITE(NO,2)T,H1,H2,X0,F0,F1,F2,E,EI
2     FORMAT(F8.1,2F8.2,F8.3,3F8.0,F8.2,F8.1)
C...
C...  STORE THE SOLUTION FOR SUBSEQUENT PLOTTING
3     H2P(IP)=H2
       EP(IP)=E
       TP(IP)=T
C...
C...  AT THE END OF THE RUN, PLOT THE SOLUTION
      IF(IP.LT.51)RETURN
      CALL TPLOTS(1,IP,TP,H2P)
      WRITE(NO,10)AKC,TI
10    FORMAT(1H ,//,26H H2 (CM) VS T (SEC), KC = ,F7.4,6H TI = ,F8.1)
      CALL TPLOTS(1,IP,TP,EP)
      WRITE(NO,11)AKC,TI
11    FORMAT(1H ,//,26H  E (CM) VS T (SEC), KC = ,F7.4,6H TI = ,F8.1)
C...
C...  INIIALIZE THE COUNTER FOR THE NEXT PLOT
      IP=0
      RETURN
      END
LIQUID LEVEL CONTROL OF TWO CASCADED TANKS - SELF REGULATED
0.        1000.     20.
    3 5000    1    1  REL 0.001
LIQUID LEVEL CONTROL OF TWO CASCASED TANKS
0.        1000.     20.
    3 5000    1    1  REL 0.001
LIQUID LEVEL CONTROL OF TWO CASCASED TANKS
0.        1000.     20.
    3 5000    1    1  REL 0.001
LIQUID LEVEL CONTROL OF TWO CASCASED TANKS
0.        1000.     20.
    3 5000    1    1  REL 0.001
LIQUID LEVEL CONTROL OF TWO CASCASED TANKS
0.        1000.     20.
    3 5000    1    1  REL 0.001
LIQUID LEVEL CONTROL OF TWO CASCASED TANKS
0.        1000.     20.
    3 5000    1    1  REL 0.001
END OF RUNS
*APP FLOW23
      SUBROUTINE INITAL
C...
C...  PRESSURES AND FLOWS IN A PUMP-PIPE-TANK NETWORK BY THE MULTI-
C...  DIMENSIONAL DAVIDENKO ALGORITHM (DIFFERENTIAL FORM OF THE
C...  NEWTON-RAPHSON 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
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
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 FLOW24
      SUBROUTINE INITAL
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 . . . . . . . . . . . . . . . . . S
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.
C...
C...  TWO CASES ARE CONSIDERED
C...
C...     (1)  A SINK (WELL FOR WITHDRAWAL OF WATER) IS LOCATED AT X
C...          = 0, Y = 0 (DESIGNATED AS W)
C...
C...     (2)  A SOURCE IS ADDED TO THE SINK OF (1) AT X = XL, Y = YL
C...          (DESIGNATED AS S).  THE SOURCE AND SINK OF (1) AND (2)
C...          ARE OF EQUAL STRENGTH (FLOW RATE) SO THAT THE ENTIRE
C...          SYSTEM COMES TO A STEADY STATE.
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      /C/         Q,         T,         S,        XL,        YL,
     4                 DX,        DY,         A,         R,        H0
     5      /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...  SOURCE AND SINK FLOW RATES (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/A
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      /C/         Q,         T,         S,        XL,        YL,
     4                 DX,        DY,         A,         R,        H0
     5      /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 SOURCE AND SINK
      IF(NORUN.EQ.1)THEN
         HT(1,1)=HT(1,1)-R/S
      ELSE IF(NORUN.EQ.2)THEN
         HT(1,1)=HT(1,1)-R/S
         HT(N,N)=HT(N,N)+R/S
      END IF
      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)
     3      /C/         Q,         T,         S,        XL,        YL,
     4                 DX,        DY,         A,         R,        H0
     5      /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, SINK ONLY
0.        10.       1.0
  121 1000    1    1  ABS 0.01
AQUIFER SIMULATION, SOURCE AND SINK
0.        25.       2.5
  121 1000    1    1  ABS 0.01
END OF RUNS
*APP FLOW25
      SUBROUTINE INITAL
C...
C...  DYNAMICS OF A ROCKET
C...
C...  THE FOLLOWING EQUATIONS HAVE BEEN PROPOSED FOR THE VELOCITY OF
C...  A ROCKET, VR (1)
C...
C...     DVR/DT + RHO*CD*AR/(2*(M0 - MDOT*T))*VR**2
C...                                                           (1)
C...           - TH*GC/(M0 - MDOT*T) + G = 0
C...
C...     T = ((PE - P0) + RHO*VR**2)*AE                        (2)
C...
C...  WHERE
C...
C...     VR     VELOCITY OF THE ROCKET
C...
C...     T      TIME
C...
C...     RHO    AIR DENSITY
C...
C...     CD     DRAG COEFFICIENT
C...
C...     AR     ROCKET CROSS SECTIONAL AREA
C...
C...     M0     INITIAL ROCKET MASS
C...
C...     MDOT   RATE OF CONSUMPTION OF FUEL
C...
C...     TH     ROCKET THRUST
C...
C...     GC     CONVERSION FACTOR BETWEEN FORCE AND MASS
C...
C...  (1)  KREIDER, JAN F., PRINCIPLES OF FLUID MECHANICS, ALLYN AND
C...       BACON, INC., NEW YORK, PP 50 - 58
C...
C...  THE ROCKET POSITION, XR, CAN ALSO BE CALCULATED FROM THE EQUATION
C...
C...     DXR/DT = VR                                           (3)
C...
C...  THE FOLLOWING INITIAL CONDITIONS WILL BE USED FOR EQUATIONS (1)
C...  AND (3)
C...
C...     XR(0) = VR(0) = 0                                  (4)(5)
C...
C...  THE SOLUTION TO BE COMPUTED IS XR(T) AND VR(T).
C...
C...  COMMON AREA
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/        VR,        XR
     2      /F/     DVRDT,     DXRDT
     3      /C/       RHO,        CD,        AR,        M0,      MDOT,
     4                 TH,         G,        IP
      REAL             M0,      MDOT
C...
C...  SET THE MODEL PARAMETERS
C...
C...  AIR DENSITY
      RHO=0.075
C...
C...  DRAG COEFFICIENT
      CD=0.4
C...
C...  ROCKET FRONTAL AREA
      AR=20.
C...
C...  INITIAL ROCKET MASS
      M0=100000.
C...
C...  FUEL BURN RATE
      MDOT=18500./60.
C...
C...  THRUST
      TH=800000.
C...
C...  GRAVITATIONAL ACCELERATION
      G=32.2
C...
C...  INITIAL CONDITIONS
      VR=0.
      XR=0.
C...
C...  INITIAL DERIVATIVES
      CALL DERV
      IP=0
      RETURN
      END
      SUBROUTINE DERV
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/        VR,        XR
     2      /F/     DVRDT,     DXRDT
     3      /C/       RHO,        CD,        AR,        M0,      MDOT,
     4                 TH,         G,        IP
      REAL             M0,      MDOT
C...
C...  MODEL ALGEBRA
C...
C...     CHECK IF ALL OF THE SOLID FUEL HAS BEEN CONSUMED.  IF SO, THE
C...     THRUST WILL BE ZERO (HERE WE ASSUME THE INITIAL MASS OF THE
C...     FUEL IS 20,000)
         IF(MDOT*T.GE.20000.)TH=0.
C...
C...  MODEL DIFFERENTIAL EQUATIONS
C...
C...     VELOCITY EQUATION
         DVRDT=-(RHO*CD*AR)/(2.0*(M0-MDOT*T))*(VR**2)
     1         +TH*32.2/(M0-MDOT*T)-G
C...
C...     POSITION EQUATION
         DXRDT=VR
      RETURN
      END
      SUBROUTINE PRINT(NI,NO)
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/        VR,        XR
     2      /F/     DVRDT,     DXRDT
     3      /C/       RHO,        CD,        AR,        M0,      MDOT,
     4                 TH,         G,        IP
      REAL             M0,      MDOT
C...
C...  DIMENSION THE ARRAYS FOR PLOTTING
      DIMENSION TP(51), VRP(51), XRP(51), VRTP(51), XRTP(51)
C...
C...  PRINT A HEADING FOR THE SOLUTION
      IF(IP.EQ.0)WRITE(NO,1)
1     FORMAT(9X,'T',8X,'VR',8X,'XR',5X,'TERM1',5X,'TERM2',5X,'TERM3',
     1       4X,'DVR/DT',4X,'DXR/DT')
C...
C...  PRINT THE NUMERICAL SOLUTION EVERY FIFTH CALL TO SUBROUTINE PRINT
      IP=IP+1
      IF(((IP-1)/5*5).EQ.(IP-1))THEN
         TERM1=-RHO*CD*AR/(2.0*(M0-MDOT*T))*(VR**2)
         TERM2=TH/(M0-MDOT*T)
         TERM3=-G
         WRITE(NO,2)T,VR,XR,TERM1,TERM2,TERM3,DVRDT,DXRDT
2        FORMAT(F10.1,7F10.1)
      END IF
C...
C...  STORE THE SOLUTION FOR PLOTTING
      TP(IP)=T
      VRP(IP)=VR
      XRP(IP)=XR
      VRTP(IP)=DVRDT
      XRTP(IP)=DXRDT
C...
C...  PLOT THE NUMERICAL SOLUTION
      IF(IP.LT.51)RETURN
      CALL TPLOTS(1,IP,TP,VRP)
      WRITE(NO,10)
10    FORMAT(1H ,//,' VR(T) (FT/SEC) VS T (SEC)')
      CALL TPLOTS(1,IP,TP,XRP)
      WRITE(NO,11)
11    FORMAT(1H ,//,' XR(T) (FT) VS T (SEC)')
      CALL TPLOTS(1,IP,TP,VRTP)
      WRITE(NO,12)
12    FORMAT(1H ,//,' DVR/DT (FT/SEC**2) VS T (SEC)')
      CALL TPLOTS(1,IP,TP,XRTP)
      WRITE(NO,13)
13    FORMAT(1H ,//,' DXR/DT (FT/SEC) VS T (SEC)')
      IP=0
      RETURN
      END
DYNAMICS OF A ROCKET
0.        25.       0.5
    2 1000    1    1  REL 0.001
END OF RUNS
*APP FLOW26
      PROGRAM EULER
C...
C...  EULER INTEGRATION OF THREE DIFFERENTIAL EQUATIONS FOR THE
C...  DYNAMICS OF TWO TANKS CONNECTED BY A LONG LINE
C...
C...  THE FOLLOWING PROGRAM ILLUSTRATES THE EULER INTEGRATION OF A
C...  SYSTEM OF THREE ORDINARY DIFFERENTIAL EQUATIONS (ODES) WHICH
C...  MODEL THE DYNAMICS OF TWO TANKS CONNECTED BY A LONG LINE.  THE
C...  DETAILS OF THE MODEL, AND THE ODES, ARE GIVEN AS COMMENTS IN
C...  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 AND PLOTTED IN SUBROUTINE PRINT
C...  BY CALLS TO SUBROUTINE TPLOTS.  TPLOTS IS NOT PART OF THE FOLLOW-
C...  ING CODING, BUT IS AVAILABLE FROM DSS/2, OR FROM THE AUTHOR, W. E.
C...  SCHIESSER.
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...  TO OTHER SUBROUTINES, E.G., SUBROUTINE TPLOTS AND SUBRORDINATE
C...  ROUTINES TSKPT, TTYPIT AND TGZRO
      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=1
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=1000.
      TP=50.
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
      DT=1.0
C...
C...  BEGIN THE EULER INTEGRATION
      NSTEPS=INT(TP/DT)
3     DO 1 I=1,NSTEPS
C...
C...  CALCULATE THE DERIVATIVES AT THE BASE POINT
      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
C...
C...  ALL NEQN DEPENDENT VARIABLES HAVE BEEN ADVANCED, SO TAKE THE
C...  NEXT STEP IN TIME
1     CONTINUE
C...
C...  ONE PRINT INTERVAL IS COMPLETE, SO PRINT THE SOLUTION
      T=T+TP
      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...  DYNAMICS OF TWO TANKS CONNECTED BY A LONG LINE
C...
C...  TWO CYLINDRICAL TANKS ARE CONNECTED BY A LONG LINE AT THEIR
C...  BASE.  THE SPECIFICATIONS FOR THE SYSTEM ARE
C...
C...     TANK 1 - HEIGHT = 6 METERS
C...              DIAMETER = 3 METERS
C...
C...     TANK 2 - HEIGHT = 6 METERS
C...              DIAMETER = 4 METERS
C...
C...     LINE - LENGTH = 50 METERS
C...            DIAMETER = 15 CM
C...
C...  TANKS 1 AND 2 INITIALLY CONTAIN WATER AT DEPTHS OF 5 METERS
C...  AND 2 METERS, RESPECTIVELY.  THE HEIGHT OF THE WATER IN THE
C...  TWO TANKS AND THE FLOW RATE THROUGH THE LINE IS CALCULATED
C...  AS A FUNCTION OF TIME BY THE INTEGRATION OF THE THREE
C...  DIFFERENTIAL EQUATIONS
C...
C...     D(A1*H1*RHO)/DT = -RHO*Q                                    (1)
C...
C...     D(A2*H2*RHO)/DT =  RHO*Q                                    (2)
C...
C...     (1/GC)*D(AL*XL*RHO*V)/DT = FH - FF                          (3)
C...
C...  WHERE
C...
C...     A1        CROSS SECTIONAL AREA OF TANK 1 (M**3)
C...
C...     A2        CROSS SECTIONAL AREA OF TANK 2 (M**3)
C...
C...     AL        LINE CROSS SECTIONAL AREA (M**2)
C...
C...     XL        LINE LENGTH (M)
C...
C...     H1        HEIGHT OF LIQUID IN TANK 1 (M)
C...
C...     H2        HEIGHT OF LIQUID IN TANK 2 (M)
C...
C...     V         VELOCITY OF FLOW THROUGH THE LINE (M/SEC)
C...
C...     T         TIME (SEC)
C...
C...     RHO       LIQUID DENSITY (KG/M**3)
C...
C...     Q         LIQUID VOLUMETRIC FLOW RATE (M**3/SEC)
C...
C...     G         ACCELERATION OF GRAVITY (M/SEC**2)
C...
C...     GC        CONVERSION FACTOR (KG-M/N-SEC**2)
C...
C...     FH        HYDROSTATIC FORCE (N)
C...
C...     FF        FRICTIONAL FORCE (N)
C...
C...  THE HYDROSTATIC FORCE IN THE MOMENTUM BALANCE, EQUATION (3), IS
C...  GIVEN BY
C...
C...     FH = RHO*(G/GC)*(H1 - H2)*AL                                (4)
C...
C...  THE FRICTIONAL FORCE IN EQUATION (3) IS GIVEN BY
C...
C...     FF = (-DP)*AL = (F*RHO*V**2*XL)/(2*GC*DL)*AL                (5)
C...
C...  WHERE
C...
C...     -DP       PRESSURE DROP IN THE LINE (N/M**2)
C...
C...     F         FRICTION FACTOR (DIMENSIONLESS)
C...
C...     DL        LINE DIAMETER (M)
C...
C...  THE FRICTION FACTOR, IN TURN, IS A FUNCTION OF THE REYNOLDS
C...  NUMBER
C...
C...     F = 64/RE, RE LT 2000 (POISEUILLE*S LAW)                    (6)
C...
C...     F = 0.184/RE**0.2, RE GT 2000                               (7)
C...
C...     RE = DL*RHO*V/VIS                                           (8)
C...
C...  WHERE
C...
C...     VIS       FLUID VISCOSITY (KG/M-SEC)
C...
C...  THE INITIAL CONDITIONS FOR EQUATIONS (1), (2) AND (3) ARE
C...
C...     H1(0) = 5, H2(0) = 2, V(0) = 0                              (9)
C...
      COMMON/T/      T,  NSTOP,  NORUN
     1      /Y/     H1,     H2,      V
     2      /F/  DH1DT,  DH2DT,   DVDT
     3      /C/     D1,     D2,     DL,     A1,     A2,     AL,
     4              XL,    RHO,    VIS,      Q,      F,      G,
     5              RE,     FF,     HF,     IP
C...
C...  SET THE MODEL PARAMETERS
      RHO=1000.
      VIS=0.001
      D1=3.
      D2=4.
      DL=15./100.
      XL=50.
      G=9.8
C...
C...  CALCULATE THE MODEL CONSTANTS
      PI=4.*ATAN(1.)
      A1=PI*D1**2/4.
      A2=PI*D2**2/4.
      AL=PI*DL**2/4.
C...
C...  SET A COUNTER FOR THE PLOTTED SOLUTION
      IP=0
C...
C...  SET THE MODEL INITIAL CONDITIONS
      H1=5.
      H2=2.
      V=0.
C...
C...  INITIALIZE THE MODEL DERIVATIVE CALCULATIONS
      CALL DERV
      RETURN
      END
      SUBROUTINE DERV
      COMMON/T/      T,  NSTOP,  NORUN
     1      /Y/     H1,     H2,      V
     2      /F/  DH1DT,  DH2DT,   DVDT
     3      /C/     D1,     D2,     DL,     A1,     A2,     AL,
     4              XL,    RHO,    VIS,      Q,      F,      G,
     5              RE,     FF,     HF,     IP
C...
C...  MODEL ALGEBRA
      RE=DL*RHO*ABS(V)/VIS
      IF( RE.LT.0.01)F=0.
      IF((RE.GT.0.01).AND.(RE.LT.2000.))F=64./RE
      IF( RE.GE.2000.)F=0.184/RE**0.2
      HF=(G/XL)*(H1-H2)
      FF=F*V*ABS(V)/(2.*DL)
      Q=V*AL
C...
C...  MODEL DIFFERENTIAL EQUATIONS
      DH1DT=-(1./A1)*Q
      DH2DT= (1./A2)*Q
      DVDT=HF-FF
      RETURN
      END
      SUBROUTINE PRINT(NI,NO)
      COMMON/T/      T,  NSTOP,  NORUN
     1      /Y/     H1,     H2,      V
     2      /F/  DH1DT,  DH2DT,   DVDT
     3      /C/     D1,     D2,     DL,     A1,     A2,     AL,
     4              XL,    RHO,    VIS,      Q,      F,      G,
     5              RE,     FF,     HF,     IP
C...
C...  DIMENSION THE ARRAYS FOR STORING THE PLOTTED SOLUTION
      DIMENSION TP(21),HP(2,21),VP(21)
C...
C...  PRINT A HEADING FOR THE NUMERICAL SOLUTION
      IF(IP.EQ.0)WRITE(NO,1)
1     FORMAT(9X,1HT,8X,2HH1,8X,2HH2,9X,1HV,5X,5HDH1DT,5X,5HDH2DT,6X,
     1 4HDVDT,8X,2HRE,8X,2HHF,8X,2HFF)
C...
C...  PRINT THE NUMERICAL SOLUTION
      WRITE(NO,2)T,H1,H2,V,DH1DT,DH2DT,DVDT,RE,HF,FF
2     FORMAT(F10.0,3F10.3,3F10.5,3E10.2)
C...
C...  STORE THE SOLUTION FOR SUBSEQUENT PLOTTING
      IP=IP+1
      TP(IP)=T
      HP(1,IP)=H1
      HP(2,IP)=H2
      VP(IP)=V
C...
C...  PLOT THE NUMERICAL SOLUTION
      IF(IP.LT.21)RETURN
      CALL TPLOTS(1,IP,TP,VP)
      WRITE(NO,3)
3     FORMAT(1H ,//10H V(T) VS T)
      CALL TPLOTS(2,IP,TP,HP)
      WRITE(NO,4)
4     FORMAT(1H ,//,10H 1 - H1(T),3X,15H 2 - H2(T) VS T)
      RETURN
      END
*APP FLOW27
      PROGRAM EULER
C...
C...  EULER INTEGRATION OF THREE DIFFERENTIAL EQUATIONS FOR THE
C...  DYNAMICS OF TWO TANKS CONNECTED BY A LONG LINE WITH FEED AND
C...  DISCHARGE LINES
C...
C...  THE FOLLOWING PROGRAM ILLUSTRATES THE EULER INTEGRATION OF A
C...  SYSTEM OF THREE ORDINARY DIFFERENTIAL EQUATIONS (ODES) WHICH
C...  MODEL THE DYNAMICS OF TWO TANKS CONNECTED BY A LONG LINE.  THE
C...  DETAILS OF THE MODEL, AND THE ODES, ARE GIVEN AS COMMENTS IN
C...  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 AND PLOTTED IN SUBROUTINE PRINT
C...  BY CALLS TO SUBROUTINE TPLOTS.  TPLOTS IS NOT PART OF THE FOLLOW-
C...  ING CODING, BUT IS AVAILABLE FROM DSS/2, OR FROM THE AUTHOR, W. E.
C...  SCHIESSER.
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...  TO OTHER SUBROUTINES, E.G., SUBROUTINE TPLOTS AND SUBRORDINATE
C...  ROUTINES TSKPT, TTYPIT AND TGZRO
      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=1
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=500.
      TP=10.
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
      DT=1.0
C...
C...  BEGIN THE EULER INTEGRATION
      NSTEPS=INT(TP/DT)
3     DO 1 I=1,NSTEPS
C...
C...  CALCULATE THE DERIVATIVES AT THE BASE POINT
      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
C...
C...  ALL NEQN DEPENDENT VARIABLES HAVE BEEN ADVANCED, SO TAKE THE
C...  NEXT STEP IN TIME
1     CONTINUE
C...
C...  ONE PRINT INTERVAL IS COMPLETE, SO PRINT THE SOLUTION
      T=T+TP
      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...  DYNAMICS OF TWO TANKS CONNECTED BY A LONG LINE WITH FEED AND
C...  DISCHARGE LINES
C...
C...  THE FOLLOWING SYSTEM OF EQUATIONS MODELS TWO HOLDING TANKS
C...  CONNECTED BY A LONG LINE WITH A FEED LINE TO THE FIRST TANK
C...  AND A DISCHARGE LINE WITH A VALVE FROM THE SECOND TANK
C...
C...  MATERIAL BALANCE FOR TANK 1
C...
C...     DH1/DT = (1/S1)*(F0 - F1), F1 = V1*AP
C...
C...  MATERIAL BALANCE FOR TANK 2
C...
C...     DH2/DT = (1/S2)*(F1 - F2), F2 = CV*X*(H2**0.5)
C...
C...  MOMENTUM BALANCE FOR THE FLUID IN THE CONNECTING LINE
C...
C...     (1/GC)*D(AP*L*RHO*V1)/DT =
C...
C...         RHO*(G/GC)*H1*AP - RHO*(G/GC)*H2*AP - FK
C...
C...     FK = F*RHO*L*AP*V1*ABS(V1)*V1/(2*GC*DP)
C...
C...     F = 64/RE, RE LE 2000, F = 0.18/RE**0.2, RE GT 2000
C...
C...     RE = DP*ABS(V1)*RHO/VIS
C...
C...  THE INITIAL CONDITIONS FOR THIS THIRD-ORDER SYSTEM ARE
C...
C...     H1(0) = 2 M, H2(0) = 5 M, V1 = 0 M/S
C...
C...  THE MODEL VARIABLES AND PARAMETERS ARE
C...
C...     H1      HEIGHT OF LIQUID IN THE FIRST TANK (M)
C...
C...     H2      HEIGHT OF LIQUID IN THE SECOND TANK (M)
C...
C...     V1      AVERAGE FLUID VELOCITY IN THE CONNECTING LINE (M/S)
C...
C...     T       TIME (S)
C...
C...     F0      ENTERING FLOW RATE TO THE FIRST TANK (0.2 M**3/S)
C...
C...     F1      FLOW RATE FROM THE FIRST TANK (M**3/S)
C...
C...     F2      FLOW RATE FROM THE SECOND TANK (M**3/S)
C...
C...     AP      CONNECTING LINE CROSS SSCTIONAL AREA (M**2)
C...
C...     DP      CONNECTING LINE DIAMETER (0.3 M)
C...
C...     D1      DIAMETER OF THE FIRST TANK (2.5 M)
C...
C...     D2      DIAMETER OF THE SECOND TANK (3.0 M)
C...
C...     S1      CROSS SECTIONAL AREA OF THE FIRST TANK (M**2)
C...
C...     S2      CROSS SECTIONAL AREA OF THE SECOND TANK (M**2)
C...
C...     RHO  DFLUID DENSITY (1000 KG/M**3)
C...
C...     VIS  DFLUID VISOCITY (0.001 KG/M-S)
C...
C...     CV      VALVE CONSTANT (0.1 M**3/S-M**0.5)
C...
C...     X       VALVE STEM POSITION (1 DIMENSIONLESS)
C...
C...     L       CONNECTING LINE LENGTH (100 M)
C...
C...     G       ACCELERATION OF GRAVITY (9.8 M/S**2)
C...
C...     GC      CONVERSION FACTOR (1 KG-M/N-S**2)
C...
C...     F       FRICTION FACTOR (DIMENSIONLESS)
C...
C...  THE NUMERICAL SOLUTION TO THIS SYSTEM OF ALGEBRAIC AND DIFFER-
C...  ENTIAL EQUATIONS IS PRINTED AND PLOTTED IN SUBROUTINE PRINT
C...
      COMMON/T/     T
     1      /Y/    H1,    H2,    V1
     2      /F/ DH1DT, DH2DT, DV1DT
     3      /C/    D1,    D2,    S1,    S2,    F0,    F1,    F2,
     4             CV,     X,    AP,     L,    DP,   RHO,   VIS,
     5              G,    GC,     F,    RE,    C1,    C2,    IP
      REAL L
C...
C...  DEFINE THE MODEL PARAMETERS
      D1=2.5
      D2=3.0
      F0=0.2
      CV=0.1
      X=1.0
      L=100.
      DP=0.30
      RHO=1000.
      VIS=0.001
      G=9.8
      GC=1.0
C...
C...  PRECOMPUTE SOME CONSTANTS
      PI=3.1415927
      S1=PI*(D1**2)/4.
      S2=PI*(D2**2)/4.
      AP=PI*(DP**2)/4.
      C1=G/L
      C2=1./(2.*DP)
C...
C...  SET THE MODEL INITIAL CONDITIONS
      H1=2.
      H2=5.
      V1=0.
C...
C...  INITIALIZE A COUNTER FOR THE PLOTTED SOLUTION
      IP=0
C...
C...  INITIALIZE THE MODEL DERIVATIVES
      CALL DERV
      RETURN
      END
      SUBROUTINE DERV
      COMMON/T/     T
     1      /Y/    H1,    H2,    V1
     2      /F/ DH1DT, DH2DT, DV1DT
     3      /C/    D1,    D2,    S1,    S2,    F0,    F1,    F2,
     4             CV,     X,    AP,     L,    DP,   RHO,   VIS,
     5              G,    GC,     F,    RE,    C1,    C2,    IP
      REAL L
C...
C...  MODEL ALGEBRA
      RE=DP*ABS(V1)*RHO/VIS
      IF( RE.LT.0.01)F=6400.
      IF((RE.GE.0.01).AND.(RE.LE.2000.))F=64./RE
      IF( RE.GT.2000.)F=0.18/RE**0.2
      F1=AP*V1
      F2=CV*X*SQRT(H2)
C...
C...  MODEL DIFFERENTIAL EQUATIONS
      DH1DT=(1./S1)*(F0-F1)
      DH2DT=(1./S2)*(F1-F2)
      DV1DT=C1*(H1-H2)-C2*F*V1*ABS(V1)
      RETURN
      END
      SUBROUTINE PRINT(NI,NO)
      COMMON/T/     T
     1      /Y/    H1,    H2,    V1
     2      /F/ DH1DT, DH2DT, DV1DT
     3      /C/    D1,    D2,    S1,    S2,    F0,    F1,    F2,
     4             CV,     X,    AP,     L,    DP,   RHO,   VIS,
     5              G,    GC,     F,    RE,    C1,    C2,    IP
      REAL L
C...
C...  DIMENSION THE ARRAYS FOR THE PLOTTED SOLUTION
      DIMENSION  TP(51), H1P(51), H2P(51), V1P(51), REP(51)
C...
C...  PRINT A HEADING FOR THE NUMERICAL SOLUTION
      IF(IP.EQ.0)WRITE(NO,1)
1     FORMAT(9X,1HT,8X,2HH1,8X,2HH2,8X,2HV1,8X,2HRE,8X,2HF1,8X,2HF2)
C...
C...  PRINT THE NUMERICAL SOLUTION
      WRITE(NO,2)T,H1,H2,V1,RE,F1,F2
2     FORMAT(F10.1,3F10.3,E10.3,2F10.4)
C...
C...  STORE THE SOLUTION FOR SUBSEQUENT PLOTTING
      IP=IP+1
      TP(IP)=T
      H1P(IP)=H1
      H2P(IP)=H2
      V1P(IP)=V1
      REP(IP)=RE
C...
C...  PLOT THE NUMERICAL SOLUTION
      IF(IP.LT.51)RETURN
      CALL TPLOTS(1,IP,TP,H1P)
      WRITE(NO,11)
11    FORMAT(1H ,//,8H H1 VS T)
      CALL TPLOTS(1,IP,TP,H2P)
      WRITE(NO,12)
12    FORMAT(1H ,//,8H H2 VS T)
      CALL TPLOTS(1,IP,TP,V1P)
      WRITE(NO,13)
13    FORMAT(1H ,//,8H V1 VS T)
      CALL TPLOTS(1,IP,TP,REP)
      WRITE(NO,14)
14    FORMAT(1H ,//,8H RE VS T)
      RETURN
      END
*APP FLOW28
      PROGRAM EULER
C...
C...  EULER INTEGRATION OF THE DIFFERENTIAL EQUATION FOR DRAINING OF
C...  A TANK
C...
C...  THE FOLLOWING PROGRAM ILLUSTRATES THE EULER INTEGRATION OF AN
C...  ORDINARY DIFFERENTIAL EQUATION (ODE) FOR THE DRAINING OF A TANK.
C...  THE DETAILS OF THE CODING ARE GIVEN AS COMMENTS IN SUBROUTINE
C...  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=100.
      TP=1.
C...
C...  SET THE NUMBER OF DIFFERENTIAL EQUATIONS
      NEQN=1
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=TF/100.
      IF(NORUN.EQ.2)DT=TF/200.
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 OF THE EQUATION FOR THE TIME TO DRAIN A TANK
C...
C...  THE FOLLOWING EQUATION HAS BEEN REPORTED FOR THE HEIGHT OF LIQUID
C...  IN A DRAINING TANK AS A FUNCTION OF TIME (1)
C...
C...     DZ/DT = -(A2/AT)*(2*G*Z)**0.5, Z(0) = ZA            (1)(2)
C...
C...  WHERE
C...
C...     Z     HEIGHT OF LIQUID IN THE TANK
C...
C...     T     TIME
C...
C...     A2    CROSS SECTIONAL AREA OF THE OPENING IN THE BASE OF THE
C...           TANK
C...
C...     AT    CROSS SECTIONAL AREA OF THE TANK
C...
C...     G     ACCELERATION OF GRAVITY
C...
C...     ZA    INITIAL HEIGHT OF LIQUID IN THE TANK
C...
C...  (1)  KREIDER, JAN F., PRINCIPLES OF FLUID MECHANICS, ALLYN AND
C...       BACON, INC., NEW YORK, PP 87-88
C...
C...  COMMON AREA
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/         Z
     2      /F/      DZDT
     3      /C/        A2,        AT,         G,        ZA,        ZB,
     4                 IP
C...
C...  SET THE MODEL PARAMETERS
C...
C...  OPENING CROSS SECTIONAL AREA
      A2=0.25
C...
C...  TANK CROSS SECTIONAL AREA
      AT=5.0
C...
C...  ACCELERATION OF GRAVITY
      G=9.8
C...
C...  INITIAL TANK HEIGHT
      ZA=10.0
C...
C...  FINAL TANK HEIGHT
      ZB=0.5
C...
C...  INITIAL CONDITION
      Z=ZA
C...
C...  INITIAL DERIVATIVES
      CALL DERV
      IP=0
      RETURN
      END
      SUBROUTINE DERV
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/         Z
     2      /F/      DZDT
     3      /C/        A2,        AT,         G,        ZA,        ZB,
     4                 IP
C...
C...  MODEL DIFFERENTIAL EQUATION
      DZDT=-(A2/AT)*SQRT(2.*G*Z)
C...
C...  CHECK FOR THE END OF THE RUN
      IF(Z.LE.ZB)NSTOP=1
      RETURN
      END
      SUBROUTINE PRINT(NI,NO)
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/         Z
     2      /F/      DZDT
     3      /C/        A2,        AT,         G,        ZA,        ZB,
     4                 IP
C...
C...  PRINT A HEADING FOR THE SOLUTION
      IF(IP.EQ.0)WRITE(NO,1)
1     FORMAT(1H ,//,9X,'T',11X,'Z',4X,'Z (ANAL)')
C...
C...  COMPUTE THE ANALYTICAL SOLUTION FOR COMPARISON WITH THE NUMERICAL
C...  SOLUTION
      ZANAL=(SQRT(ZA)-(T*A2*SQRT(2.*G)/(2.*AT)))**2
C...
C...  PRINT THE NUMERICAL AND ANALYTICAL SOLUTIONS
      WRITE(NO,2)T,Z,ZANAL
2     FORMAT(F10.1,2F12.4)
      IP=IP+1
      RETURN
      END
*APP FLOW29
      SUBROUTINE INITAL
C...
C...  HYDRAULIC SYSTEM DYNAMICS
C...
C...  CONSIDER THE FOLLOWING HYDRAULIC SYSTEM
C
C  Q0(T)...
C         .
C  .      .     .                                             CLOSED
C  .      .     . OPEN                                         TANK
C  .      +     . TANK                                      ..........
C  .            .                                           .   AIR  .
C  .            .                                           .  P2(T) .
C  .............. H1(T)                                     .        .
C  .            .                                     H2(T) ..........
C  .            .                                           .        .
C  .            .                                           .        .
C  .            .  .... P(T)                          HFEED .        .
C  .       P1(T)....  ......................................+        .
C  ..............  ....             LONG LINE               .        .
C                  PUMP                                     .        .
C                                                           ..........
C                                                                .
C                                                         VALVE ...
C                                                                .
C                                                               ...
C                                                                .
C                                                                +
C                                                              Q2(T)
C...
C...  THE PURPOSE OF THIS SIMULATION IS TO COMPUTE THE LIQUID HEIGHTS,
C...  H1(T) AND H2(T), THE VELOCITY THROUGH THE LONG LINE, V1(T), THE
C...  LIQUID AND AIR PRESSURES, P1(T) AND P2(T), AND THE DISCHARGE FLOW
C...  RATE, Q2(T).
C
C...  THE MODEL VARIABLES ARE
C...
C...  H1(T)  HEIGHT OF LIQUID IN THE OPEN TANK
C...
C...  H2(T)  HEIGHT OF LIQUID IN THE CLOSED TANK
C...
C...  T      TIME
C...
C...  CV     VALVE CONSTANT
C...
C...  RHO    LIQUID DENSITY
C...
C...  G      ACCELERATION OF GRAVITY
C...
C...  PAT    ATMOSPHERIC PRESSURE
C...
C...  A1,A2  CROSS SECTIONAL AREAS OF THE OPEN AND CLOSED TANKS
C...
C...  P1(T)  PRESSURE AT THE INLET OF THE PUMP
C...
C...  P(T)   PRESSURE AT THE OUTLET OF THE PUMP
C...
C...  P2(T)  PRESSURE OF THE AIR IN THE CLOSED TANK
C...
C...  Q0(T)   VOLUMETRIC FLOW RATE INTO THE OPEN TANK
C...
C...  Q2(T)  VOLUMETRIC FLOW RATE FROM THE CLOSED TANK
C...
C...  HT2    TOTAL HEIGHT OF THE CLOSED TANK
C...
C...  HFEED  HEIGHT OF THE FEED LINE TO THE CLOSED TANK
C...
C...  D      DIAMETER OF THE LONG LINE
C...
C...  L      LENGTH OF THE LONG LINE
C...
C...  THE MODEL PARAMETERS ARE

C...     D1 = 3 M, D2 = 2 M, DP = 0.05 M, RHO = 900 KG/M**3
C...
C...     VIS = 0.002 KG/M-SEC, G = 9.8 M/SEC**2, L = 100 M
C...
C...     Q0 = 0.1 M**3/SEC, H10 = 3 M, H20 = 2 M, V10 = 0 M/SEC
C...
C...     P20 = 1.0E+05 PA, CV = 0.0001 M**3/SEC-(PA**0.5)
C...
C...     HFEED = 1.5 M, HT2 = 5 M
C...
C...  THE FOLLOWING EQUATIONS MODEL THIS SYSTEM
C...
C...     (1) MATERIAL BALANCE FOR THE FIRST TANK
C...
C...     D(S1*H1*RHO)/DT =  Q0*RHO - Q1*RHO
C...
C...     OR, WITH CONSTANT S1*RHO,
C...
C...        DH1/DT = (Q0 - Q1)/S1, H1(0) = H10                   (1)
C...
C...     WITH
C...
C...        Q1 = V1*SP                                           (2)
C...
C...     (2)  MOMENTUM BALANCE FOR THE LIQUID IN THE PIPE
C...
C...     D(AP*L*RHO*V1)/DT = P*AP - (P2 + (H2 - HF)*RHO*G)*AP
C...
C...                       - F*V1*ABS(V1)*L*RHO*AP/(2*D)
C...
C...     OR, WITH CONSTANT AP*L*RHO,
C...
C...     DV1/DT = P - (P2 + (H2 - HF)*RHO*G)/(RHO*L)
C...                                                             (3)
C...            - F*V1*ABS(V1)/(2*D), V1(0) = V10
C...
C...     (NOTE - HF = HFEED).  IN EQUATION (3), IF H2 LT HF, THEN
C...     H2 - HF = 0.  THE PUMP OUTLET PRESSURE, P(T), IS GIVEN BY
C...     THE PUMP CHARACTERISTIC EQUATION
C...
C...     P = P1 + 1.27E+06 + 5.27E+06*Q1 - 2.32E+08*Q1**2        (4)
C...
C...     WHERE
C...
C...     P1 = PAT + RHO*G*H1                                     (5)
C...
C...     (3)  IDEAL GAS LAW APPLIED TO THE AIR IN THE SECOND TANK
C...
C...     IF THE AIR IS ISOTHERMAL
C...
C...     P2*V2 = P20*V20 = N*R*T2
C...
C...     OR
C...
C...     P2*(HT2 - H2)*S2 = P20*(HT2 - H20)*S2                   (6)
C...
C...     WHERE P20 IS THE INITIAL AIR PRESSURE
C...
C...     (4)  MATERIAL BALANCE FOR THE SECOND TANK
C...
C...     D(H2*S2*RHO)/DT = Q1*RHO - Q2*RHO
C...
C...     OR
C...
C...     DH2/DT = (Q1 - Q2)/S2, H2(0) = H20                      (7)
C...
C...     AND THE FLOW THROUGH THE VALVE, Q2, IS GIVEN BY THE USUAL
C...     VALVE EQUATION
C...
C...     Q2 = CV*(P2 + RHO*G*H2 - PAT)**0.5                      (8)
C...
C...  THE FOLLOWING CODING IS FOR THE SOLUTION OF EQUATIONS (1) TO (8).
C...
C...  DSS/2 COMMON AREA
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/        H1,        H2,        V1
     2      /F/     DH1DT,     DH2DT,     DV1DT
     3      /C/        D1,        D2,        DP,       RHO,       VIS,
     4                  G,         L,        Q0,       P20,       PAT,
     5                 HF,       HT2,        CV,        PI,        S1,
     6                 S2,        SP,       H20,        Q1,        Q2,
     7                 RE,         F,        IP
      REAL              L
C...
C...  SET THE MODEL PARAMETERS
C...
C...  TANK DIAMETERS
      D1=3.
      D2=2.
C...
C...  LINE DIAMETER
      IF(NORUN.EQ.1)THEN
         DP=0.05
      ELSE IF(NORUN.EQ.2)THEN
         DP=0.1
      END IF
C...
C...  LIQUID DENSITY, VISCOSITY
      RHO=900.
      VIS=0.002
C...
C...  ACCELERATION OF GRAVITY
      G=9.8
C...
C...  PIPE LENGTH
      L=100.
C...
C...  ENTERING LIQUID FLOW RATE, INITIAL AIR PRESSURE, ATMOSPHERIC
C...  PRESSURE
      Q0=0.1
      P20=1.0E+05
      PAT=1.0E+05
C...
C...  PIPE HEIGHT, SECOND TANK HEIGHT
      HF=1.5
      HT2=5.
C...
C...  VALVE CONSTANT
      CV=0.0001
C...
C...  CALCULATE SOME CONSTANTS FOR USE IN OTHER SUBROUTINES
      PI=3.1415927
      S1=PI*(D1**2)/4.
      S2=PI*(D2**2)/4.
      SP=PI*(DP**2)/4.
C...
C...  MODEL INITIAL CONDITIONS
      H10=3.
      H1=H10
      H20=2.
      H2=H20
      V10=0.
      V1=V10
C...
C...  INITIAL DERIVATIVES
      CALL DERV
      IP=0
      RETURN
      END
      SUBROUTINE DERV
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/        H1,        H2,        V1
     2      /F/     DH1DT,     DH2DT,     DV1DT
     3      /C/        D1,        D2,        DP,       RHO,       VIS,
     4                  G,         L,        Q0,       P20,       PAT,
     5                 HF,       HT2,        CV,        PI,        S1,
     6                 S2,        SP,       H20,        Q1,        Q2,
     7                 RE,         F,        IP
      REAL              L
C...
C...  MODEL ALGEBRA
      Q1=V1*SP
      P1=PAT+RHO*G*H1
      P=P1+1.27E+06+5.27E+06*Q1-2.32E+08*Q1**2
      P2=P20*(HT2-H20)/(HT2-H2)
      Q2=CV*SQRT(P2+RHO*G*H2-PAT)
      RE=DP*ABS(V1)*RHO/VIS
         IF( RE.LT.0.01)F=6400.
         IF((RE.GE.0.01).AND.(RE.LE.2000.))F=64./RE
         IF( RE.GT.2000.)F=0.18/RE**0.2
C...
C...  MODEL DIFFERENTIAL EQUATIONS
      DH1DT=(Q0-Q1)/S1
      DH2DT=(Q1-Q2)/S2
      IF((H2-HF).GE.0.)THEN
        DV1DT=(P-(P2+(H2-HF)*RHO*G))/(RHO*L)-F*V1*ABS(V1)/(2.*DP)
      ELSE
        DV1DT=(P-(P2              ))/(RHO*L)-F*V1*ABS(V1)/(2.*DP)
      END IF
      RETURN
      END
      SUBROUTINE PRINT(NI,NO)
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/        H1,        H2,        V1
     2      /F/     DH1DT,     DH2DT,     DV1DT
     3      /C/        D1,        D2,        DP,       RHO,       VIS,
     4                  G,         L,        Q0,       P20,       PAT,
     5                 HF,       HT2,        CV,        PI,        S1,
     6                 S2,        SP,       H20,        Q1,        Q2,
     7                 RE,         F,        IP
      REAL              L
C...
C...  PRINT A HEADING FOR THE SOLUTION
      IP=IP+1
      IF(IP.EQ.1)THEN
         WRITE(NO,1)
1        FORMAT(9X,'T',8X,'H1',8X,'H2',8X,'V1',
     1              8X,'Q0',8X,'Q1',8X,'Q2')
      END IF
C...
C...  PRINT THE SOLUTION EVERY FIFTH CALL TO SUBROUTINE PRINT
      IF(((IP-1)/5*5).EQ.(IP-1))THEN
         WRITE(NO,2)T,H1,H2,V1,Q0,Q1,Q2
2        FORMAT(F10.1,6F10.3)
      END IF
      RETURN
      END
HYDRAULIC SYSTEM DYNAMICS
0.        1000.      10.
    3 1000    1    1  REL 0.001
HYDRAULIC SYSTEM DYNAMICS
0.        1000.      10.
    3 1000    1    1  REL 0.001
END OF RUNS
*APP FLOW30
      PROGRAM EULER
C...
C...  EULER INTEGRATION OF THE DIFFERENTIAL EQUATION FOR A MANOMETER
C...
C...  THE FOLLOWING PROGRAM ILLUSTRATES THE EULER INTEGRATION OF AN
C...  ORDINARY DIFFERENTIAL EQUATION (ODE) FOR THE MOTION OF A MANO-
C...  METER.  THE DETAILS OF THE CODING ARE GIVEN AS COMMENTS IN
C...  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=5
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=10.
      TP=0.5
C...
C...  SET THE NUMBER OF DIFFERENTIAL EQUATIONS
      NEQN=2
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/1.0
      IF(NORUN.EQ.2)DT=TP/10.0
      IF(NORUN.EQ.3)DT=TP/100.0
      IF(NORUN.EQ.4)DT=TP/1000.0
      IF(NORUN.EQ.5)DT=TP/10000.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 OF THE DIFFERENTIAL EQUATION FOR A MANOMETER
C...
C...  THE FOLLOWING EQUATION HAS BEEN REPORTED FOR THE MOTION OF THE
C...  LIQUID IN A MANOMETER
C...
C...     D2Z/DT2 + (2*G/L)*Z = 0                                (1)
C...
C...  WHERE
C...
C...     Z      DISPLACEMENT OF THE MANOMETER LIQUID RELATIVE TO THE
C...            TEST HEIGHT (M)
C...
C...     T      TIME (SEC)
C...
C...     G      ACCELERATION OF GRAVITY (9.8 M/SEC**2)
C...
C...     L      TOTAL LENGTH OF THE MANOMETER LIQUID (M)
C...
C...  EQUATION (1) IS INTEGRATED SUBJECT TO THE INITIAL CONDITIONS
C...
C...     Z(0) = 0.25 M, DZ(0)/DT = 0
C...
C...  (1)  KREIDER, JAN F., PRINCIPLES OF FLUID MECHANICS, ALLYN AND
C...       BACON, INC., NEW YORK, PP 88-89
C...
C...  COMMON AREA
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/        Z1,        Z2
     2      /F/     DZ1DT,     DZ2DT
     3      /C/         L,         G,        IP
      REAL              L
C...
C...  SET THE MODEL PARAMETERS
C...
C...  ACCELERATION OF GRAVITY
      G=9.8
C...
C...  LIQUID LENGTH
      L=1.0
C...
C...  INITIAL CONDITIONS
      Z1=0.25
      Z2=0.
C...
C...  INITIAL DERIVATIVES
      CALL DERV
      IP=0
      RETURN
      END
      SUBROUTINE DERV
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/        Z1,        Z2
     2      /F/     DZ1DT,     DZ2DT
     3      /C/         L,         G,        IP
      REAL              L
C...
C...  MODEL DIFFERENTIAL EQUATION
      DZ1DT=Z2
      DZ2DT=-(2.*G/L)*Z1
      RETURN
      END
      SUBROUTINE PRINT(NI,NO)
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/        Z1,        Z2
     2      /F/     DZ1DT,     DZ2DT
     3      /C/         L,         G,        IP
      REAL              L
C...
C...  PRINT A HEADING FOR THE SOLUTION
      IF(IP.EQ.0)WRITE(NO,1)
1     FORMAT(1H ,//,9X,'T',14X,'Z',7X,'Z (ANAL)',12X,'ERROR')
C...
C...  COMPUTE THE ANALYTICAL SOLUTION FOR COMPARISON WITH THE NUMERICAL
C...  SOLUTION
      ZANAL=0.25*COS(SQRT(2.*G/L)*T)
C...
C...  PRINT THE NUMERICAL AND ANALYTICAL SOLUTIONS, ERROR
      ERROR=Z1-ZANAL
      WRITE(NO,2)T,Z1,ZANAL,ERROR
2     FORMAT(F10.1,2F15.4,F17.6)
      IP=IP+1
      RETURN
      END
*APP FLOW31
      SUBROUTINE INITAL
C...
C...  EIGENVALUE ANALYSIS OF A FLUID FLOW SYSTEM WITH A FAST MOMENTUM
C...  BALANCE
C...
C...  FREQUENTLY DURING THE DYNAMIC SIMULATION OF A FLUID FLOW SYSTEM,
C...  THE USE OF A MOMENTUM BALANCE TO CALCULATE THE FLUID VELOCITY
C...  LEADS TO A DIFFERENTIAL EQUATION WHICH HAS A FAST TRANSIENT
C...  SOLUTION.  THIS CAN LEAD TO A SO-CALLED STIFF SYSTEM OF DIFFER-
C...  ENTIAL EQUATIONS.  IN THE FOLLOWING PROGRAMMING, THE EIGENVALUES
C...  OF A TYPICAL LOW-ORDER FLUID FLOW PROBLEM ARE COMPUTED TO DEMON-
C...  STRATE THIS PROPERTY OF STIFFNESS, I.E., SEPARATION IN THE EIGEN-
C...  VALUES.
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     LIQUID 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
C...
C...     (B)  DP = 1.0 CM
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
      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
      CALL DERV
      RETURN
      END
      SUBROUTINE DERV
      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...  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 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...  DIMENSION THE ARRAYS FOR SUBROUTINES JMAP, EIGEN
      DIMENSION         A(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 (H,SV(1)), (DHDT,FV(1))
C...
C...  PRINT A HEADING FOR THE NUMERICAL SOLUTION (THE FOLLOWING WRITE
C...  STATEMENTS FOR THE HEADING AND NUMERICAL SOLUTION HAVE BEEN CON-
C...  VERTED TO COMMENTS TO FACILITATE THE INTERPRETATION OF THE MAP
C...  OF THE JACOBIAN MATRIX AND THE EIGENVALUES)
C...  IF(IP.EQ.0)WRITE(NO,1)
C...1 FORMAT(9X,1HT,9X,1HH,9X,1HV,5X,5HDH/DT,5X,5HDV/DT,
C... 1       8X,2HRE,9X,1HF,8X,2HFF)
C...
C...  PRINT THE SOLUTION
C...  WRITE(NO,2)T,H,V,DHDT,DVDT,RE,F,FF
C...2 FORMAT(F10.1,F10.3,F10.2,F10.4,F10.2,F10.0,F10.4,F10.1)
C...
C...  MAP THE JACOBIAN MATRIX EVERY FIFTH CALL TO SUBROUTINE JMAP
      IF(((IP-1)/5*5).EQ.(IP-1))THEN
      NODE=2
      CALL JMAP(NODE,A,SV,SVOLD,FV,FVOLD)
C...
C...  COMPUTE THE TEMPORAL EIGENVALUES OF THE TWO ODES DEFINED IN COMMON
C...  /Y/ AND /F/
      CALL EIGEN(NODE,A,EIGENV,WF)
C...
C...  PRINT THE EIGENVALUES (SUBROUTINE EIGEN ALSO PRINTS THE EIGEN-
C...  VALUES, BUT WITH AN F-TYPE FORMAT THAT DOES NOT PRINT ALL OF THE
C...  SIGNIFICANT FIGURES OF THE SMALLEST EIGENVALUE.  THIS PROBLEM IS
C...  CORRECTED BY USING AN E-TYPE FORMAT IN THE FOLLOWING WRITE STATE-
C...  MENT)
      ER1= REAL(EIGENV(1))
      EI1=AIMAG(EIGENV(1))
      ER2= REAL(EIGENV(2))
      EI2=AIMAG(EIGENV(2))
      RATIO=ABS(ER2)/ABS(ER1)
      WRITE(NO,3)T,ER1,EI1,ER2,EI2,RATIO
3     FORMAT(1H ,//,' T = ',F6.1,/,
     1 ' ER1 = ',E11.3,' EI1 = ',E11.3,/,
     2 ' ER2 = ',E11.3,' EI2 = ',E11.3,/,
     3 ' ER2/ER1 = ',E11.3)
      END IF
      IP=IP+1
      RETURN
      END
EIGENVALUES OF A FLUID FLOW SYSTEM, DP = 0.5
0.        1000.     100.
    2 1000    1    1  REL 0.001
EIGENVALUES OF A FLUID FLOW SYSTEM, DP = 1.0
0.        200.      20.
    2 1000    1    1  REL 0.001
END OF RUNS
*APP FLOW32
      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 FLOW33
      SUBROUTINE INITAL
C...
C...  DYNAMIC RESPONSE OF A MANOMETER
C...
C...  THE DIFFERENTIAL HEIGHT OF LIQUID IN A U-TUBE MANOMETER, H, CAN
C...  BE CALCULATED AS A FUNCTION OF TIME, T, BY INTEGRATION OF THE
C...  SECOND-ORDER ORDINARY DIFFERENTIAL EQUATION (ODE)
C...
C...     (TAU**2)D2H/DT2 + 2*TAU*Z*DH/DT + H = F(T)              (1)
C...
C...  WHERE
C...
C...     TAU     CHACTERISTIC TIME (RECIPROCAL OF THE NATURAL
C...             FREQUENCY) OF THE MANOMETER (SEC)
C...
C...     Z       DAMPING COEFFICIENT (DIMENSIONLESS)
C...
C...     F(T)    FORCING FUNCTION CORRESPONDING TO THE PRESSURE APPLIED
C...             TO ONE LEG OF THE MANOMETER (M)
C...
C...  FOR A MANOMETER, TAU AND Z ARE DEFINED BY
C...
C...     TAU = (L/(2*G))**0.5, Z = (8*VIS/((D**2)*RHO))*(2*L/G)**0.5
C...
C...  WHERE FOR THE PARTICULAR MANOMETER CONSIDERED IN THE FOLLOWING
C...  ANALYSIS
C...
C...     L        TOTAL LENGTH OF THE LIQUID IN THE MAMOMETER = 0.9915 M
C...
C...     G        ACCELERATION OF GRAVITY = 9.8 M/SEC**2
C...
C...     VIS      LIQUID VISCOSITY = 2.5E-03 PA-SEC (1 PA = 1 PASCAL =
C...              NEWTON/M**2)
C...
C...     D        TUBE DIAMETER (M)
C...
C...     RHO      LIQUID DENSITY = 13600 KG/M**3
C...
C...  IN THE FOLLOWING PROGRAMMING, THE TUBE DIAMETER, D, IS SET TO
C...  THREE VALUES IN THREE RUNS CORRESPONDING TO Z GT 1 (OVERDAMPED),
C...  Z = 1 (CRITICALLY DAMPED) AND Z LT 1 (UNDERDAMPED)
C...
C...  INITIALLY, THE LIQUID IN THE MAMOMETER IS AT REST.  THEREFORE, THE
C...  INITIAL CONDITIONS FOR EQUATION (1) ARE
C...
C...     H(0) = 0, DH(O)/DT = 0                                  (2)(3)
C...
C...  AT T = 0, A PRESSURE, P1, OF 2.0E+04 PA IS APPLIED TO ONE OF THE
C...  LEGS OF THE MAMOMETER.  THE OTHER LEG HAS A VACUUM ABOVE IT.  THUS
C...  F(T) IN EQUATION (1) IS A CONSTANT WITH THE VALUE
C...
C...     F(T) = GC*P1/(RHO*G) = 1*2.0E+04/(13600*9.8) = 0.1501 M
C...
C...  WHERE
C...
C...     GC       CONVERSION FACTOR = 1 KG-M/N-SEC**2
C...
C...  EQUATIONS (1) TO (3) CAN BE SOLVED ANALYTICALLY, E.G., BY THE
C...  LAPLACE TRANSFORM.  THE ANALYTICAL SOLUTIONS FOR THE THREE CASES,
C...  Z GT 1, Z = 1, Z LT 1, ARE PROGRAMMED IN SUBROUTINE PRINT AND
C...  PRINTED ALONG WITH THE NUMERICAL SOLUTION
C...
C...  THE DERIVATION OF EQUATION (1), AND ITS LAPLACE TRANSFORM SOLUTION
C...  ARE OUTLINED BELOW
C...
C...  A CONTINUITY BALANCE ON LEG 1 OF THE MANOMETER GIVES
C...
C...     D(H1*S*RHO)/DT = -V*S*RHO
C...
C...  WHERE
C...
C...     H1       HEIGHT OF LIQUID IN LEG 1 (M)
C...
C...     S        CROSS SECTIONAL AREA OF THE TUBE (M**2)
C...
C...     V        FLUID VELOCITY (M/SEC)
C...
C...  SIMILARLY, FOR LEG 2
C...
C...     D(H2*S*RHO)/DT = V*S*RHO
C...
C...  A MOMENTUM BALANCE ON THE FLUID IN THE TUBE GIVES
C...
C...     (1/GC)*D(RHO*L*S*V)/DT = (G/GC)*RHO*H1*S - (G/GC)*RHO*H2*S
C...
C...             + P1*S - 0*S - (F*V*ABS(V)/(2*D*GC))*S
C...
C...                   F = 64*VIS/(D*ABS(V)*RHO)
C...
C...  THESE EQUATIONS CAN BE SIMPLIFIED (ASSUMING CONSTANT S AND RHO) TO
C...
C...     DH1/DT = -V
C...
C...     DH2/DT =  V
C...
C...     DV/DT = (G/L)*(H1 - H2) + P1*GC/(L*RHO) - 32*VIS*V/((D**2)*RHO)
C...
C...  THESE EQUATIONS CAN EASILY BE REARRANGED TO GIVE AN EQUATION IN
C...  H = H2 - H1
C...
C...     V = (1/2)*D(H2 - H1)/DT = (1/2)*DH/DT
C...
C...     (1/2)D2H/DT2 = -(G/L)*H + (P1*GC/(L*RHO))
C...
C...                    - (16*VIS/((D**2)*RHO))*DH/DT
C...
C...  WHICH CAN BE REARRANGED TO
C...
C...     (L/(2*G))*D2H/DT2 + (16*VIS*L/((D**2)*RHO*G))*DH/DT + H =
C...
C...                         (GC/(RHO*G))*P1
C...
C...  EQUATION (1) THEN FOLLOWS FROM THIS RESULT WITH TAU AND Z DEFINED
C...  PREVIOUSLY
C...
C...  EQUATION (1) CAN BE LAPLACE TRANSFORMED TO
C...
C...     ((TAU**2)*(S**2) + 2*TAU*Z*S + 1)*H(S) = (GC*P1/(RHO*G))*(1/S)
C...
C...  WHICH CAN THEN BE SOLVED FOR THE TRANSFORMED HEIGHT, H(S).  THE
C...  CHARACTERISTIC POLYNOMIAL CAN BE WRITTEN IN FACTORED FORM AS
C...
C...     (TAU**2)*(S**2) + 2*TAU*Z*S + 1 = (TAU**2)*(S - R1)*(S - R2)
C...
C...  WHERE R1 AND R2 ARE GIVEN BY THE QUADRATIC FORMULA
C...
C...    R1, R2 = (-2*TAU*Z + (OR -)((2*TAU*Z)**2 - 4*(TAU**2))**0.5)/
C...
C...                               (2*(TAU**2))
C...  OR
C...
C...     R1, R2 = (-Z + (OR -)(Z**2 - 1)**0.5)/TAU
C...
C...  R1 AND R2 WILL BE REAL AND DISTINCT, REAL AND REPEATED OR COMPLEX
C...  FOR Z GT 1, Z = 1 AND Z LT 1.  THE ANALYSIS WILL BE CONTINUED FOR
C...  VALUES OF TAU AND Z CORRESPONDING TO THREE TUBE DIAMETERS
C...
C...     CASE 1 - D = 4.50E-04 M
C...
C...              Z = 3.9691E-07/(4.50E-04)**2 = 1.9600 (OVERDAMPED)
C...
C...     CASE 2 - D = 6.30E-04 M
C...
C...              Z = 3.9691E-07/(6.30E-04)**2 = 1.0000 (CRITICALLY
C...                                                       DAMPED)
C...     CASE 3 - D = 1.80E-03 M
C...
C...              Z = 3.9691E-07/(1.80E-03)**2 = 0.1225 (UNDERDAMPED)
C...
C...  SUBSTITUTION OF THESE CONSTANTS IN THE LAPLACE TRANSFORM OF H
C...  GIVES
C...
C...     H(S) = (0.1501/S)/(0.05058*S**2 + 2*Z*(0.02249)*S + 1)
C...
C...          (0.1501/S)/(0.05085*(S - R1)*(S - R2))
C...
C...  WHERE FROM THE QUADRATIC FORMULA
C...
C...     CASE 1 - R1 = -1.2196, R2 = -16.210
C...
C...     CASE 2 - R1 = R2 = R = -4.4464
C...
C...     CASE 3 - R1 = -0.54468 + 4.41291I, R2 = -0.54468 - 4.41291I
C...
C...              (I = SQRT(-1) SO R1 AND R2 ARE COMPLEX CONJUGATES)
C...
C...  INVERSION OF H(S) CAN BE ACCOMPLISHED BY PARTIAL FRACTIONS
C...
C...     CASE 1
C...
C...        H(S) = A/S + B/(S - R1) + C/(S - R2)
C...
C...  WHERE A, B AND C ARE CONSTANTS TO BE DETERMINED (THE MULTIPLYING
C...  CONSTANT 0.1501/0.05058 WILL BE INCLUDED AFTER THE INVERSION).  IN
C...  THE USUAL WAY FOR PARTIAL FRACTION EXPANSIONS
C...
C...     A = 1/(R1*R2) = 1/((-1.12196)*(-16.120)) = 0.05058
C...
C...     B = 1/(R1*(R1 - R2)) = -0.05470
C...
C...     C = 1/(R2*(R2 - R1)) =  0.004115
C...
C...  SUBSTITUTION IN H(S) FOLLOWED BY INVERSION GIVES
C...
C...        H(T) = 0.1501*(1 - 1.0815*EXP(-1.2196*T)
C...
C...                         + 0.0815*EXP(-16.210*T)
C...
C...  NOTE BY INSPECTION THAT H(0) = 0 WHICH IS A GOOD CHECK OF THE
C...  CONSTANTS A, B AND C
C...
C...     CASE 2
C...
C...        H(S) = A/S + B/(S - R) + C/(S - R)**2
C...
C...  WHICH IS THE USUAL PARTIAL FRACTION EXPANSION FOR REPEATED ROOTS
C...
C...     A = 1/R**2 = 1/(-4.4464)**2 = 0.05058
C...
C...     B = D(1/S)/DS WITH S = R = -1/R**2 = -0.05058
C...
C...     C = 1/R = -0.2249
C...
C...  SUBSTITUTION IN H(S) FOLLOWED BY INVERSION GIVES
C...
C...        H(T) = 0.1501*(1 - EXP(-4.4464*T) - 4.4464*T*EXP(-4.4464*T))
C...
C...  AGAIN, BY INSPECTION H(0) = 0
C...
C...     CASE 3
C...
C...        H(S) = A/S + B/(S - R1) + C/(S - R2)
C...
C...  WHERE A, B AND C CAN BE EVALUATED AS BEFORE IN CASE 1.  THUS
C...
C...     A = 1/(R1*R2) = 1/((-0.54468 + 4.41291I)*(-0.55468 - 4.41291I))
C...
C...       = 0.05058
C...
C...     B = 1/(R1*(R1 - R2)) = 1/((-0.55468 + 4.41291I)*(2)*(4.41291I))
C...
C...       = 1/(-38.9475 - 4.80725I) = 0.02548*EXP(-I*PHI)
C...
C...  WITH PHI = ARCTAN(-4.80725/-38.9475) = 187.04 DEGREES
C...
C...     C = 1/(R2*(R2 - R1)) = 0.02548*EXP(I*PHI)
C...
C...  SUBSTITUTION IN H(S) FOLLOWED BY INVERSION GIVES
C...
C...        H(T) = 0.1501*(1 + 0.02548*EXP(-I*PHI)*EXP(R1*T)
C...
C...                         + 0.02548*EXP( I*PHI)*EXP(R2*T))
C...
C...  WHICH CAN BE WRITTEN IN A FORM MORE CONVENIENT FOR CALCULATION (OF
C...  COURSE, H(T) MUST BE REAL)
C...
C...        H(T) = 0.1501*(1
C...
C...             + 0.50376*EXP(-I*PHI)*EXP(RE(R1)*T)*EXP(I*IM(R1)*T))
C...
C...             + 0.50376*EXP( I*PHI)*EXP(RE(R2)*T)*EXP(I*IM(R2)*T))
C...
C...             = 0.1501*(1
C...
C...             + 0.50376*EXP(-0.54468*T)*(EXP( I*(IM(R1)*T - PHI)) +
C...
C...                                      * EXP(-I*(IM(R1)*T - PHI)))
C...
C...             = 0.1501*(1
C...
C...             + (2)*(0.50376)*EXP(-0.54468*T)*COS(4.41291*T - PHI))
C...
C...  WHICH FOLLOWS FROM THE IDENTITY
C...
C...     COS(X) = (EXP(I*X) + EXP(-I*X))/2
C...
C...  AGAIN, H(0) = 0
C...
C...  THE THREE ANALYTICAL SOLUTIONS, H(T) FOR THE THREE CASES, ARE PRO-
C...  GRAMMED IN SUBROUTINE PRINT
C...
      COMMON /T/      T,  NOSTOP,  NORUN
     1       /Y/     Y1,      Y2
     2       /F/  DY1DT,   DY2DT
     3       /C/    TAU,       Z,      F,     IP
C...
C...  SET THE MODEL PARAMETERS
C...
C...     TIME CONSTANT
C...     D(H2*S*RHO)/DT = V*S*RHO
         XL=0.9915
         G=9.8
         TAU=SQRT(XL/(2.*G))
C...
C...     DAMPING COEFFICIENT
         VIS=1.5E-03
         RHO=13600.
         IF(NORUN.EQ.1)DIA=4.50E-04
         IF(NORUN.EQ.2)DIA=6.30E-04
         IF(NORUN.EQ.3)DIA=1.80E-03
         Z=(8.*VIS/((DIA**2)*RHO))*SQRT(2.*XL/G)
C...
C...     FORCING FUNCTION
         GC=1.
         PA=2.0E+04
         F=GC*PA/(RHO*G)
C...
C...  INITIAL CONDITIONS
      Y1=0.
      Y2=0.
C...
C...  INITIALIZE THE DERIVATIVE CALCULATIONS
      CALL DERV
C...
C...  SET A COUNTER FOR THE PLOTTED SOLUTION
      IP=0
      RETURN
      END
      SUBROUTINE DERV
      COMMON /T/      T,  NOSTOP,  NORUN
     1       /Y/     Y1,      Y2
     2       /F/  DY1DT,   DY2DT
     3       /C/    TAU,       Z,      F,     IP
C...
C...  MODEL DIFFERENTIAL EQUATIONS
      DY1DT=Y2
      DY2DT=(1./TAU**2)*(F-2.*TAU*Z*Y2-Y1)
      RETURN
      END
      SUBROUTINE PRINT(NI,NO)
      COMMON /T/      T,  NOSTOP,  NORUN
     1       /Y/     Y1,      Y2
     2       /F/  DY1DT,   DY2DT
     3       /C/    TAU,       Z,      F,     IP
C...
C...  DIMENSION THE ARRAYS TO STORE THE NUMERICAL SOLUTION FOR PLOTTING
      DIMENSION TP(51),YP(3,51),YAP(3,51)
C...
C...  PRINT A HEADING FOR THE NUMERICAL SOLUTION
      IF(IP.EQ.0)WRITE(NO,1)TAU,Z,F
1     FORMAT(
     1  23H CHARACTERISTIC TIME = ,F7.3,/,
     2  23H DAMPING COEFFICIENT = ,F7.3,/,
     3  20H FORCING FUNCTION = ,  F10.3,//,
     4 9X,1HT,3X,7HH (NUM),2X,8HH (ANAL))
C...
C...  CALCULATE THE ANALYTICAL SOLUTION
      IF(NORUN.EQ.1)Y1A=F*(1.-1.0815*EXP(-1.2196*T)
     1                       +0.0815*EXP(-16.210*T))
      IF(NORUN.EQ.2)Y1A=F*(1.-EXP(-4.4464*T)-4.4464*T*EXP(-4.4464*T))
      IF(NORUN.EQ.3)Y1A=F*(1.+1.00751*EXP(-0.54468*T)
     1                       *COS(4.41291*T-187.04*3.1415927/180.))
C...
C...  PRINT THE NUMERICAL AND ANALYTICAL SOLUTIONS
      WRITE(NO,2)T,Y1,Y1A
2     FORMAT(F10.1,2F10.4)
C...
C...  STORE THE NUMERICAL SOLUTION FOR PLOTTING
      IP=IP+1
      TP(IP)=T
       YP(NORUN,IP)=Y1
      YAP(NORUN,IP)=Y1A
C...
C...  PLOT THE NUMERICAL SOLUTION AT THE END OF THE THIRD RUN
      IF(IP.LT.  51)RETURN
      IF(NORUN.LT.3)RETURN
C...
C...  PLOT THE NUMERICAL SOLUTIONS FOR THE THREE CASES
      CALL TPLOTS(NORUN,IP,TP,YP)
C...
C...  LABEL THE PLOT
      WRITE(NO,3)
3     FORMAT(1H ,//,
     1       17H 1 - D = 4.50E-04,/,
     2       17H 2 - D = 6.30E-04,/,
     3       17H 3 - D = 1.80E-03)
C...
C...  PLOT THE ANALYTICAL SOLUTIONS FOR THE THREE CASES
      CALL TPLOTS(NORUN,IP,TP,YAP)
      WRITE(NO,3)
      RETURN
      END
DYNAMICS OF A MANOMETER, D = 4.50E-04
0.         10.       0.2
    2 1000    1    1  REL 0.001
DYNAMICS OF A MANOMETER, D = 6.30E-04
0.         10.       0.2
    2 1000    1    1  REL 0.001
DYNAMICS OF A MANOMETER, D = 1.80E-03
0.         10.       0.2
    2 1000    1    1  REL 0.001
END OF RUNS
*APP FLOW34
      PROGRAM FIT1
C...
C...  LEAST SQUARES ANALYSIS BY IMSL ROUTINE IFLSQ - CASE 1
C...
C...  CONSIDER THE DEVELOPMENT OF A CORRELATION RELATING THE FRICTION
C...  FACTOR, F, TO THE REYNOLDS NUMBER, RE, OF THE FORM
C...
C...     F = A*RE**B                                             (1)
C...
C...  WHERE A AND B ARE CONSTANTS TO BE DETERMINED.
C...
C...  IF EQUATION (1) IS WRITTEN LOGARITHMIC FORM,
C...
C...     LOG(F) = LOG(A) + B*LOG(RE)                             (2)
C...
C...  LINEAR LEAST SQUARES CAN BE APPLIED TO EQUATION (2) TO DETERMINE
C...  THE CONSTANTS A AND B.  DATA FOR THE CALCULATIONS ARE INCLUDED
C...  WITH THIS PROGRAM AT THE END.  THE DATA ARE ALSO TABULATED BELOW
C...  FOR REFERENCE
C...
C...    F         D       V          RHO       VIS       RE
C...  0.025     0.01      2.        1000.     0.001     20000.
C...  0.030     0.005     4.        2000.     0.005     8000.
C...  0.026     0.0025    8.        1500.     0.002     15000.
C...  0.0216    0.02      5.        800.      0.002     40000.
C...  0.0157    0.02      10.       1000.     0.001     200000.
C...  0.018     0.005     20.       1500.     0.0015    100000.
C...  0.024     0.01      10.       1000.     0.004     25000.
C...  0.022     0.0025    20.       2000.     0.003     33333.
C...
C...  F = FRICTION FACTOR, D = DIAMETER, V = VELOCITY, RHO = DENSITY,
C...  VIS = VISCOSITY, RE = REYNOLDS NUMBER (NOTE THAT ONLY COLUMNS ONE
C...  AND SIX ARE USED IN THE CORRELATION, I.E., F AND RE).
C...
C...  EXTERNAL THE FUNCTION CALLED BY IFLSQ
      EXTERNAL FCN
C...
C...  DIMENSION THE ARRAYS FOR SUBROUTINE IFLSQ
      DIMENSION F(8), RE(8), A(2), WK(10)
C...
C...  SET THE INPUT/OUTPUT DEVICE NUMBERS
      NI=1
      NO=2
C...
C...  OPEN INPUT/OUTPUT FILES
      OPEN(NI,FILE='INPUT')
      OPEN(NO,FILE='OUTPUT')
C...
C...  READ AND PRINT THE DATA
      M=8
      DO 1 I=1,M
      READ(NI,2)F(I),RE(I)
2     FORMAT(F10.0,40X,F10.0)
      WRITE(NO,5)F(I),RE(I)
5     FORMAT(F12.5,F12.1)
1     CONTINUE
C...
C...  CONVERT TO LOGARITHMIC VARIABLES
      DO 3 I=1,M
      RE(I)=ALOG(RE(I))
       F(I)=ALOG( F(I))
3     CONTINUE
C...
C...  SET THE PARAMETERS OF IFLSQ
      N=2
C...
C...  CALL IFLSQ
      CALL IFLSQ(FCN,RE,F,M,A,N,WK,IER)
C...
C...  COMPUTE A AND PRINT THE LEAST SQUARES COEFFICIENT
      A(1)=EXP(A(1))
C...
      WRITE(NO,4)A(1),A(2)
4     FORMAT(1H ,//,' A = ',F7.3,'   B = ',F7.3)
      END
      FUNCTION FCN(K,RE)
      IF(K.EQ.1)FCN=1.
      IF(K.EQ.2)FCN=RE
      RETURN
      END
0.025     0.01      2.        1000.     0.001     20000.
0.030     0.005     4.        2000.     0.005     8000.
0.026     0.0025    8.        1500.     0.002     15000.
0.0216    0.02      5.        800.      0.002     40000.
0.0157    0.02      10.       1000.     0.001     200000.
0.018     0.005     20.       1500.     0.0015    100000.
0.024     0.01      10.       1000.     0.004     25000.
0.022     0.0025    20.       2000.     0.003     33333.
*APP FLOW35
      PROGRAM MC54(INPUT,OUTPUT,TAPE1=INPUT,TAPE2=OUTPUT)
C...
C...  LEAST SQUARES ANALYSIS BY IMSL ROUTINE IFLSQ - CASE 2
C...
C...  THE PRESSURE DROP BETWEEN TWO POINTS 5 M APART IN A HORIZONTAL
C...  PIPE HAS BEEN MEASURED USING DIFFERENT PIPE DIAMETERS AND
C...  FLUIDS.  THE EXPERIMENTAL RESULTS ARE SHOWN IN THE TABLE BELOW.
C...  THEY HAVE BEEN PRINTED USING A 6E10.3 FORMAT.
C...
C...  WRITE A PROGRAM TO CALCULATE THE FRICTION FACTOR FROM THESE
C...  VALUES.  ALSO, DEVELOP A CORRELATION OF THE FORM
C...
C...  F = A*(RE**B)
C...
C...  USING IMSL ROUTINE IFLSQ (I.E., COMPUTE LEAST SQUARES VALUES OF
C...  A AND B).  SUGGESTION: USE THE LOGARITHMIC FORM
C...
C...  LOG(F) = LOG(A) + B*LOG(RE)
C...
C...    PRESSURE    PIPE      PIPE      FLUID    FLUID     FLUID
C...   DIFFERENCE  LENGTH   DIAMETER  VELOCITY  DENSITY  VISCOSITY
C...    (N/M**2)     (M)       (M)      (M/S)  (KG/M**3)  (KG/M-S)
C...    .250E+05  .500E+01  .100E-01  .200E+01  .100E+04  .100E-02
C...    .480E+06  .500E+01  .500E-02  .400E+01  .200E+04  .500E-02
C...    .250E+07  .500E+01  .250E-02  .800E+01  .150E+04  .200E-02
C...    .540E+05  .500E+01  .200E-01  .500E+01  .800E+03  .200E-02
C...    .196E+06  .500E+01  .200E-01  .100E+02  .100E+04  .100E-02
C...    .540E+07  .500E+01  .500E-02  .200E+02  .150E+04  .150E-02
C...    .600E+06  .500E+01  .100E-01  .100E+02  .100E+04  .400E-02
C...    .176E+08  .500E+01  .250E-02  .200E+02  .200E+04  .300E-02
C...
C...  THESE DATA ALSO APPEAR AT THE END OF THIS PROGRAM SO THAT THEY
C...  CAN BE READ BY THE PROGRAM.
C...
C...  THE DATA MUST BE CONVERTED TO FRICTION FACTOR VS REYNOLDS NUMBER.
C...  THE FOLLOWING IS A BRIEF DESCRIPTION OF THE EQUATIONS REQUIRED
C...  FOR THE CONVERSION.  IF A FORCE BALANCE IS WRITTEN ON THE PIPE
C...  OVER THE LENGTH L, IN TERMS OF THE SHEAR STRESS AT THE WALL, TAU,
C...
C...     PI*D*L*TAU = DP*PI*(D**2)/4
C...
C...  THE SHEAR IS THEN
C...
C...     TAU = D*DP/(4.*L)
C...
C...  THE (DARCY) FRICTION FACTOR IS THEN DEFINED AS
C...
C...     F = 4*TAU/(RHO*V**2/2)
C...
C...  THE REYNOLDS NUMBER IS DEFINED AS
C...
C...     RE = D*V*RHO/VIS
C...
C...  F AND RE CAN THEN BE CALCULATED FROM THE GIVEN DATA.
C...
C...  EXTERNAL THE FUNCTION CALLED BY IFLSQ
      EXTERNAL FCN
C...
C...  DIMENSION THE ARRAYS FOR SUBROUTINE IFLSQ
      REAL P(8), L(8), D(8), V(8), RHO(8), VIS(8), F(8), RE(8),
     1     A(8),WK(10)
C...
C...  SET THE INPUT/OUTPUT DEVICE NUMBERS
      NI=1
      NO=2
C...
C...  READ THE DATA
      M=8
      DO 1 I=1,M
      READ(NI,2)P(I),L(I),D(I),V(I),RHO(I),VIS(I)
2     FORMAT(6E10.0)
1     CONTINUE
C...
C...  COMPUTE THE FRICTION FACTOR AND REYNOLDS NUMBER
      DO 5 I=1,M
      TAU=D(I)*P(I)/(4.*L(I))
      F(I)=4.*TAU/(RHO(I)*(V(I)**2)/2.)
      RE(I)=D(I)*V(I)*RHO(I)/VIS(I)
5     CONTINUE
C...
C...  PRINT THE ORIGINAL DATA AND THE COMPUTED FRICTION FACTOR AND
C...  REYNOLDS NUMBER
      DO 6 I=1,M
      WRITE(NO,7)P(I),L(I),D(I),V(I),RHO(I),VIS(I),F(I),RE(I)
7     FORMAT(8E10.3)
6     CONTINUE
C...
C...  CONVERT TO LOGARITHMIC VARIABLES
      DO 3 I=1,M
      RE(I)=ALOG(RE(I))
       F(I)=ALOG( F(I))
3     CONTINUE
C...
C...  SET THE PARAMETERS OF IFLSQ
      N=2
C...
C...  CALL IFLSQ
      CALL IFLSQ(FCN,RE,F,M,A,N,WK,IER)
C...
C...  COMPUTE A AND PRINT THE LEAST SQUARES COEFFICIENT
      A(1)=EXP(A(1))
C...
      WRITE(NO,4)A(1),A(2)
4     FORMAT(1H ,//,' A = ',F7.3,'   B = ',F7.3)
      END
      FUNCTION FCN(K,RE)
      IF(K.EQ.1)FCN=1.
      IF(K.EQ.2)FCN=RE
      RETURN
      END
  .250E+05  .500E+01  .100E-01  .200E+01  .100E+04  .100E-02
  .480E+06  .500E+01  .500E-02  .400E+01  .200E+04  .500E-02
  .250E+07  .500E+01  .250E-02  .800E+01  .150E+04  .200E-02
  .540E+05  .500E+01  .200E-01  .500E+01  .800E+03  .200E-02
  .196E+06  .500E+01  .200E-01  .100E+02  .100E+04  .100E-02
  .540E+07  .500E+01  .500E-02  .200E+02  .150E+04  .150E-02
  .600E+06  .500E+01  .100E-01  .100E+02  .100E+04  .400E-02
  .176E+08  .500E+01  .250E-02  .200E+02  .200E+04  .300E-02
*APP FLOW36
      SUBROUTINE INITAL
C...
C...  TIME TO DRAIN A TANK THROUGH A VERTICAL PIPE
C...
C...  THE FOLLOWING EQUATION HAS BEEN PROPOSED FOR THE HEIGHT OF LIQUID,
C...  Z, IN A TANK AS A FUNCTION OF TIME, T*
C...
C...     DZ/DT + ((R**4)*G)/(8*NU*L*(R0**2))*Z = 0              (1)
C...
C...  *KREIDER, J. F., PRINCIPLES OF FLUID MECHANICS, ALLYN AND BACON,
C...  INC., BOSTON, 1985, EX 5.7
C...
C...     R       RADIUS OF THE PIPE DRAINING THE TANK (0.04 M)
C...
C...     G       ACCELERATION OF GRAVITY (9.8 M/SEC**2)
C...
C...     NU      KINEMATIC VISCOSITY OF WATER AT 20 C (1.004E-06 M**2/
C...             SEC)
C...
C...     L       LENGTH OF THE PIPE DRAINING THE TANK (3 M)
C...
C...     R0      RADIUS OF THE TANK (5 M)
C...
C...     H       HEIGHT OF THE TANK (3 M)
C...
C...  THE INITIAL CONDITION IS Z(0) = 6 M.
C...
C...  THE DIFFERENTIAL EQUATION IS THEN INTEGRATED TO DETERMINE THE
C...  TIME FOR THE TANK TO DRAIN, I.E., FOR Z = L.
C...
C...  EQUATION (1) IS BASED ON THE RELATIONSHIP F = 64/RE (THE FRICTION
C...  FACTOR - REYNOLDS NUMBER RELATIONSHIP FOR LAMINAR FLOW).  THUS,
C...  EQUATION (1) APPLIES ONLY FOR LAMINAR FLOW.  HOWEVER, REPEATED
C...  EXECUTION OF THE FOLLOWING PROGRAM INDICATED THAT LAMINAR FLOW
C...  CONDITIONS ARE DIFFICULT TO ACHIEVE (THE REYNOLDS NUMBER IS COM-
C...  PUTED IN SUBROUTINE PRINT, AND GENERALLY HAS A VALUE MUCH ABOVE
C...  2100, THE LAMINAR TO TURBULENT TRANSITION VALUE).
C...
C...  IN FACT, ABOUT THE ONLY WAY TO ACHIEVE LAMINAR FLOW CONDITIONS
C...  IN A REALISTIC WAY (I.E., DRAINING OF THE TANK IN REASONABLE TIME)
C...  IS TO INCREASE THE KINEMATIC VISCOSITY, NU.  THIS IS DONE IN A
C...  SERIES OF THREE RUNS FOR NU = 1.004E-06 (WATER AT 20), 1.004E-04
C...  1.004E-03.  FOR THE LAST TWO VALUES, THE REYNOLDS NUMBER PASSES
C...  THROUGH THE TRANSITION VALUE 2100.
C....
      COMMON /T/      T,   NSTOP,  NORUN
     1       /Y/      Z,
     2       /F/   DZDT
     3       /C/      R,         G,        NU,         L,        R0,
     4                H,         C,        IP
      REAL           NU,         L
C...
C...  SET THE MODEL PARAMETERS
C...
C...     PIPE RADIUS
         R=0.04
C...
C...     ACCELERATION OF GRAVITY
         G=9.8
C...
C...     KINEMATIC VISCOSITY
         IF(NORUN.EQ.1)NU=1.004E-06
         IF(NORUN.EQ.2)NU=1.004E-04
         IF(NORUN.EQ.3)NU=1.004E-03
C...
C...     PIPE LENGTH
         L=3.
C...
C...     TANK RADIUS
         R0=5.0
C...
C...  THE MODEL PARAMETERS ARE COMBINED INTO A SINGLE CONSTANT
      C=(R**4)*G/(8.0*NU*L*(R0**2))
C...
C...  INITIAL CONDITION
      H=3.
      Z=L+H
C...
C...  INITIAL DERIVATIVE
      CALL DERV
      IP=0
      RETURN
      END
      SUBROUTINE DERV
      COMMON /T/      T,   NSTOP,  NORUN
     1       /Y/      Z,
     2       /F/   DZDT
     3       /C/      R,         G,        NU,         L,        R0,
     4                H,         C,        IP
      REAL           NU,         L
C...
C...  DIFFERENTIAL EQUATION
      DZDT=-C*Z
      RETURN
      END
      SUBROUTINE PRINT(NI,NO)
      COMMON /T/      T,   NSTOP,  NORUN
     1       /Y/      Z,
     2       /F/   DZDT
     3       /C/      R,         G,        NU,         L,        R0,
     4                H,         C,        IP
      REAL           NU,         L
C...
C...  PRINT A HEADING FOR THE NUMERICAL SOLUTIOM
      IF(IP.EQ.0)WRITE(NO,1)
1     FORMAT(9X,'T',11X,'Z',10X,'ZA',10X,'RE')
C...
C...  CALCULATE THE ANALYTICAL SOLUTION FOR PRINTING
      ZA=(L+H)*EXP(-C*T)
C...
C...  COMPUTE THE REYNOLDS NUMBER FOR PRINTING
      V=-DZDT*(R0**2)/(R**2)
      RE=(2.0*R)*V/NU
C...
C...  PRINT THE NUMERICAL AND ANALYTICAL SOLUTIONS, REYNOLDS NUMBER
      WRITE(NO,2)T,Z,ZA,RE
2     FORMAT(F10.1,2F12.4,F12.0)
      IP=IP+1
C...
C...  TEST FOR THE END OF THE SOLUTION
      IF(Z.LE.L)NSTOP=1
      RETURN
      END
TIME TO DRAIN A TANK THROUGH A VERTICAL PIPE, NU = 1.004E-06
0.        50.       1.
    1 1000    1    1  REL 0.001
TIME TO DRAIN A TANK THROUGH A VERTICAL PIPE, NU = 1.004E-04
0.        5000.     100.
    1 1000    1    1  REL 0.001
TIME TO DRAIN A TANK THROUGH A VERTICAL PIPE, NU = 1.004E-03
0.        50000.    1000.
    1 1000    1    1  REL 0.001
END OF RUNS
*APP FLOW37
      SUBROUTINE INITAL
C...
C...  SHUTTLE LAUNCH SIMULATION
C...
C...  THE FOLLOWING MODEL AND SIMULATION WERE DEVELOPED BY
C...
C...     PROFESSOR S. H. JOHNSON
C...     DEPARTMENT OF MECHANICAL ENGINEERING
C...                AND MECHANICS
C...     LEHIGH UNIVERSITY
C...     PACKARD LABORATORY NO. 19
C...     BETHLEHEM, PA  18015
C...
C...     (215) 861-4111
C...
C...  THE MODEL AND SIMULATION ARE FOR THE VERTICAL, PITCHOVER AND
C...  GRAVITY TURN PHASES OF A SPACE SHUTTLE FLIGHT.  THE MODEL IS
C...  BASED ON THE CLASSICAL NEWTONIAN EQUATIONS OF MOTION WITH DRAG
C...  FORCES INCLUDED EMPIRICALLY (IN TABULAR FORM).  THE EQUATIONS OF
C...  MOTION ARE
C...
C...      2    2
C...     D X/DT  = (GC/W)*(TLIQ*THROTL+TSOL*REDUC-DRAG)*COS(PSI)     (1)
C...
C...      2    2
C...     D Y/DT  = (GC/W)*(TLIQ*THROTL*TSOL*REDUC-DRAG)*SIN(PSI) - G (2)
C...
C...     DW/DT = NU                                                  (3)
C...
C...     DPSI/DT = DPSIDT                                            (4)
C...
C...  WHERE
C...
C...     X,Y       X AND Y COORDINATES (DOWN RANGE AND ALTITUDE) OF THE
C...               SHUTTLE (FT)
C...
C...     T         TIME (SEC)
C...
C...     G         ACCELERATION OF GRAVITY (FT/SEC**2)
C...
C...     GC        CONVERSION FACTOR = 32.2 LBM-FT/LBF-SEC**2
C...
C...     TLIQ      NOMINAL THRUST OF THE MAIN ENGINES (LBF)
C...
C...     THROTL    THROTTLE SETTING FOR THE MAIN ENGINES (DIMENSIONLESS)
C...
C...     TSOL      MAXIMUM THRUST OF THE SOLID BOOSTER (LBF)
C...
C...     REDUC     SOLID BOOSTER THRUST REDUCTION (DIMENSIONLESS)
C...
C...     DRAG      DRAG FORCE (LBF)
C...
C...     W         SHUTTLE WEIGHT (LBM)
C...
C...     NU        RATE OF SHUTTLE WEIGHT REDUCTION (LBM/SEC)
C...
C...     PSI       SHUTTLE TRAJECTORY ANGLE WITH RESPECT TO THE GROUND
C...               (RADIANS)
C...
C...     DPSIDT    TIME DERIVATIVE OF PSI (RADIANS/SEC)
C...
C...  ADDITIONAL DIFFERENTIAL EQUATIONS FOLLOW IMMEDIATELY FROM EQUA-
C...  TIONS (1) AND (2)
C...
C...      2    2
C...     D X/DT  = DVX/DT, DX/DT = VX                             (5)(6)
C...
C...      2    2
C...     D Y/DT  = DVY/DT, DY/DT = VY                             (7)(8)
C...
C...  THE ASSOCIATED ALGEBRAIC EQUATIONS ARE
C...
C...     VARIATION OF GRAVITY WITH ALTITUDE
C...
C...        G0 = 32.2
C...
C...        G = G0*(3960.0*5280.0)**2/(3960.0*5280.0+Y)**2          (9)
C...
C...     VARIATION OF AIR DENSITY WITH ALTITUDE
C...
C...        RHO = 0.0234/EXP((Y - 35332.0)/20229.31), Y LE 35332   (10)
C...
C...        RHO = ((145428.0 - Y)/265816.0)**(1.0/0.2347), Y GT 35332
C...
C...     VARIATION OF TEMPERATURE WITH ALTITUDE
C...
C...        TEMP = 459.67 + 59.0 - 0.003566*Y, Y LE 35332
C...                                                               (11)
C...        TEMP = 459.67 - 67.0, Y GT 35332
C...
C...     SPEED OF SOUND
C...
C...        C = SQRT(1.4*G*53.3*TEMP)                              (12)
C...
C...     SCALAR VELOCITY
C...
C...        V = SQRT(DX/DT**2 + DY/DT**2)                          (13)
C...
C...     MACH NUMBER
C...
C...        MACH = V/C                                             (14)
C...
C...     DRAG COEFFICIENT
C...
C...        CD = CD(MACH)                                          (15)
C...
C...             (THE FUNCTIONAL DEPENDENCY OF CD ON MACH IS GIVEN IN
C...              TABULAR FORM IN THE BLOCK DATA ROUTINE AS ARRAYS XM
C...              YCD)
C...
C...     THROTTLE SETTING FOR THE MAIN ENGINES
C...
C...        THROTL = 1.0,    0 LE T LE 6.5
C...
C...        THROTL = 1.04, 6.5 LT T LE 20
C...
C...        THROTL = 0.94,  20 LT T LE 36
C...
C...        THROTL = 0.94   36 LT T LE 45
C...
C...               - 0.29*(T - 36.0)/9.0                           (16)
C...
C...        THROTL = 0.65,  45 LT T LE 52
C...
C...        THROTL = 0.65   52 LT T LE 67
C...
C...               + 0.39*(T - 52.0)/15.0
C...
C...        THROTL = 1.04,  67 LT T
C...
C...     SOLID BOOSTER THRUST REDUCTION
C...
C...        REDUC = 1.0,     0 LE T LE 20
C...
C...        REDUC = 1.0,    20 LT T LE 45
C...
C...              - 0.01091*(T - 20.0)
C...
C...        REDUC = 0.7272, 45 LT T LE 50                          (17)
C...
C...        REDUC = 0.7272  50 LT T LE 70
C...
C...              + 0.004545*(T - 50.0)
C...
C...        REDUC = 0.8181  70 LT T
C...
C...     RATE OF WEIGHT REDUCTION OF THE SHUTTLE
C...
C...        NU = NUSOL*REDUC + NULIQ*THROTL                        (18)
C...
C...     DYNAMIC PRESSURE
C...
C...        Q = 0.5*(RHO/G)*(V**2)                                 (19)
C...
C...     DRAG
C...
C...        DRAG = CD*S*Q                                          (19)
C...
C...     RATE OF CHANGE OF TRAJECTORY ANGLE
C...
C...        VERTICAL ASCENT PORTION
C...
C...        DPSIDT = 0, 0 LE T LE 6.5
C...
C...        CONSTANT PITCHOVER PORTION
C...                                                               (20)
C...        DPSIDT = -0.93*PI/180.0, 6.5 LT T LE 28.01
C...
C...        GRAVITY TURN PORTION
C...
C...        DPSIDT = -(G/V)*SIN(PI/2.0 - PSI), 28.01 LT T
C...
C...  THE ALGEBRAIC AND DIFFERENTIAL EQUATIONS ARE IMPLEMENTED IN
C...  SUBROUTINE DERV.
C...
C...  FINALLY, THE INITIAL CONDITIONS FOR THE MODEL, IMPLEMENTED IN
C...  SUBROUTINE INITAL, ARE
C...
C...     X = Y = VX = VY = 0                            (21)(22)(23)(24)
C...
C..      PSI = PI/2, W = W0                                     (25)(26)
C...
C...  VARIABLES, PARAMETERS AND CONSTANTS NOT DEFINED PREVIOUSLY ARE
C...  DEFINED IN THE SUBSEQUENT CODE WHEN THEY ARE FIRST USED.
C...
C...  DSS/2 COMMON AREA
      COMMON/T/      T,  NSTOP,  NORUN
     1      /Y/      X,      Y,     VX,     VY,      W,    PSI
     2      /F/   DXDT,   DYDT,  DVXDT,  DVYDT,   DWDT, DPSIDT
     3      /C/      G,     G0,    RHO,   TEMP,      C,      V,   MACH,
     4              CD, THROTL,  REDUC,      Q,   DRAG,   SUMF,     PI,
     5           NUSOL,  NULIQ,     W0,   TSOL,   TLIQ,      S, XM(37),
     6         YCD(37),     IP
C...
C...  TYPE SELECTED VARIABLES
      REAL       NUSOL,  NULIQ,     NU,   MACH
C...
C...
C...  SET THE MODEL CONSTANTS
C...
C...     MAXIMUM RATE OF WEIGHT LOSS OF THE SOLID BOOSTERS (LBM/SEC)
         NUSOL=-0.0173E+06
C...
C...     MAXIMUM RATE OF WEIGHT LOSS OF THE MAIN ENGINES (LBM/SEC)
         NULIQ=-0.0038E+06
C...
C...     GROUND LEVEL ACCELERATION OF GRAVITY (FT/SEC**2)
         G0=32.2
C...
C...     INITIAL SHUTTLE WEIGHT (LBM)
         W0=4.52E+06
C...
C...     MAXIMUM THRUST OF THE SOLID BOOSTERS (LBF)
         TSOL=6.6E+06
C...
C...     NOMINAL THRUST OF THE MAIN ENGINES (LBF)
         TLIQ=1.125E+06
C...
C...     SHUTTLE FRONTAL AREA (FT**2)
         S=600.0
C...
C...     PI
         PI=3.1415927
C...
C...  MODEL INITIAL CONDITIONS
C...
C...     VELOCITY (FT/SEC)
         VX=0.0
         VY=0.0
C...
C...     POSITION (FT)
         X=0.0
         Y=0.0
C...
C...     WEIGHT (LBM) AND ANGLE (RADIANS)
         W=W0
         PSI=PI/2.
C...
C...  INITIAL DERIVATIVES
      CALL DERV
C...
C...  COUNTER FOR THE PLOTTED OUTPUT
      IP=0
      RETURN
      END
      SUBROUTINE DERV
      COMMON/T/      T,  NSTOP,  NORUN
     1      /Y/      X,      Y,     VX,     VY,      W,    PSI
     2      /F/   DXDT,   DYDT,  DVXDT,  DVYDT,   DWDT, DPSIDT
     3      /C/      G,     G0,    RHO,   TEMP,      C,      V,   MACH,
     4              CD, THROTL,  REDUC,      Q,   DRAG,   SUMF,     PI,
     5           NUSOL,  NULIQ,     W0,   TSOL,   TLIQ,      S, XM(37),
     6         YCD(37),     IP
      REAL       NUSOL,  NULIQ,     NU,   MACH
C...
C...  MODEL ALGEBRA
C...
C...     VARIATION OF GRAVITY WITH ALTITUDE
         G=G0*(3960.0*5280.0)**2/(3960.0*5280.0+Y)**2
C...
C...     VARIATION OF DENSITY WITH ALTITUDE
         IF(Y.LE.35332.0)THEN
            RHO=0.0234/EXP((Y-35332.0)/20929.31)
         ELSE IF((Y.GT.35332.0).AND.(Y.LT.145428.0))THEN
            RHO=((145428.0-Y)/265816.0)**(1.0/0.2347)
         ELSE IF(Y.GE.145428.0)THEN
            RHO=0.
         END IF
C...
C...     VARIATION OF TEMPERATURE WITH ALTITUDE
         IF(Y.LE.35332.0)THEN
            TEMP=459.67+59.0-0.003566*Y
         ELSE IF(Y.GT.35332.0)THEN
            TEMP=459.67-67.0
         END IF
C...
C...     SPEED OF SOUND
         C=SQRT(1.4*G*53.3*TEMP)
C...
C...     VELOCITY
         V=SQRT(VX**2+VY**2)
C...
C...     MACH NUMBER
         MACH=V/C
C...
C...     VARIATION OF DRAG COEFFICIENT WITH MACH NUMBER
            CD=0.16
C...
C...        LINEAR INTERPOLATION OVER 37 POINTS
            DO 1 I=1,36
            IF((MACH.GT.XM(I)).AND.(MACH.LE.XM(I+1)))
     1        CD=YCD(I)+(YCD(I+1)-YCD(I))*(MACH-XM(I+1))/(XM(I+1)-XM(I))
1           CONTINUE
C...
C...        INCREASE IN THE DRAG COEFFICIENT DUE TO DIRTY SHUTTLE STACK
            CD=1.0*CD
C...
C...     THROTTLE SETTING FOR MAIN ENGINES AS A FUNCTION OF TIME
         IF((T.GE.0.0).AND.(T.LE.6.5))THROTL=1.0
         IF((T.GT.6.5).AND.(T.LE.20.))THROTL=1.04
         IF((T.GT.20.).AND.(T.LE.37.))THROTL=0.94
         IF((T.GT.37.).AND.(T.LE.45.))THROTL=0.94-0.29*(T-37.0)/9.0
         IF((T.GT.45.).AND.(T.LE.52.))THROTL=0.65
         IF((T.GT.52.).AND.(T.LE.67.))THROTL=0.65+0.39*(T-52.0)/15.0
         IF( T.GT.67.)                THROTL=1.04
C...
C...     SOLID BOOSTER THRUST REDUCTION AS A FUNCTION OF TIME
         IF((T.GE.0.0).AND.(T.LE.20.))REDUC=1.0
         IF((T.GT.20.).AND.(T.LE.45.))REDUC=1.0-0.01091*(T-20.0)
         IF((T.GT.45.).AND.(T.LE.50.))REDUC=0.7272
         IF((T.GT.50.).AND.(T.LE.70.))REDUC=0.7272+0.004545*(T-50.0)
         IF( T.GT.70.)                REDUC=0.8181
C...
C...     RATE OF SHUTTLE WEIGHT REDUCTION
         NU=NUSOL*REDUC+NULIQ*THROTL
C...
C...     DYNAMIC PRESSURE
         Q=0.5*(RHO/G)*(V**2)
C...
C...     DRAG FORCE
         DRAG=CD*S*Q
C...
C...     SUM OF THE FORCES
         SUMF=(G/W)*(TLIQ*THROTL+TSOL*REDUC-DRAG)
C...
C...  MODEL DIFFERENTIAL EQUATIONS
C...
C...     HORIZONTAL AND VERTICAL ACCELERATIONS
         DVXDT=SUMF*COS(PSI)
         DVYDT=SUMF*SIN(PSI)-G
C...
C...     HORIZONTAL AND VERTICAL VELOCITIES
         DXDT=VX
         DYDT=VY
C...
C...     SHUTTLE WEIGHT
         DWDT=NU
C...
C...     TRAJECTORY ANGLE
C...
C...        VERTICAL PORTION
            IF((T.GE.0.0).AND.(T.LE.6.5))DPSIDT=0.0
C...
C...        CONSTANT PITCHOVER PORTION
            IF((T.GT.6.5).AND.(T.LE.28.01))DPSIDT=-0.93*PI/180.
C...
C...        GRAVITY TURN POSITION
            IF(T.GT.28.01)DPSIDT=(-G/V)*SIN(PI/2.-PSI)
C...
C...  THIS COMPLETES THE MODEL
      RETURN
      END
      BLOCK DATA
C...
C...  THIS BLOCK DATA ROUTINE DEFINES THE TABULAR VALUES OF XM AND YCD
C...
      COMMON/T/      T,  NSTOP,  NORUN
     1      /Y/      X,      Y,     VX,     VY,      W,    PSI
     2      /F/   DXDT,   DYDT,  DVXDT,  DVYDT,   DWDT, DPSIDT
     3      /C/      G,     G0,    RHO,   TEMP,      C,      V,   MACH,
     4              CD, THROTL,  REDUC,      Q,   DRAG,   SUMF,     PI,
     5           NUSOL,  NULIQ,     W0,   TSOL,   TLIQ,      S, XM(37),
     6         YCD(37),     IP
      REAL       NUSOL,  NULIQ,     NU,   MACH
C...
C...  TABULATED VALUES OF MACH NUMBER
      DATA  XM/    0.0,    0.2,    0.4,    0.6,    0.8,   0.85,    0.9,
     1            0.95,    1.0,   1.05,    1.1,   1.15,    1.2,    1.4,
     2             1.6,    1.8,    2.0,    2.2,    2.4,    2.6,    2.8,
     3             3.0,    3.2,    3.4,    3.6,    3.8,    4.0,    4.2,
     4             4.4,    4.6,    4.8,    5.0,    5.2,    5.4,    5.6,
     5             5.8,    6.0/
C...
C...  TABULATED VALUES OF DRAG COEFFICIENT
      DATA YCD/   0.16,   0.17,   0.18,   0.22,   0.32,   0.50,   0.58,
     1            0.60,   0.62,   0.62,   0.61,   0.60,   0.59,   0.55,
     2            0.51,   0.48,   0.45,   0.42,   0.39,   0.38,   0.35,
     3            0.34,   0.32,   0.31,   0.30,   0.29,   0.28,   0.27,
     4            0.27,   0.27,   0.26,   0.26,   0.25,   0.25,   0.25,
     5            0.24,   0.24/
      END
      SUBROUTINE PRINT(NI,NO)
      COMMON/T/      T,  NSTOP,  NORUN
     1      /Y/      X,      Y,     VX,     VY,      W,    PSI
     2      /F/   DXDT,   DYDT,  DVXDT,  DVYDT,   DWDT, DPSIDT
     3      /C/      G,     G0,    RHO,   TEMP,      C,      V,   MACH,
     4              CD, THROTL,  REDUC,      Q,   DRAG,   SUMF,     PI,
     5           NUSOL,  NULIQ,     W0,   TSOL,   TLIQ,      S, XM(37),
     6         YCD(37),     IP
      REAL       NUSOL,  NULIQ,     NU,   MACH
C...
C...  DIMENSION THE ARRAYS FOR THE PLOTTED SOLUTION
      DIMENSION TP(76), HP(76), VP(76), WP(76), TEMPP(76), PSIP(76)
C...
C...  CONVERT THE ALTITUDE FROM FT TO NAUTICAL MILES
      H=Y/(5280.0*1.151)
C...
C...  CONVERT SHUTTLE WEIGHT AND WEIGHT TIME DERIVATIVE TO TONS
      WT=W/2000.
      DWTDT=DWDT/2000.
C...
C...  CONVERT THE TEMPERATURE FROM (R) TO (F)
      TEMPF=TEMP-459.67
C...
C...  CONVERT THE ANGLE PSI FROM RADIANS TO DEGREES
      PSID=PSI*180.0/PI
C...
C...  PRINT THE SOLUTION EVERY 15TH CALL TO SUBROUTINE PRINT
      IP=IP+1
      IF(((IP-1)/15*15).EQ.(IP-1))THEN
      WRITE(NO,1)T,X,Y,VX,VY,DVXDT,DVYDT
1     FORMAT(1H ,//,' TIME = ',F6.3,//,
     1 '        X = ',F7.1,'        Y = ',F7.1,/,
     2 '       VX = ',F7.1,'       VY = ',F7.1,/,
     3 '   DVX/DT = ',F7.1,'   DVY/DT = ',F7.1)
      WRITE(NO,2)Q,H,WT,DWTDT,G,RHO,TEMPF,C,MACH,CD,V,PSID
2     FORMAT(
     1 '        Q = ',F7.1,'        H = ',F7.1,/,
     2 '        W = ',F7.1,'    DW/DT = ',F7.1,/,
     3 '        G = ',F7.1,'      RHO = ',F7.4,/,
     4 '     TEMP = ',F7.1,'        C = ',F7.1,/,
     5 '     MACH = ',F7.1,'       CD = ',F7.3,/,
     6 '        V = ',F7.1,'     PSID = ',F7.1)
      END IF
C...
C...  STORE THE SOLUTION FOR PLOTTING
      TP(IP)=T
      HP(IP)=H
      VP(IP)=MACH
      WP(IP)=WT
      TEMPP(IP)=TEMPF
      PSIP(IP)=PSID
C...
C...  PLOT THE SOLUTION AT THE END OF THE RUN
      IF(IP.LT.76)RETURN
      CALL TPLOTS(1,IP,TP,HP)
      WRITE(NO,11)
11    FORMAT(1H ,/,' ALTITUDE (NAUTICAL MILES) VS TIME (SEC)',/)
      CALL TPLOTS(1,IP,TP,VP)
      WRITE(NO,12)
12    FORMAT(1H ,/,' MACH NUMBER VS TIME (SEC)',/)
      CALL TPLOTS(1,IP,TP,WP)
      WRITE(NO,13)
13    FORMAT(1H ,/,' WEIGHT (TONS) VS TIME (SEC)',/)
      CALL TPLOTS(1,IP,TP,TEMPP)
      WRITE(NO,14)
14    FORMAT(1H ,/,' TEMPERATURE (F) VS TIME (SEC)',/)
      CALL TPLOTS(1,IP,TP,PSIP)
      WRITE(NO,15)
15    FORMAT(1H ,/,' ANGLE (DEGREES) VS TIME (SEC)',/)
      RETURN
      END
SHUTTLE LAUNCH SIMULATION
0.        75.       1.
    6 1000    1    1  REL 0.001
END OF RUNS
*APP FLOW38
      SUBROUTINE INITAL
C...
C...  SETTLING OF A PARTICLE IN A FLUID
C...
C...  THE FOLLOWING ORDINARY DIFFERENTIAL EQUATION (ODE) DEFINES THE
C...  VELOCITY V(T) OF A PARTICLE OF RADIUS R AND DENSITY RHO WHICH
C...  IS SETTLING IN A FLUID OF DENSITY RHOF
C...
C...     M*DV/DT = (4/3)*PI*(R**3)*G*(RHO - RHOF)
C...                                                               (1)
C..              - CD*(1/2)*RHOF*(V**2)*PI*(R**2)
C...
C...  WHERE
C...
C...     M      MASS OF THE PARTICLE = (4/3)*PI*(R**3)*RHO
C...
C...     CD     DRAG COEFFICIENT
C...
C...            = 24/RE, RE LE 0.5
C...
C...            = (0.545 + (24/RE)**0.5)**2, 0.5 LT RE LE 1.0E+04
C...
C...            = 0.44, RE GT 1.0E+04
C...
C...     RE     REYNOLDS NUMBER = D*V*RHF/VIS (D = 2*R)
C...
C...     R      PARTICLE RADIUS = 0.1 CM
C...
C...     RHO    PARTICLE DENSITY = 2000 KG/M**3
C...
C...     RHOF   FLUID DENSITY = 1000 KG/M**3
C...
C...     G      ACCELERATION OF GRAVITY = 9.8 M/SEC**2
C...
C...     VIS    FLUID VISOCITY = 1 CP
C...
C...  THE FOLLOWING PROGRAM COMPUTES THE PARTICLE ACCELERATION, VELCOITY
C...  AND POSITION AS A FUNCTION OF TIME.
C...
C...  COMMON AREA LINKING THE SUBROUTINES
      COMMON/T/      T,  NSTOP,  NORUN
     1      /Y/      X,      V
     2      /F/   DXDT,   DVDT
     3      /C/     C1,     C2,     C3,     RE,    CD,   RHOF,    VIS,
     4               R,     IP
C...
C...  SET THE MODEL CONSTANTS (IN CGS UNITS)
      R=0.1
      RHO =2000.0*1000.0/(100.0**3)
      RHOF=1000.0*1000.0/(100.0**3)
      VIS=0.01
      G=9.8*100.0
      PI=3.1415927
      VOL=(4./3.)*PI*(R**3)
      C1=VOL*RHO
      C2=VOL*G*(RHO-RHOF)
      C3=(1./2.)*RHOF*PI*(R**2)
C...
C...  INITIAL CONDITIONS
      X=0.
      V=0.
C...
C...  INITIAL DERIVATIVES
      CALL DERV
      IP=0
      RETURN
      END
      SUBROUTINE DERV
      COMMON/T/      T,  NSTOP,  NORUN
     1      /Y/      X,      V
     2      /F/   DXDT,   DVDT
     3      /C/     C1,     C2,     C3,     RE,    CD,   RHOF,    VIS,
     4               R,     IP
C...
C...  REYNOLDS NUMBER
      RE=(2.0*R)*RHOF*V/VIS
C...
C...  DRAG COEFFICIENT
      CD=DRAG(RE)
C...
C...  VELOCITY ODE
      DVDT=(1.0/C1)*(C2-CD*C3*(V**2))
C...
C...  POSITION ODE
      DXDT=V
      RETURN
      END
      FUNCTION DRAG(RE)
C...
C...  FUNCTION DRAG COMPUTES THE DRAG COEFFICIENT AS A FUNCTION OF
C...  THE REYNOLDS NUMBER
C...
      IF( RE.LE.1.0E-10)DRAG=0.
      IF((RE.GT.1.0E-10).AND.(RE.LE.0.5))DRAG=24.0/RE
      IF((RE.GT.0.5).AND.(RE.LE.1.0E+04))DRAG=
     1  (0.545+SQRT(24.0/RE))**2
      IF( RE.GT.1.0E+04)DRAG=0.44
      RETURN
      END
      SUBROUTINE PRINT(NI,NO)
      COMMON/T/      T,  NSTOP,  NORUN
     1      /Y/      X,      V
     2      /F/   DXDT,   DVDT
     3      /C/     C1,     C2,     C3,     RE,    CD,   RHOF,    VIS,
     4               R,     IP
C...
C...  PRINT A LABEL FOR THE NUMERICAL SOLUTION
      IF(IP.EQ.0)WRITE(NO,1)
1     FORMAT(9X,'T',11X,'X',11X,'V',10X,'RE',10X,'CD')
C...
C...  PRINT THE NUMERICAL SOLUTION
      WRITE(NO,2)T,X,V,RE,CD
2     FORMAT(F10.4,2F12.4,F12.2,F12.3)
      IP=IP+1
      RETURN
      END
SETTLING OF A PARTICLE IN A FLUID
0.        0.2       0.02
    2 1000    1    1  REL 0.001
END OF RUNS
*APP FLOW39
      SUBROUTINE INITAL
C...
C...  FLOW THROUGH POROUS MEDIA
C...
C...  THE FOLLOWING MODEL FOR THE MOVEMENT OF WATER THROUGH VERY DRY
C...  SOIL IS DISCUSSED BY FINLAYSON (1)
C...
C...     (-S  )*P  = (KR(PC)*P ) , PC = - P                  (1)(2)
C...        PC   T            X X
C...
C...     P(0,T) = BP1, P (1,T) = 0                           (3)(4)
C...                    X
C...
C...     P(X,0) = BP0                                           (5)
C...
C...  (1)  FINLAYSON, B. A., FLOW THROUGH POROUS MEDIA, IN STIFF
C...       COMPUTATION (R. C. AIKEN, ED), OXFORD UNIVERSITY PRESS,
C...       1985, PP. 130-134
C...
C...  WHERE
C...
C...     P     WATER PRESSURE
C...
C...     PC    CAPILLARY PRESSURE
C...
C...     T     TIME
C...
C...     X     POSITION
C...
C...     S     SATURATION
C...
C...     KR    RELATIVE PERMEABILITY
C...
C...     BP0,  CONSTANT INITIAL AND BOUNDARY VALUES OF P(X,T),
C...     BP1   RESPECTIVELY
C...
C...  AN ALPHABETIC SUBSCRIPT IN THE PRECEDING EQUATIONS INDICATES A
C...  PARTIAL DERIVATIVE, E.G., P  IS THE FIRST-ORDER PARTIAL DERIVATIVE
C...                             T
C...  OF P WITH RESPECT TO T.
C...
C...  KR AND S ARE GIVEN BY THE FOLLOWING EQUATIONS
C...
C...     KR = 1/(1 + PC*L/146)**6.65                            (6)
C...
C...     S = 0.32 + 0.68/(1 + PC*L/231)**3.65                   (7)
C...
C...  WHERE L = 300 CM.
C...
C...  THE NUMERICAL VALUES OF THE MODELS PARAMETERS ARE SET IN SUBROU-
C...  TINE INITAL, AND THE MODEL EQUATIONS, (1) TO (7), ARE PROGRAMMED
C...  IN SUBROUTINE DERV.
C...
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/     P(51)
     2      /F/    PT(51)
     3      /S/    PX(51),   KPX(51),  KPXX(51)
     4      /C/        C1,        C2,         L,         N,        IP
      REAL              L,         K,       KPX,      KPXX
C...
C...  SET THE MODEL PARAMETERS
C...
C...  THE FOLLOWING VALUES OF C1 AND C2 WERE SELECTED ARBITRARILY.
C...  FINLAYSON'S FIGURE 3.4 SUGGESTS C1 = 0, C2 = -1, BUT WHEN THESE
C...  VALUES WERE USED, STRANGE NUMBERS WERE COMPUTED IN FUNCTION K
C...  WHICH APPEARS TO HAPPEN WHEN P AND PC ARE CLOSE TO 0.  THEREFORE,
C...  VALUES OF C1 AND C2 WERE SELECTED TO KEEP P AND PC AWAY FROM 0
      C1=-1.0
      C2=-2.0
      L=300.
      N=51
C...
C...  MODEL INITIAL CONDITIONS
      DO 1 I=1,N
      P(I)=C2
1     CONTINUE
C...
C...  INITIAL DERIVATIVES
      CALL DERV
      IP=0
      RETURN
      END
      SUBROUTINE DERV
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/     P(51)
     2      /F/    PT(51)
     3      /S/    PX(51),   KPX(51),  KPXX(51)
     4      /C/        C1,        C2,         L,         N,        IP
      REAL              L,         K,       KPX,      KPXX
C...
C...  CONSTRAIN THE PRESSURE TO PHYSICALLY MEANINGFUL VALUES
      DO 3 I=1,N
      IF(P(I).GT.0.)P(I)=0.
3     CONTINUE
C...
C...  BOUNDARY CONDITION AT X = 0
      P(1)=C1
      PT(1)=0.
C...
C...  SPATIAL DERIVATIVE P
C...                      X
      CALL DSS004(0.,1.,N,P,PX)
C...
C...  BOUNDARY CONDITION AT X = 1
      PX(N)=0.
C...
C...  PRODUCT K(P)*P
C...                X
      DO 1 I=1,N
      KPX(I)=K(I)*PX(I)
1     CONTINUE
C...
C...  DERIVATIVE (K(P)*P )
C...                    X X
      CALL DSS004(0.,1.,N,KPX,KPXX)
C...
C...  PDE
      DO 2 I=2,N
      PT(I)=-(1./SP(I))*KPXX(I)
2     CONTINUE
      RETURN
      END
      REAL FUNCTION K(I)
C...
C...  FUNCTION K COMPUTES THE RELATIVE PERMEABILITY ACCORDING TO
C...  EQUATION (6)
C...
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/     P(51)
     2      /F/    PT(51)
     3      /S/    PX(51),   KPX(51),  KPXX(51)
     4      /C/        C1,        C2,         L,         N,        IP
      COMMON/IO/       NI,        NO
      REAL              L,       DUM,       KPX,      KPXX
      PC=-P(I)
      IF(PC.LT.0.)PC=0.
      ARG=1.+PC*L/146.
      K=1./ARG**6.65
      RETURN
      END
      REAL FUNCTION SP(I)
C...
C...  FUNCTION SP COMPUTES THE DERIVATIVE S  ACCORDING TO EQUATION
C...  (7)                                  P
C...
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/     P(51)
     2      /F/    PT(51)
     3      /S/    PX(51),   KPX(51),  KPXX(51)
     4      /C/        C1,        C2,         L,         N,        IP
      COMMON/IO/       NI,        NO
      REAL              L,         K,       KPX,      KPXX
      PC=-P(I)
      IF(PC.LT.0.)PC=0.
      ARG=1.+PC*L/231.
      SP=(0.68)*(-3.65)*(ARG**(-4.65))*(L/231.)
      RETURN
      END
      SUBROUTINE PRINT(NI,NO)
      COMMON/T/         T,     NSTOP,     NORUN
     1      /Y/     P(51)
     2      /F/    PT(51)
     3      /S/    PX(51),   KPX(51),  KPXX(51)
     4      /C/        C1,        C2,         L,         N,        IP
      REAL              L,         K,       KPX,      KPXX,
     1                                     KPXP,     KPXXP
C...
C...  DIMENSION THE ARRAYS FOR THE PLOTTED SOLUTION
      DIMENSION             PP(3,51),            PXP(3,51),
     1                    KPXP(3,51),          KPXXP(3,51),
     2                     PTP(3,51),               XP(51)
C...
C...  PRINT THE NUMERICAL SOLUTION
      NS=10
      WRITE(NO,1)T,(   P(I),I=1,N,NS),(  PX(I),I=1,N,NS),
     1             ( KPX(I),I=1,N,NS),(KPXX(I),I=1,N,NS),
     2             (  PT(I),I=1,N,NS)
1     FORMAT(1H ,//,5H T = ,F10.3,/,
     1 5H    P,6E11.3,/,5H   PX,6E11.3,/,
     2 5H  KPX,6E11.3,/,5H KPXX,6E11.3,/,
     3 5H   PT,6E11.3,/)
C...
C...  INITIALIZE A SECOND COUNTER FOR THE PLOTTED SOLUTION
      IF(IP.EQ.0)IP1=0
C...
C...  STORE THE SOLUTION FOR PLOTTING
      IP=IP+1
      IF(((IP-1)/10*10).NE.(IP-1))RETURN
      IP1=IP1+1
      DO 2 I=1,N
      XP(I)=FLOAT(I-1)/FLOAT(N-1)
         PP(IP1,I)=P(I)
        PXP(IP1,I)=PX(I)
       KPXP(IP1,I)=KPX(I)
      KPXXP(IP1,I)=KPXX(I)
        PTP(IP1,I)=PT(I)
2     CONTINUE
C...
C...  PLOT THE NUMERICAL SOLUTION
      IF(IP1.LT.3)RETURN
C...
C...  P VS X WITH T AS A PARAMETER
      CALL TPLOTS(3,IP,XP,   PP)
      WRITE(NO,11)
11    FORMAT(1H ,//,' P(X,T) VS X, T = 0, 1, 2')
C...
C...  PX VS X WITH T AS A PARAMETER
      CALL TPLOTS(3,IP,XP,  PXP)
      WRITE(NO,12)
12    FORMAT(1H ,//,' PX VS X, T = 0, 1, 2')
C...
C...  KR*PX VS X WITH T AS A PARAMETER
      CALL TPLOTS(3,IP,XP, KPXP)
      WRITE(NO,13)
13    FORMAT(1H ,//,' KR*PX VS X, T = 0, 1, 2')
C...
C...  (KR*PX)X VS X WITH T AS A PARAMETER
      CALL TPLOTS(3,IP,XP,KPXXP)
      WRITE(NO,14)
14    FORMAT(1H ,//,' (KR*PX)X VS X, T = 0, 1, 2')
C...
C...  PT VS X WITH T AS A PARAMETER
      CALL TPLOTS(3,IP,XP,  PTP)
      WRITE(NO,15)
15    FORMAT(1H ,//,' PT VS T, T = 0, 1, 2')
      IP=0
      IP1=0
      RETURN
      END
MOVEMENT OF WATER IN DRY SOIL
0.        2.0       0.1
   51 1000    1    1  ABS  0.01
END OF RUNS
*APP FLOW40
      SUBROUTINE INITAL
C...
C...  RIVER POLLUTION MODEL
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 + PS(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...  PS(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 1, 1986 RESULTING FROM A LARGE
C...  DISCHARGE OF PESTICIDE FROM A CHEMICAL PLANT IN SWITZERLAND.  THE
C...  SOURCE FUNCTION, SP(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...  PS(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 THREE VARIATIONS OF THE MODEL.  IN
C...  PARTICULAR, THE EXIT BOUNDARY CONDITION (4) IS CHANGED, AS DES-
C...  CRIBED 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.
      B=5.
      C=0.
      X0=0.
      XF=500.
      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.0*DX
C...
C...  MODEL INITIAL CONDITION (2)
      DO 2 I=1,N
      U(I)=0.
2     CONTINUE
C...
C...  INITIAL DERIVATIVES
      CALL DERV
      IP=0
      RETURN
      END
      SUBROUTINE DERV
C...
C...  SUBROUTINE DERV CALLS SUBROUTINES DERV1, DERV2 AND DERV3 FOR
C...  ALTERNATE BOUNDARY CONDITIONS AT X = XF
C...
      COMMON/T/      T,  NSTOP,  NORUN
C...
C...  *****************************************************************
C...
C...  DERV1 IMPLEMENTS THE DIRICHLET BOUNDARY CONDITION U(XF,T) = 0.
C...  THIS CONDITION REPRESENTS A CONDITION OF NO POLLUTION AT THE END
C...  OF THE RIVER.
      IF(NORUN.EQ.1)CALL DERV1
C...
C...  *****************************************************************
C...
C...  DERV2 IMPLEMENTS THE NEUMANN BOUNDARY CONDITION U (XF,T) = 0.
C...                                                   X
C...  THIS CONDITION REPRESENTS PURE CONVECTION (FLOW) FROM THE END OF
C...  THE RIVER.
      IF(NORUN.EQ.2)CALL DERV2
C...
C...  *****************************************************************
C...
C...  DERV3 IMPLEMENTS THE TIME-DEPENDENT BOUNDARY CONDITION U (XF,T)
C...                                                          T
C...  = -B*U (XF,T).  THIS CONDITION REPRESENTS CONVECTION (FLOW) PLUS
C...        X
C...  ACCUMULATION AT THE END OF THE RIVER.
      IF(NORUN.EQ.3)CALL DERV3
C...
C...  *****************************************************************
C...
      RETURN
      END
      SUBROUTINE DERV1
C...
C...  SUBROUTINE DERV1 IMPLEMENTS THE NUMERICAL METHOD OF LINES
C...  SOLUTION OF EQUATIONS (1) TO (4)
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.
      UT(1)=0.
C...
C...  BOUNDARY CONDITION (4)
      U(N)=0.
      UT(N)=0.
C...
C...  EQUATION (1)
      DO 1 I=2,N-1
      UT(I)=A*(U(I+1)-2.0*U(I)+U(I-1))/DXS
     1     -B*(U(I+1)-U(I-1))/DX
     2     -C*U(I)+PS(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
      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.
      UT(1)=0.
C...
C...  NEUMANN BOUNDARY CONDITION
      U(N)=(1.0/3.0)*(4.0*U(N-1)-U(N-2))
      UT(N)=0.
C...
C...  EQUATION (1)
      DO 1 I=2,N-1
      UT(I)=A*(U(I+1)-2.0*U(I)+U(I-1))/DXS
     1     -B*(U(I+1)-U(I-1))/DX
     2     -C*U(I)+PS(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 TIME-DEPENDENT BOUNDARY CONDITION U (XF,T) =
C...  = -B*U (XF,T)                                      T
C...        X
      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.
      UT(1)=0.
C...
C...  TIME-DEPENDENT BOUNDARY CONDITION
      UT(N)=-B*(1.0/DX)*(3.0*U(N)-4.0*U(N-1)+U(N-2))
C...
C...  EQUATION (1)
      DO 1 I=2,N-1
      UT(I)=A*(U(I+1)-2.0*U(I)+U(I-1))/DXS
     1     -B*(U(I+1)-U(I-1))/DX
     2     -C*U(I)+PS(X(I),T)
1     CONTINUE
      RETURN
      END
      FUNCTION PS(X,T)
C...
C...  FUNCTION PS(X,T) DEFINES THE POLLUTION SOURCE FUNCTION
C...
C...  POLLUTION ENTERS THE RIVER AT X = 250
      IF((X.GT.249.5).AND.(X.LT.250.5))THEN
C...
C...  THE POLLUTION ENTERS THE RIVER FOR 10 TIME UNITS
         IF(T.LE.10.0)THEN
            PS=100.
         ELSE
C...
C...  AFTER TEN TIME UNITS, THE POLLUTION IS ENDED
            PS=0.
         END IF
      ELSE
C...
C...  THE RIVER IS NOT POLLUTED AT OTHER LOCATIONS (THAN X = 250)
         PS=0.
      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)
      CALL QIKSET(5.,0.,100.,8.,-10.,20.)
      CALL QIKPLT(X,UP,-N,8H*X (KM)*,14H*U(X,T) (BOD)*,
     1 33H*BIOCHEMICAL OXYGEN DEMAND (BOD)*,-6)
      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.10
      Y1=8.5
      Y2=8.45
      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
RIVER POLLUTION MODEL, DIRICHLET BOUNDARY CONDITION
0.        100.0     20.0
   51 1000    1    1  ABS 0.001
RIVER POLLUTION MODEL, NEUMANN BOUNDARY CONDITION
0.        100.0     20.0
   51 1000    1    1  ABS 0.001
RIVER POLLUTION MODEL, TIME-DEPENDENT BOUNDARY CONDITION
0.        100.0     20.0
   51 1000    1    1  ABS 0.001
END OF RUNS
*APP FLOW41
      SUBROUTINE INITAL
C...
C...  METHOD OF LINES IMPLEMENTATION OF BOUNDARY CONDITIONS FOR
C...  CONVECTIVE-DIFFUSION EQUATIONS
C...
C...  THE MODELING OF A BROAD SPECTRUM OF CHEMICAL AND PHYSICAL SYSTEMS
C...  EVENTUALLY LEADS TO PARTIAL DIFFERENTIAL EQUATIONS (PDES) WHICH
C...  ARE GENERALLY CLASSIFIED AS 'CONVECTIVE-DIFFUSION EQUATIONS'.
C...  THIS TERM RELECTS THE FACT THAT BOTH DIFFUSION, AS MODELED BY
C...  SECOND-ORDER SPATIAL DERIVATIVES, AND CONVECTION (FLOW) AS MODELED
C...  BY FIRST-ORDER SPATIAL DERIVATIVES, APPEAR IN THE PDES.
C...
C...  SINCE THE PDES ARE SECOND ORDER DUE TO THE DIFFUSION TERMS,
C...  SPATIAL (TWO-POINT) BOUNDARY CONDITIONS ARE REQUIRED.  THE
C...  MATHEMATICAL FORM OF THESE BOUNDARY CONDITIONS HAS BEEN EXTEN-
C...  SIVELY DISCUSSED IN THE LITERATURE.  BEYOND THE FORM OF THE
C...  BOUNDARY CONDITIONS, THEIR IMPLEMENTATION IN COMPUTER CODES IS
C...  OF PRACTICAL INTEREST, PARTICULARLY THE BOUNDARY CONDITIONS FOR
C...  THE EXIT OF THE PROBLEM SYSTEM.
C...
C...  IN THE FOLLOWING PROGRAM, WE CONSIDER TWO FORMS OF THE EXIT
C...  BOUNDARY CONDITIONS FOR A CONVECTIVE-DIFFUSION MODEL OF POLLUTANT
C...  DISPERSION IN A RIVER.  THE BOUNDARY CONDITIONS ARE SUMMARIZED
C...  BELOW
C...
C...     (1)  DIRICHLET CONDITION - THE DEPENDENT VARIABLE AT THE EXIT
C...          IS SPECIFIED, IN THIS CASE ZERO POLLUTION AT THE EXIT OF
C...          THE RIVER, DUE TO, FOR EXAMPLE, FLOW INTO A LARGE BODY
C...          OF UNPOLLUTED WATER.
C...
C...     (2)  NEUMANN DERIVATIVE - THE NORMAL (FIRST-ORDER SPATIAL)
C...          DERIVATIVE IS SPECIFIED IN SOME WAY AT THE EXIT.  HERE
C...          WE CONSIDER TWO CASES
C...
C...          (2.1)  PURE CONVECTION, SO THAT THE DERIVATIVE IS ZERO.
C...                 THIS FORM WAS SUGGESTED BY DR. PHILLIP M. GRESHO
C...                 OF THE LAWRENCE LIVERMORE NATIONAL LABORATORY.
C...                 THE IMPLEMENTATION IS A MINOR VARIATION ON DR.
C...                 GRESHO'S SUGGESTION - A SECOND-ORDER APPROXIMATION
C...                 IS USED IN PLACE OF A FIRST-ORDER APPROXIMATION SO
C...                 THAT THE ORDERS OF THE PDE AND BOUNDARY CONDITION
C...                 APPROXIMATIONS ARE THE SAME.
C...
C...          (2.2)  CONVECTION PLUS ACCUMULATION OF MASS, SO THAT
C...                 THE BOUNDARY CONDITION IS A FIRST-ORDER PDE IN
C...                 SPACE AND TIME.  THIS FORM WAS SUGGESTED BY
C...                 PROFESSOR JIM DOUGLAS, DEPARTMENT OF MATHEMATICS,
C...                 UNIVERSITY OF CHICAGO.
C...
C...     IN ALL CASES, ONLY THE BOUNDARY CONDITION IS APPROXIMATED AT
C...     THE BOUNDARY.  A VARIATION ON THE FOLLOWING PROGRAMMING WOULD
C...     BE TO APPROXIMATE BOTH THE BOUNDARY CONDITION AND THE PDE AT
C...                                                   --- --- ---
C...     THE BOUNDARY.  THIS POINT HAS BEEN INVESTIGATED IN ANOTHER
C...     COMPUTER PROGRAM AVAILABLE FROM W. E. SCHIESSER.
C...
C...  AT THIS POINT, WE CONSIDER THE CONVECTIVE-DIFFUSION MODEL FOR
C...  POLLUTANT DISPERSION IN A RIVER, THEN GO INTO THE PROGRAMMING
C...  OF CASES (1) AND (2) ABOVE (THE PROGRAM GOES THROUGH A TOTAL
C...  OF THREE RUNS FOR CASES (1), (2.1) AND (2.2)).  NUMERICAL AND
C...  GRAPHICAL OUTPUT IS PRODUCED TO FACILITATE COMPARISON OF THE
C...  SOLUTIONS FOR THESE CASES.
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 + PS(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...  PS(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, SP(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...  PS(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 THREE VARIATIONS OF THE MODEL.  IN
C...  PARTICULAR, THE EXIT BOUNDARY CONDITION (4) IS CHANGED, AS DES-
C...  CRIBED 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.
      B=5.
      C=0.
      X0=0.
      XF=500.
      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.0*DX
C...
C...  MODEL INITIAL CONDITION (2)
      DO 2 I=1,N
      U(I)=0.
2     CONTINUE
C...
C...  INITIAL DERIVATIVES
      CALL DERV
      IP=0
      RETURN
      END
      SUBROUTINE DERV
C...
C...  SUBROUTINE DERV CALLS SUBROUTINES DERV1, DERV2 AND DERV3 FOR
C...  ALTERNATE BOUNDARY CONDITIONS AT X = XF
C...
      COMMON/T/      T,  NSTOP,  NORUN
C...
C...  *****************************************************************
C...
C...  DERV1 IMPLEMENTS THE DIRICHLET BOUNDARY CONDITION U(XF,T) = 0.
C...  THIS CONDITION REPRESENTS A CONDITION OF NO POLLUTION AT THE END
C...  OF THE RIVER.
      IF(NORUN.EQ.1)CALL DERV1
C...
C...  *****************************************************************
C...
C...  DERV2 IMPLEMENTS THE NEUMANN BOUNDARY CONDITION U (XF,T) = 0.
C...                                                   X
C...  THIS CONDITION REPRESENTS PURE CONVECTION (FLOW) FROM THE END OF
C...  THE RIVER.
      IF(NORUN.EQ.2)CALL DERV2
C...
C...  *****************************************************************
C...
C...  DERV3 IMPLEMENTS THE TIME-DEPENDENT BOUNDARY CONDITION U (XF,T)
C...                                                          T
C...  = -B*U (XF,T).  THIS CONDITION REPRESENTS CONVECTION (FLOW) PLUS
C...        X
C...  ACCUMULATION AT THE END OF THE RIVER.
      IF(NORUN.EQ.3)CALL DERV3
C...
C...  *****************************************************************
C...
      RETURN
      END
      SUBROUTINE DERV1
C...
C...  SUBROUTINE DERV1 IMPLEMENTS THE NUMERICAL METHOD OF LINES
C...  SOLUTION OF EQUATIONS (1) TO (4)
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.
      UT(1)=0.
C...
C...  BOUNDARY CONDITION (4)
      U(N)=0.
      UT(N)=0.
C...
C...  EQUATION (1)
      DO 1 I=2,N-1
      UT(I)=A*(U(I+1)-2.0*U(I)+U(I-1))/DXS
     1     -B*(U(I+1)-U(I-1))/DX
     2     -C*U(I)+PS(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
      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.
      UT(1)=0.
C...
C...  NEUMANN BOUNDARY CONDITION
      U(N)=(1.0/3.0)*(4.0*U(N-1)-U(N-2))
      UT(N)=0.
C...
C...  EQUATION (1)
      DO 1 I=2,N-1
      UT(I)=A*(U(I+1)-2.0*U(I)+U(I-1))/DXS
     1     -B*(U(I+1)-U(I-1))/DX
     2     -C*U(I)+PS(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 TIME-DEPENDENT BOUNDARY CONDITION U (XF,T) =
C...  = -B*U (XF,T)                                      T
C...        X
      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.
      UT(1)=0.
C...
C...  TIME-DEPENDENT BOUNDARY CONDITION
      UT(N)=-B*(1.0/DX)*(3.0*U(N)-4.0*U(N-1)+U(N-2))
C...
C...  EQUATION (1)
      DO 1 I=2,N-1
      UT(I)=A*(U(I+1)-2.0*U(I)+U(I-1))/DXS
     1     -B*(U(I+1)-U(I-1))/DX
     2     -C*U(I)+PS(X(I),T)
1     CONTINUE
      RETURN
      END
      FUNCTION PS(X,T)
C...
C...  FUNCTION PS(X,T) DEFINES THE POLLUTION SOURCE FUNCTION
C...
C...  POLLUTION ENTERS THE RIVER AT X = 250
      IF((X.GT.249.5).AND.(X.LT.250.5))THEN
C...
C...  THE POLLUTION ENTERS THE RIVER FOR 10 TIME UNITS
         IF(T.LE.10.0)THEN
            PS=100.
         ELSE
C...
C...  AFTER TEN TIME UNITS, THE POLLUTION IS ENDED
            PS=0.
         END IF
      ELSE
C...
C...  THE RIVER IS NOT POLLUTED AT OTHER LOCATIONS (THAN X = 250)
         PS=0.
      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)
      CALL QIKSET(5.,0.,100.,8.,-10.,20.)
      CALL QIKPLT(X,UP,-N,8H*X (KM)*,14H*U(X,T) (BOD)*,
     1 33H*BIOCHEMICAL OXYGEN DEMAND (BOD)*,-6)
      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=8.5
      Y2=8.45
      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
RIVER POLLUTION MODEL, DIRICHLET BOUNDARY CONDITION
0.        100.0     20.0
   51 1000    1    1  ABS 0.001
RIVER POLLUTION MODEL, NEUMANN BOUNDARY CONDITION
0.        100.0     20.0
   51 1000    1    1  ABS 0.001
RIVER POLLUTION MODEL, TIME-DEPENDENT BOUNDARY CONDITION
0.        100.0     20.0
   51 1000    1    1  ABS 0.001
END OF RUNS
*APP FLOW42
      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 FLOW43
      SUBROUTINE INITAL
C...
C...  A COMPARISON OF TWO-POINT UPWIND AND FIVE-POINT BIASED UPWIND
C...  APPROXIMATIONS IN THE NUMERICAL METHOD OF LINES INTEGRATION OF
C...  FIRST-ORDER HYPERBOLIC PARTIAL DIFFERENTIAL EQUATIONS
C...
C...  THE FOLLOWING SYSTEM OF TWO FIRST-ORDER HYPERBOLIC PARTIAL DIFFER-
C...  ENTIAL EQUATIONS, WHICH MODEL A CONCENTRIC PIPE HEAT EXCHANGER,
C...  IS USED TO DEMONSTRATE THE IMPLEMENTATION OF TWO-POINT AND FIVE-
C...  POINT BIASED UPWIND APPROXIMATIONS.
C...
C...  THE PARTIAL DIFFERENTIAL EQUATIONS DESCRIBING THE DYNAMICS OF A
C...  DOUBLE-PIPE HEAT EXCHANGER ARE
C...
C...     TFP  = -(FFP/AP)TFP  - (U*D*PI/(RHOFP*CPFP*AP))(TFP - TFA)  (1)
C...        T               Z
C...
C...     TFA  =  (FFA/AA)TFA  + (U*D*PI/(RHOFA*CPFA*AA))(TFP - TFA)  (2)
C...        T               Z
C...
C...  WITH INITIAL CONDITIONS
C...
C...     TFP(Z,0) = G1(Z), TFA(Z,0) = G2(Z)                       (3)(4)
C...
C...  AND BOUNDARY CONDITIONS
C...
C...     TFP(0,T) = G3(T), TFA(ZL,T) = G4(T)                      (5)(6)
C...
C...  WHERE
C...
C...     TFP       PIPE FLUID TEMPERATURE
C...
C...     TFA       ANNULUS FLUID TEMPERATURE
C...
C...     Z         AXIAL POSITION ALONG THE EXCHANGER
C...
C...     T         TIME
C...
C...     ZL        LENGTH OF THE EXCHANGER
C...
C...     FFP       PIPE FLUID VOLUMETRIC FLOW RATE
C...
C...     FFA       ANNULUS FLUID VOLUMETRIC FLOW RATE
C...
C...     AP        PIPE CROSS SECTIONAL AREA
C...
C...     AA        ANNULUS CROSS SECTIONAL AREA
C...
C...     U         OVERALL HEAT TRANSFER COEFFICIENT BETWEEN THE PIPE
C...               AND ANNULUS FLUIDS
C...
C...     D         PIPE INSIDE DIAMETER
C...
C...     RHOFP     PIPE FLUID DENSITY
C...
C...     RHOFA     ANNULUS FLUID DENSITY
C...
C...     CPFP      PIPE FLUID HEAT CAPACITY
C...
C...     CPFA      ANNULUS FLUID HEAT CAPACITY
C...
C...     G1(Z)     PRESCRIBED INITIAL CONDITION FUNCTIONS
C...     G2(Z)
C...
C...     G3(T)     PRESCRIBED BOUNDARY CONDITION FUNCTIONS
C...     G4(T)
C...
C...  1.0 FT**3/MIN OF A LUBE OIL AT 250F FLOWS THROUGH THE PIPE AND IS
C...  BEING COOLED WITH 1.0 FT**3/MIN OF WATER AT 60F FLOWING COUNTER-
C...  CURRENTLY THROUGH THE ANNULUS.  FOR THE ANALYSIS OF THE EXCHANGER,
C...  THE AXIAL DERIVATIVES ARE APPROXIMATED BY
C...
C...     (1)  TWO-POINT UPWIND APPROXIMATIONS (STIRRED TANKS IN SERIES)
C...          IMPLEMENTED IN SUBROUTINES INTAL1, DERV1 AND PRINT1
C...
C...     (2)  FIVE-POINT BIASED UPWIND APPROXIMATIONS IMPLEMENTED IN
C...          SUBROUTINES INTAL2, DERV2 AND PRINT2
C...
C...  THE PRODUCT U*D IS 3 BTU/MIN-FT-F.  THE OUTLET TEMPERATURES ARE OF
C...  PARTICULAR INTEREST, I.E., TFP(ZL,T) AND TFA(0,T).
C...
      COMMON/T/         T,      NFIN,     NORUN
      IF(NORUN.EQ.1)CALL INTAL1
      IF(NORUN.EQ.2)CALL INTAL2
      RETURN
      END
      SUBROUTINE INTAL1
      COMMON/T/         T,      NFIN,     NORUN
     1      /Y/ TFP(0:20), TFA(1:21)
     2      /F/TFPT(0:20),TFAT(1:21)
     3      /S/TFPZ(0:20),TFAZ(1:21)
     4      /C/        ZL,        DZ,        VP,        VA,        HP,
     5                 HA,       N20,       N21,        IP
C...
C...  SET THE MODEL PARAMETERS
      FFP=1.0
      FFA=1.0
      AP=0.1
      AA=0.1
      UD=3.0
      RHOFP=50.0
      RHOFA=62.0
      CPFP=0.5
      CPFA=1.0
      ZL=20.0
      N20=20
      N21=21
      DZ=ZL/FLOAT(N20)
C...
C...  PRECOMPUTE SOME CONSTANTS TO SAVE TIME
      VP=FFP/AP
      VA=FFA/AA
      HP=UD*3.1415927/(RHOFP*CPFP*AP)
      HA=UD*3.1415927/(RHOFA*CPFA*AA)
C...
C...  INITIAL CONDITIONS (3) AND (4)
      DO 1 I=0,N20
      Z=ZL*FLOAT(I)/FLOAT(N20)
      TFP(I)  =G1(Z)
      TFA(I+1)=G2(Z)
1     CONTINUE
C...
C...  INITIALIZE THE REST OF THE MODEL
      CALL DERV
      IP=0
      RETURN
      END
      SUBROUTINE INTAL2
      COMMON/T/         T,      NFIN,     NORUN
     1      /Y/   TFP(21),   TFA(21)
     2      /F/  TFPT(21),  TFAT(21)
     2      /S/  TFPZ(21),  TFAZ(21)
     4      /C/        ZL,        DZ,        VP,        VA,        HP,
     5                 HA,       N20,       N21,        IP
C...
C...  SET THE MODEL PARAMETERS
      FFP=1.0
      FFA=1.0
      AP=0.1
      AA=0.1
      UD=3.0
      RHOFP=50.0
      RHOFA=62.0
      CPFP=0.5
      CPFA=1.0
      ZL=20.0
      N20=20
      N21=21
      DZ=ZL/FLOAT(N21-1)
C...
C...  PRECOMPUTE SOME CONSTANTS TO SAVE TIME
      VP=FFP/AP
      VA=FFA/AA
      HP=UD*3.1415927/(RHOFP*CPFP*AP)
      HA=UD*3.1415927/(RHOFA*CPFA*AA)
C...
C...  INITIAL CONDITIONS (3) AND (4)
      DO 1 I=1,N21
      Z=ZL*FLOAT(I-1)/FLOAT(N21-1)
      TFP(I)=G1(Z)
      TFA(I)=G2(Z)
1     CONTINUE
C...
C...  INITIALIZE THE REST OF THE MODEL
      CALL DERV
      IP=0
      RETURN
      END
      FUNCTION G1(Z)
C...
C...  FUNCTION G1(Z) IMPLEMENTS INITIAL CONDITION (3)
      G1=60.0
      RETURN
      END
      FUNCTION G2(Z)
C...
C...  FUNCTION G2(Z) IMPLEMENTS INITIAL CONDITION (4)
      G2=60.0
      RETURN
      END
      FUNCTION G3(T)
C...
C...  FUNCTION G3(T) IMPLEMENTS BOUNDARY CONDITION (5)
      G3=250.0
      RETURN
      END
      FUNCTION G4(T)
C...
C...  FUNCTION G4(T) IMPLEMENTS BOUNDARY CONDITION (6)
      G4=60.0
      RETURN
      END
      SUBROUTINE DERV
      COMMON/T/         T,      NFIN,     NORUN
C...
C...  COMPUTE THE SPATIAL DERIVATIVES IN EQUATIONS (1) AND (2) BY
C...  TWO-POINT UPWIND APPROXIMATIONS (STIRRED TANKS IN SERIES)
      IF(NORUN.EQ.1)CALL DERV1
C...
C...  COMPUTE THE SPATIAL DERIVATIVES IN EQUATIONS (1) AND (2) BY
C...  FIVE-POINT BIASED UPWIND APPROXIMATIONS
      IF(NORUN.EQ.2)CALL DERV2
      RETURN
      END
      SUBROUTINE DERV1
      COMMON/T/         T,      NFIN,     NORUN
     1      /Y/ TFP(0:20), TFA(1:21)
     2      /F/TFPT(0:20),TFAT(1:21)
     3      /S/TFPZ(0:20),TFAZ(1:21)
     4      /C/        ZL,        DZ,        VP,        VA,        HP,
     5                 HA,       N20,       N21,        IP
C...
C...  BOUNDARY CONDITIONS (5) AND (6)
      TFP(0)  =G3(T)
      TFA(N21)=G4(T)
C...
C...  SPATIAL DERIVATIVES IN EQUATIONS (1) AND (2) ARE APPROXIMATED BY
C...  TWO-POINT UPWIND APPROXIMATIONS (STIRRED TANKS IN SERIES)
      DO 1 I=1,N20
      TFPT(I)=-VP*(TFP(I)-TFP(I-1))/DZ-HP*(TFP(I)-TFA(I))
1     CONTINUE
      DO 2 I=1,N20
      TFAT(I)= VA*(TFA(I+1)-TFA(I))/DZ+HA*(TFP(I)-TFA(I))
2     CONTINUE
      TFPT(0)=0.
      TFAT(N21)=0.
      RETURN
      END
      SUBROUTINE DERV2
      COMMON/T/         T,      NFIN,     NORUN
     1      /Y/   TFP(21),   TFA(21)
     2      /F/  TFPT(21),  TFAT(21)
     2      /S/  TFPZ(21),  TFAZ(21)
     4      /C/        ZL,        DZ,        VP,        VA,        HP,
     5                 HA,       N20,       N21,        IP
C...
C...  BOUNDARY CONDITIONS (5) AND (6)
      TFP(1)  =G3(T)
      TFA(N21)=G4(T)
C...
C...  SPATIAL DERIVATIVES IN EQUATIONS (1) AND (2) ARE APPROXIMATED BY
C...  FIVE-POINT BIASED UPWIND APPROXIMATIONS
      CALL DSS020(0.,ZL,N21,TFP,TFPZ,+1.)
      CALL DSS020(0.,ZL,N21,TFA,TFAZ,-1.)
C...
C...  EQUATIONS (1) AND (2)
      DO 1 I=1,N21
      IF(I.EQ.1)GO TO 2
      TFPT(I)=-VP*TFPZ(I)-HP*(TFP(I)-TFA(I))
2     IF(I.EQ.N21)GO TO 1
      TFAT(I)= VA*TFAZ(I)+HA*(TFP(I)-TFA(I))
1     CONTINUE
      TFPT(1)=0.
      TFAT(N21)=0.
      RETURN
      END
      SUBROUTINE PRINT(NI,NO)
      COMMON/T/         T,      NFIN,     NORUN
     4      /C/        ZL,        DZ,        VP,        VA,        HP,
     5                 HA,       N20,       N21,        IP
C...
C...  DIMENSION THE ARRAYS FOR PLOTTING
      COMMON/PLOT/ TP(4,101), TIMEP(101)
      DIMENSION  TFOP(2,101),TAOP(2,101)
C...
C...  FOR NORUN = 1, CALL SUBROUTINE PRINT1, AND AT THE END OF THE
C...  RUN, STORE THE EXIT TEMPERATURES
      IF(NORUN.EQ.1)THEN
         CALL PRINT1(NI,NO)
            IF(IP.EQ.101)THEN
               DO 1 I=1,IP
               TFOP(NORUN,I)=TP(2,I)
               TAOP(NORUN,I)=TP(3,I)
1              CONTINUE
            END IF
C...
C...  FOR NORUN = 2, CALL SUBROUTINE PRINT2, AND AT THE END OF THE
C...  RUN, STORE THE EXIT TEMPERATURES
      ELSE IF(NORUN.EQ.2)THEN
         CALL PRINT2(NI,NO)
            IF(IP.EQ.101)THEN
               DO 2 I=1,IP
               TFOP(NORUN,I)=TP(2,I)
               TAOP(NORUN,I)=TP(3,I)
2              CONTINUE
            END IF
      END IF
C...
C...  AT THE END OF THE SECOND RUN, PLOT THE EXIT TEMPERATURES
      IF((IP.EQ.101).AND.(NORUN.EQ.2))THEN
C...
C...     EXIT PIPE TEMPERATURES VS TIME
         CALL SPLOTS(NORUN,IP,TIMEP,TFOP)
         WRITE(NO,11)
11       FORMAT(1H ,/,' TFP(ZL,T), 1 - TWO-POINT, 2 - FIVE-POINT')
C...
C...     EXIT ANNULUS TEMPERATURES VS TIME
         CALL SPLOTS(NORUN,IP,TIMEP,TAOP)
         WRITE(NO,12)
12       FORMAT(1H ,/,' TFA(0,T),  1 - TWO-POINT, 2 - FIVE-POINT')
C...
C...  COMPUTE OVERALL STEADY STATE ENERGY BALANCES TO DETERMINE IF ONE
C...  APPROXIMATION IS BETTER THAN THE OTHER
C...
C...     STEADY STATE ENERGY BALANCE FOR TWO-POINT APPROXIMATIONS
         QIN1 =1.0*50.0*0.5*250.0     +1.0*62.0*1.0*60.0
         QOUT1=1.0*50.0*0.5*TFOP(1,IP)+1.0*62.0*1.0*TAOP(1,IP)
         QNET1=QIN1-QOUT1
C...
C...     STEADY STATE ENERGY BALANCE FOR FIVE-POINT APPROXIMATIONS
         QIN2 =1.0*50.0*0.5*250.0     +1.0*62.0*1.0*60.0
         QOUT2=1.0*50.0*0.5*TFOP(2,IP)+1.0*62.0*1.0*TAOP(2,IP)
         QNET2=QIN2-QOUT2
C...
C...     PRINT THE RESULTS OF THE STEADY STATE ENERGY BALANCE
         WRITE(NO,13)QIN1,QOUT1,QNET1,QIN2,QOUT2,QNET2
13       FORMAT(1H1,/,
     1  ' QIN1 = ',E12.5,' QOUT1 = ',E12.5,' QNET1 = ',E12.5,/,
     2  ' QIN2 = ',E12.5,' QOUT2 = ',E12.5,' QNET2 = ',E12.5,/)
      END IF
      RETURN
      END
      SUBROUTINE PRINT1(NI,NO)
      COMMON/T/         T,      NFIN,     NORUN
     1      /Y/ TFP(0:20), TFA(1:21)
     2      /F/TFPT(0:20),TFAT(1:21)
     3      /S/TFPZ(0:20),TFAZ(1:21)
     4      /C/        ZL,        DZ,        VP,        VA,        HP,
     5                 HA,       N20,       N21,        IP
C...
C...  DIMENSION THE ARRAYS FOR PLOTTING
      COMMON/PLOT/ TP(4,101), TIMEP(101)
C...
C...  LABEL THE NUMERICAL OUTPUT
      IF(T.LT.0.05)WRITE(NO,2)
2     FORMAT(9X,1HT,4X,8HTFP(0,T),3X,9HTFP(ZL,T),
     1              4X,8HTFA(0,T),3X,9HTFA(ZL,T))
C...
C...  PRINT THE NUMERICAL SOLUTION
      WRITE(NO,1)T,TFP(0),TFP(N20),TFA(1),TFA(N21)
1     FORMAT(F10.1,4F12.2)
C...
C...  STORE THE NUMERICAL SOLUTION FOR PLOTTING
      IP=IP+1
      TP(1,IP)=TFP(  0)
      TP(2,IP)=TFP(N20)
      TP(3,IP)=TFA(  1)
      TP(4,IP)=TFA(N21)
      TIMEP(IP)=T
C...
C...  PLOT THE INLET AND OUTLET TEMPERATURES AT THE END OF EACH RUN
      IF(IP.LT.101)RETURN
C...
C...  PLOT THE NUMERICAL SOLUTION
      CALL SPLOTS(4,IP,TIMEP,TP)
C...
C...  LABEL THE PLOT
      WRITE(NO,3)
3     FORMAT(1H ,/,' 1 - TFP( 0,T), 2 - TFP(ZL,T)',/,
     1             ' 3 - TFA( 0,T), 4 - TFA(ZL,T)')
      RETURN
      END
      SUBROUTINE PRINT2(NI,NO)
      COMMON/T/         T,      NFIN,     NORUN
     1      /Y/   TFP(21),   TFA(21)
     2      /F/  TFPT(21),  TFAT(21)
     2      /S/  TFPZ(21),  TFAZ(21)
     4      /C/        ZL,        DZ,        VP,        VA,        HP,
     5                 HA,       N20,       N21,        IP
C...
C...  DIMENSION THE ARRAYS FOR PLOTTING
      COMMON/PLOT/ TP(4,101), TIMEP(101)
C...
C...  LABEL THE NUMERICAL OUTPUT
      IF(T.LT.0.05)WRITE(NO,2)
2     FORMAT(9X,1HT,4X,8HTFP(0,T),3X,9HTFP(ZL,T),
     1              4X,8HTFA(0,T),3X,9HTFA(ZL,T))
C...
C...  PRINT THE NUMERICAL SOLUTION
      WRITE(NO,1)T,TFP(1),TFP(N21),TFA(1),TFA(N21)
1     FORMAT(F10.1,4F12.2)
C...
C...  STORE THE NUMERICAL SOLUTION FOR PLOTTING
      IP=IP+1
      TP(1,IP)=TFP(  1)
      TP(2,IP)=TFP(N21)
      TP(3,IP)=TFA(  1)
      TP(4,IP)=TFA(N21)
      TIMEP(IP)=T
C...
C...  PLOT THE INLET AND OUTLET TEMPERATURES AT THE END OF EACH RUN
      IF(IP.LT.101)RETURN
C...
C...  PLOT THE NUMERICAL SOLUTION
      CALL SPLOTS(4,IP,TIMEP,TP)
C...
C...  LABEL THE PLOT
      WRITE(NO,3)
3     FORMAT(1H ,/,' 1 - TFP( 0,T), 2 - TFP(ZL,T)',/,
     1             ' 3 - TFA( 0,T), 4 - TFA(ZL,T)')
      RETURN
      END
DYNAMICS OF A DOUBLE-PIPE HEAT EXCHANGER
0.        10.0      0.1
   42  100    1    1  REL 0.001
DYNAMICS OF A DOUBLE-PIPE HEAT EXCHANGER
0.        10.0      0.1
   42  100    1    1  REL 0.001
END OF RUNS
*APP FLOW44
      SUBROUTINE INITAL
C...
C...  LIQUID LEVEL DYNAMICS OF TWO TANKS WITH A LONG DISCHARGE LINE
C...
C...  IN THE TWO TANKS SHOWN IN THE DIAGRAM BELOW, THE INITIAL LIQUID
C...  LEVELS ARE H10 AND H20 BEFORE THE VALVE IS OPENED AND THE CAP
C...  AT THE END OF THE DISCHARGE LINE IS REMOVED.  THE DISCHARGE
C...  LINE IS OF LENGTH XL AND INSIDE DIAMETER DL. THE RESISTANCE IN THE
C...  LINE CONNECTING THE TWO TANKS IS NEGLIGIBLE COMPARED TO THAT OF
C...  VALVE.  THE PHYSICAL PROPERTIES OF THE LIQUID ARE CONSTANTS.
C...
C...  DEVELOP A MATHEMATICAL MODEL TO DETERMINE THE LIQUID LEVELS IN
C...  THE TWO TANKS AND THE FLOW RATE IN AND OUT OF THE SECOND TANK
C...  AS A FUNCTION OF TIME WHEN THE FLOW RATE INTO THE FIRST TANK IS
C...  A PRESCRIBED FUNCTION OF TIME, F0(T).  LIST ANY ASSUMPTIONS
C...  YOU MAKE WHILE DEVELOPING THE MODEL.
C...
C...           .......
C...                 . F0(T)
C...                 .
C...                 +
C...            .         .        .         .
C...            .         .        .         .
C...            .         .        .         .
C...       H1(T)...........   H2(T)...........
C...            .         .        .         .
C...            .         .        .         .
C...            .         .  F1(T) .         .
C...            .         .   . .  .         .  DISCHARGE LINE
C...            ................................................+ F2(T)
C...                          . .                    DL,XL
C...                         VALVE
C...
C...  SIMULATE THIS SYSTEM USING THE MATHEMATICAL MODEL, I.E., COMPUTE
C...  H1(T), H2(T) AND V(T).
C...
C...  TANKS 1 AND 2 INITIALLY CONTAIN WATER AT DEPTHS OF 5 METERS
C...  AND 2 METERS, RESPECTIVELY, AND THE WATER IN THE LINE IS
C...  INITIALLY AT REST.
C...
C...  THE SYSTEM PARAMETERS AND VARIABLES ARE
C...
C...     A1        CROSS SECTIONAL AREA OF TANK 1 (M**3)
C...
C...     A2        CROSS SECTIONAL AREA OF TANK 2 (M**3)
C...
C...     AL        LINE CROSS SECTIONAL AREA (M**2)
C...
C...     CV        VALVE CONSTANT (M**3/SEC-M**0.5)
C...
C...     XL        LINE LENGTH (M)
C...
C...     H1        HEIGHT OF LIQUID IN TANK 1 (M)
C...
C...     H2        HEIGHT OF LIQUID IN TANK 2 (M)
C...
C...     F0        ENTERING FLOW RATE (M**3/SEC)
C...
C...     V         VELOCITY OF FLOW THROUGH THE LINE (M/SEC)
C...
C...     T         TIME (SEC)
C...
C...     RHO       LIQUID DENSITY (KG/M**3)
C...
C...     Q         LIQUID VOLUMETRIC FLOW RATE (M**3/SEC)
C...
C...     G         ACCELERATION OF GRAVITY (M/SEC**2)
C...
C...     GC        CONVERSION FACTOR (KG-M/N-SEC**2)
C...
C...     FH        HYDROSTATIC FORCE (N)
C...
C...     FF        FRICTIONAL FORCE (N)
C...
C...     -DP       PRESSURE DROP IN THE LINE (N/M**2)
C...
C...     F         FRICTION FACTOR (DIMENSIONLESS)
C...
C...     DL        LINE DIAMETER (M)
C...
C...     VIS       FLUID VISCOSITY (KG/M-SEC)
C...
C...  THE FRICTION FACTOR IS A FUNCTION OF THE REYNOLDS NUMBER
C...
C...     F = 64/RE, RE LT 2000 (POISEUILLE*S LAW)
C...
C...     F = 0.184/RE**0.2, RE GT 2000
C...
C...     RE = DL*RHO*V/VIS
C...
C...  ASSUMING CONSTANT DENSITY, BY A MASS BALANCE ON THE FIRST TANK,
C...
C...     DH1/DT = (F0 - F1)/A1, H1(0) = H10
C...
C...  FOR THE VALVE,
C...
C...     F1 = CV*(H1 - H2)**0.5, H1 GT H2
C...
C...     F1 = -CV*(H2 - H1)**0.5, H2 GE H1
C...
C...  BY A MASS BALANCE FOR THE SECOND TANK,
C...
C...     DH2/DT = (F1 - V*AL)/A2, H2(0) = H20
C...
C...  BY A MASS BALANCE ON THE LINE,
C...
C...     D(XL*AL*RHO)/DT = 0 = AL*VL - AP*VR OR VL = VR = V
C...
C...  (THE AVERAGE VELOCITY AT ANY POINT IN THE LINE IS V).
C...
C...  BY A MOMENTUM BALANCE FOR THE LIQUID IN THE PIPE IN THE DIRECTION
C...  OF FLOW
C...
C...     D(XL*AL*RHO*V)/DT = (RHO*AL*VL)*VL - (RHO*AL*VR)*VR
C...
C...        + (RHO*G*H2)*AL - FF*V*ABS(V)*XL*RHO*AL/(2*DL), V(0) = V0
C...
C...  OR
C...
C...     DV/DT = G*H2/XL - FF*V*ABS(V)/(2*DL)
C...
C...  THE THREE DIFFERENTIAL EQUATIONS DEFINING DH1/DT, DH2/DT AND
C...  DV/DT CAN NOW BE INTEGRATED TO OBTAIN H1(T), H2(T) AND V(T).
C...
      COMMON/T/      T,  NSTOP,  NORUN
     1      /Y/     H1,     H2,      V
     2      /F/  DH1DT,  DH2DT,   DVDT
     3      /C/     DL,     AL,    RHO,    VIS,     RE,     FF,
     4              A1,     A2,     F0,     F1,     F2,      G,
     5              CV,     XL,     IP
C...
C...  SET THE MODEL PARAMETERS
      RHO=1000.
      VIS=0.001
      D1=3.
      D2=4.
      DL=25./100.
      XL=50.
      CV=1.0
      G=9.8
      F0=0.5
C...
C...  COMPUTE SOME CONSTANTS
      PI=3.1515927
      A1=PI*D1**2/4.
      A2=PI*D2**2/4.
      AL=PI*DL**2/4.
C...
C...  INITIAL CONDITIONS
      H1=5.0
      H2=2.0
      V =0.0
C...
C...  INITAL DERIVATIVES
      CALL DERV
      IP=0
      RETURN
      END
      SUBROUTINE DERV
      COMMON/T/      T,  NSTOP,  NORUN
     1      /Y/     H1,     H2,      V
     2      /F/  DH1DT,  DH2DT,   DVDT
     3      /C/     DL,     AL,    RHO,    VIS,     RE,     FF,
     4              A1,     A2,     F0,     F1,     F2,      G,
     5              CV,     XL,     IP
C...
C...  FRICTION FACTOR
      RE=(DL*ABS(V)*RHO)/VIS
      IF(RE.LT.0.1)THEN
         FF=0.
      ELSE IF((RE.GE.0.1).AND.(RE.LT.2000.))THEN
         FF=64.0/RE
      ELSE IF(RE.GE.2000.)THEN
         FF=0.184/RE**0.2
      END IF
C...
C...  VALVE
      IF(H1.GE.H2)F1= CV*SQRT(H1-H2)
      IF(H1.LT.H2)F1=-CV*SQRT(H2-H1)
C...
C...  FIRST TANK
      DH1DT=(F0-F1)/A1
C...
C...  SECOND TANK
      F2=AL*V
      DH2DT=(F1-F2)/A2
C...
C...  DISCHARGE LINE
      DVDT=G*H2/XL-FF*V*ABS(V)/(2.0*DL)
      RETURN
      END
      SUBROUTINE PRINT(NI,NO)
      COMMON/T/      T,  NSTOP,  NORUN
     1      /Y/     H1,     H2,      V
     2      /F/  DH1DT,  DH2DT,   DVDT
     3      /C/     DL,     AL,    RHO,    VIS,     RE,     FF,
     4              A1,     A2,     F0,     F1,     F2,      G,
     5              CV,     XL,     IP
C...
C...  DIMENSION THE ARRAYS FOR PLOTTING
      DIMENSION TP(51), HP(2,51), VP(51), FP(3,51), REP(51)
C...
C...  PRINT A HEADING FOR THE SOLUTION
      IP=IP+1
      IF(IP.EQ.1)WRITE(NO,1)
1     FORMAT(9X,'T',9X,'H1',9X,'H2',10X,'V',
     1       5X,'DH1/DT',5X,'DH2/DT',6X,'DV/DT')
C...
C...  PRINT THE SOLUTION EVERY FIFTH CALL TO SUBROUTINE PRINT
      IF(((IP-1)/5*5).EQ.(IP-1))THEN
      WRITE(NO,2)T,H1,H2,V,DH1DT,DH2DT,DVDT
2     FORMAT(F10.1,3F11.2,3F11.4)
      END IF
C...
C...  STORE THE SOLUTION FOR PLOTTING
C...
C...     LIQUID HEIGHTS
         HP(1,IP)=H1
         HP(2,IP)=H2
C...
C...     VELOCITY
         VP(IP)=V
C...
C...     FLOW RATES
         FP(1,IP)=F0
         FP(2,IP)=F1
         FP(3,IP)=F2
C...
C...     REYNOLDS NUMBER
         REP(IP)=RE
         TP(IP)=T
C...
C...  PLOT THE SOLUTIONS
      IF(IP.LT.51)RETURN
C...
C...     LIQUID HEIGHTS
         CALL SPLOTS(2,IP,TP,HP)
         WRITE(NO,10)
10       FORMAT(1H ,//,' 1 - H1, 2 - H2 VS T')
C...
C...     VELOCITY
         CALL SPLOTS(1,IP,TP,VP)
         WRITE(NO,11)
11       FORMAT(1H ,//,' V VS T')
C...
C...     FLOW RATES
         CALL SPLOTS(3,IP,TP,FP)
         WRITE(NO,12)
12       FORMAT(1H ,//,' 1 - F0, 2 - F1, 3 - F2 VS T')
C...
C...     REYNOLDS NUMBER
         CALL SPLOTS(1,IP,TP,REP)
         WRITE(NO,13)
13       FORMAT(1H ,//,' REYNOLDS NUMBER VS T')
C...
      RETURN
      END
TWO TANKS WITH A LONG DISCHARGE LINE
0.        2500.     50.
    3 1000    1    1  REL 0.001
END OF RUNS
