Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-09 - 43,50466/ecaptr.f4
There are no other files named ecaptr.f4 in the archive.
	SUBROUTINE ECA70
C
C	TRANSIENT MAINLINE
C
C
C	FOLLOWING ARE COMMON TO ALL SUBROUTINES (2141 WORDS)
C
	COMMON /MAIN1/AMPO(65),FLOW2(65),FLOW1(65),EO(65),BIAS2(65)
     1	,BIAS1(65),ERROR1,ICOLT(65),IROWT(65),IRTN,KTO,START,NSTEP
     2	,MODE1(65),FINISH,NH(65),NT(65),LINKS,NODES,NPRINT(10),NSWTCH
     3	,NTERMS,NTRACE,NUMBC,NUMBL,NUMBR,SHORT,Y(65),Y2(65),Y1(65)
     4	,LIST4(65),YTERM2(65),YTERM1(65),IDATA
C
C
C
C	FOLLOWING ARE COMMON TO ALL SUBROUTINES (2090 WORDS)
C	THESE DO NOT MATCHUP WORD FOR WORD IN ALL SUBROUTINES
C
	DOUBLE PRECISION B,V,VO
C
	COMMON /MAIN2/OPEN,LABEL(200),B(50),KE,KI,LOCKS,NLTRMS,
     1	DELTA,V(50),VO(50),LISTE(5),LISTI(5),
     2	NUME(5),NUMI(5),JSTEP(10),JSTEPS(10),JLINE(10),LINK1D(65),
     3	LINK1E(65),NREC,MAJOR,ERROR2,ERROR3,ETIME(5,2),ATIME(5,2),
     4	ETR(5,65),AMPTR(5,65),XXX(188)
C
C
C
C	FOLLOWING ARE USED INDIVIDUALLY BY LANG.,DC,AC,TR. (668 WORDS)
C
	DOUBLE PRECISION FLUX,VALUE
C
	COMMON /MAIN3/FLUX(65),VALUE(65),LEVER(65),LEVERS(65)
     1	,LINK1A(65),TTAU(10),ESLOPE(5),ASLOPE(5),HOLD,LEAST,
     2	LIST,LATCH,LOCK,LOCKA,LOCKB,LOCKD,LOCKF,LOCKG,MINOR,
     3	NUMBER,PARTS,SAVE,STEP,T,TEST,THIGH,TLOW,TSTAR,TZERO,
     4	UNIT,JX1,YYY(162)
C
C
C
C	FOLLOWING USED WHERE EVER NEEDED THROUGH OUT ECAP (5000 WORDS)
C
	DOUBLE PRECISION H(50,50)
C
	COMMON /MAIN4/H
C
C
C
C	FOLLOWING ARE FOR INPUT AND OUTPUT SUBROUTINES
C
C	IDLG-DIALOG INPUT DEV.
C	IRSP-DIALOG OUTPUT DEV.
C	NDEVI-INPUT DEV.
C	NDEVO-OUTPUT DEV.
C
	COMMON /IOBLK/IDLG,IRSP,NDEVI,NDEVO,IDVI,IDVO,ICODE,IBNK,NAMI(2)
	COMMON /IOBLKA/NAMO(2),IPJ,IPG,NCOPYS,ITYCH
C
C
	IDEV=1
    1 IF ( NTRACE ) 3, 4, 3
 2    FORMAT(' TRANSIENT MAINLINE-ECA70 ENTERED.' )
 3    WRITE(NDEVO, 2)
    4 CONTINUE
      NOMORE = 1
      SAVE = DELTA
      CALL SORT
      NREC = 0
      LOCK = 0
      JX1=0
       LOCKB = 1
       LOCKD = 2
      NSTEP=KE+KI
       LOCKF = 0
      CALL TVSET
      LATCH=1
      CALL IC
      CALL FLOW03
      LATCH=2
      CALL IC
      CALL CURRNT
      CALL MATRIX
      CALL PRINT3
      CALL REDUCE
      CALL SOLVE
      CALL CURRNT
      T=START
      TZERO=T
      CALL FLOWS
      IF ( LATCH ) 1900, 1900, 8710
 1900 CALL Y03
      CALL MATRIX
      CALL REDUCE
      NUMBER=0
      MINOR=NUMBER
       CALL PRINT1
      CALL PRINT2
      IF( LOCK ) 3300, 9999, 3300
 3000 GO TO ( 3100,3400,3400,3400,3300,3300),LOCK
 3100 LATCH = 1
      CALL IC
      LATCH=2
      CALL FLOW03
      LATCH = 2
      CALL IC
      DO 3125 K=1, NODES
      VO(K) = V(K)
 3125 V(K) = 0.0
      CALL CURRNT
      CALL MATRIX
      CALL REDUCE
      CALL SOLVE
      CALL CURRNT
      CALL FLOWS
      IF ( LATCH ) 3250, 3250, 8710
 3250 CALL Y03
      CALL MATRIX
      CALL REDUCE
      JX1=0
      CALL PRINT2
       GO TO 3400
 3300  GO TO (3800, 3400), LOCKD
 3800 CALL TVS
 3400 IF( ERROR3 - 1.0 ) 3430, 3410, 3410
 3410 GO TO ( 3420, 3500 ), LOCKB
 3420 LOCK = 6
      GO TO 3600
 3430 IF ( LOCK - 6 ) 3440, 3600, 3600
 3440 CALL MODIFY
       IF(LOCKF) 3450, 3450, 3425
 3425 CALL Y03
      CALL MATRIX
      CALL REDUCE
      LOCKF = 0
 3450 IF( LOCK - 5 ) 3480, 3500, 3600
 3480 NUMBER = MINOR
      T = T + DELTA
      GO TO 3804
 3500 NUMBER = MINOR
      GO TO 3700
 3600 TZERO = T
      MINOR=NUMBER
 3700 T = TZERO + SAVE
 3804 NUMBER = NUMBER + 1
      LOCKA=1
      LATCH=2
      CALL FLOW03
      DO 4000 K = 1, NODES
 4000 VO( K ) = V( K )
       GO TO (4500, 5000), LOCKD
 4500  LATCH = 1
       CALL CURVES
 5000 DO 5100 K = 1, NODES
 5100 V( K ) = 0.0
      CALL CURRNT
      CALL SOLVE
C
C
      CALL CURRNT
      CALL FLOWS
      IF(LATCH)5113,5113,8710
 5113 JX1=0
      IF(NSWTCH)5110,5110,5112
 5112 CALL SSWTCH(1,LAST)
      GO TO (5111,5110),LAST
 5111 CALL PRINT2
      JX1=1
C
C
 5110 IF ( LOCKS ) 7700, 7700, 7000
 7000 CALL SCAN
      IF ( LOCKG ) 7550, 7600, 7550
 7550 LATCH = 3
       CALL FLOW03
      CALL Y01
      CALL MATRIX
      CALL REDUCE
      GO TO ( 7560, 7600 ), LOCKD
 7560 LATCH = 2
      CALL CURVES
 7600 GO TO ( 7700, 5000, 5000, 5000, 7800 ), LOCKA
 7700 GO TO ( 8701, 3000, 3000, 3000, 8701, 8701 ), LOCK
 7800 GO TO ( 7910, 7920 ), LOCKB
 7910 CALL SWITCH
      GO TO ( 7912, 7917 ), LOCKB
 7912 GO TO ( 7915, 7917 ), LOCKD
 7915 CALL TVS
 7917 CALL PRINT2
      GO TO 7930
 7920 DELTA = SAVE
      LOCK = 6
 7925 LOCKB = 1
      CALL Y03
      CALL MATRIX
      CALL REDUCE
 7930 GO TO ( 8701, 3000 ), LOCKB
 8701 IF ( T - FINISH ) 8201, 8702, 8702
 8702 NOMORE=2
       IF(FINISH) 8703,8703,8400
 8703  WRITE(NDEVO,8704)
	WRITE(IDLG,8704)
 8704  FORMAT(///' FINAL TIME PARAMETER OMITTED, ONLY ONE TIME STEP CALC
     XULATED.')
      GO TO 8400
 8201 IF( NUMBER - MAJOR ) 3000, 8300, 8300
 8300 NUMBER=0
      IF ( LOCK-5 ) 8600, 8400, 8400
 8400 CALL PRINT2
 8600 GO TO ( 3000, 9999 ), NOMORE
 8710 WRITE(NDEVO, 8711 ) NREC
	WRITE(IDLG,8711) NREC
 8711 FORMAT(25H1TRANSIENT JOB TERMINATED//12H EXCESSIVE (I3,21H ) CURRE
     1NT UNBALANCES/1H1)
 9999 IF( NTRACE )9996,9996,9997
 9998 FORMAT(' ECA70 EXIT')
 9997 WRITE(NDEVO, 9998 )
 9996 RETURN
      END
	SUBROUTINE IC
C
C	FOLLOWING ARE COMMON TO ALL SUBROUTINES (2141 WORDS)
C
	COMMON /MAIN1/AMPO(65),FLOW2(65),FLOW1(65),EO(65),BIAS2(65)
     1	,BIAS1(65),ERROR1,ICOLT(65),IROWT(65),IRTN,KTO,START,NSTEP
     2	,MODE1(65),FINISH,NH(65),NT(65),LINKS,NODES,NPRINT(10),NSWTCH
     3	,NTERMS,NTRACE,NUMBC,NUMBL,NUMBR,SHORT,Y(65),Y2(65),Y1(65)
     4	,LIST4(65),YTERM2(65),YTERM1(65),IDATA
C
C
C
C	FOLLOWING ARE COMMON TO ALL SUBROUTINES (2090 WORDS)
C	THESE DO NOT MATCHUP WORD FOR WORD IN ALL SUBROUTINES
C
	DOUBLE PRECISION B,V,VO
C
	COMMON /MAIN2/OPEN,LABEL(200),B(50),KE,KI,LOCKS,NLTRMS,
     1	DELTA,V(50),VO(50),LISTE(5),LISTI(5),
     2	NUME(5),NUMI(5),JSTEP(10),JSTEPS(10),JLINE(10),LINK1D(65),
     3	LINK1E(65),NREC,MAJOR,ERROR2,ERROR3,ETIME(5,2),ATIME(5,2),
     4	ETR(5,65),AMPTR(5,65),XXX(188)
C
C
C
C	FOLLOWING ARE USED INDIVIDUALLY BY LANG.,DC,AC,TR. (668 WORDS)
C
	DOUBLE PRECISION FLUX,VALUE
C
	COMMON /MAIN3/FLUX(65),VALUE(65),LEVER(65),LEVERS(65)
     1	,LINK1A(65),TTAU(10),ESLOPE(5),ASLOPE(5),HOLD,LEAST,
     2	LIST,LATCH,LOCK,LOCKA,LOCKB,LOCKD,LOCKF,LOCKG,MINOR,
     3	NUMBER,PARTS,SAVE,STEP,T,TEST,THIGH,TLOW,TSTAR,TZERO,
     4	UNIT,JX1,YYY(162)
C
C
C
C	FOLLOWING USED WHERE EVER NEEDED THROUGH OUT ECAP (5000 WORDS)
C
	DOUBLE PRECISION H(50,50)
C
	COMMON /MAIN4/H
C
C
C
C	FOLLOWING ARE FOR INPUT AND OUTPUT SUBROUTINES
C
C	IDLG-DIALOG INPUT DEV.
C	IRSP-DIALOG OUTPUT DEV.
C	NDEVI-INPUT DEV.
C	NDEVO-OUTPUT DEV.
C
	COMMON /IOBLK/IDLG,IRSP,NDEVI,NDEVO,IDVI,IDVO,ICODE,IBNK,NAMI(2)
	COMMON /IOBLKA/NAMO(2),IPJ,IPG,NCOPYS,ITYCH
C
C
    1 IF ( NTRACE ) 3, 4, 3
    2 FORMAT ( 7H IC    , 10X, 7H NUMBC=, I4, 7H NUMBR=, I4,
     1   7H NUMBL=,I4 )
 3    WRITE(NDEVO, 2) NUMBC, NUMBR, NUMBL
    4 CONTINUE
      GO TO ( 1000, 5000 ), LATCH
 1000 IF( NUMBR ) 3000, 3000, 2000
 2000 INDEX = NUMBC
      DO 2500  I = 1, NUMBR
      INDEX = INDEX + 1
      LL = LINK1A( INDEX )
 2500 Y( LL ) = Y1( LL )
 3000 IF( NUMBC ) 5000, 5000, 4000
 4000 DO 4500   I= 1, NUMBC
      LL = LINK1A( I )
 4500 Y( LL ) = 1.0/SHORT
 5000 IF( NUMBL ) 9000, 9000, 6000
 6000 INDEX = NUMBC + NUMBR
      DO 8000  I = 1, NUMBL
      INDEX = INDEX + 1
      LL = LINK1A( INDEX )
      GO TO (6500,7000),LATCH
 6500 Y( LL ) = 0.0
      GO TO 8000
 7000 Y( LL ) = 1.0/OPEN
 8000 CONTINUE
 9000 RETURN
      END
	SUBROUTINE Y01
C
C	FOLLOWING ARE COMMON TO ALL SUBROUTINES (2141 WORDS)
C
	COMMON /MAIN1/AMPO(65),FLOW2(65),FLOW1(65),EO(65),BIAS2(65)
     1	,BIAS1(65),ERROR1,ICOLT(65),IROWT(65),IRTN,KTO,START,NSTEP
     2	,MODE1(65),FINISH,NH(65),NT(65),LINKS,NODES,NPRINT(10),NSWTCH
     3	,NTERMS,NTRACE,NUMBC,NUMBL,NUMBR,SHORT,Y(65),Y2(65),Y1(65)
     4	,LIST4(65),YTERM2(65),YTERM1(65),IDATA
C
C
C
C	FOLLOWING ARE COMMON TO ALL SUBROUTINES (2090 WORDS)
C	THESE DO NOT MATCHUP WORD FOR WORD IN ALL SUBROUTINES
C
	DOUBLE PRECISION B,V,VO
C
	COMMON /MAIN2/OPEN,LABEL(200),B(50),KE,KI,LOCKS,NLTRMS,
     1	DELTA,V(50),VO(50),LISTE(5),LISTI(5),
     2	NUME(5),NUMI(5),JSTEP(10),JSTEPS(10),JLINE(10),LINK1D(65),
     3	LINK1E(65),NREC,MAJOR,ERROR2,ERROR3,ETIME(5,2),ATIME(5,2),
     4	ETR(5,65),AMPTR(5,65),XXX(188)
C
C
C
C	FOLLOWING ARE USED INDIVIDUALLY BY LANG.,DC,AC,TR. (668 WORDS)
C
	DOUBLE PRECISION FLUX,VALUE
C
	COMMON /MAIN3/FLUX(65),VALUE(65),LEVER(65),LEVERS(65)
     1	,LINK1A(65),TTAU(10),ESLOPE(5),ASLOPE(5),HOLD,LEAST,
     2	LIST,LATCH,LOCK,LOCKA,LOCKB,LOCKD,LOCKF,LOCKG,MINOR,
     3	NUMBER,PARTS,SAVE,STEP,T,TEST,THIGH,TLOW,TSTAR,TZERO,
     4	UNIT,JX1,YYY(162)
C
C
C
C	FOLLOWING USED WHERE EVER NEEDED THROUGH OUT ECAP (5000 WORDS)
C
	DOUBLE PRECISION H(50,50)
C
	COMMON /MAIN4/H
C
C
C
C	FOLLOWING ARE FOR INPUT AND OUTPUT SUBROUTINES
C
C	IDLG-DIALOG INPUT DEV.
C	IRSP-DIALOG OUTPUT DEV.
C	NDEVI-INPUT DEV.
C	NDEVO-OUTPUT DEV.
C
	COMMON /IOBLK/IDLG,IRSP,NDEVI,NDEVO,IDVI,IDVO,ICODE,IBNK,NAMI(2)
	COMMON /IOBLKA/NAMO(2),IPJ,IPG,NCOPYS,ITYCH
C
C
    1 IF ( NTRACE ) 3, 4, 3
    2 FORMAT ( 7H Y01   , 10X, 7H NUMBC=, I4 )
 3    WRITE(NDEVO, 2) NUMBC
    4 CONTINUE
      IF( NUMBC ) 5000, 5000, 1000
 1000 DO 2000 I = 1, NUMBC
       LL = LINK1A(I)
 2000 Y( LL ) = Y1( LL ) / DELTA
C
C
 5000  RETURN
       END
	SUBROUTINE Y03
C
C	FOLLOWING ARE COMMON TO ALL SUBROUTINES (2141 WORDS)
C
	COMMON /MAIN1/AMPO(65),FLOW2(65),FLOW1(65),EO(65),BIAS2(65)
     1	,BIAS1(65),ERROR1,ICOLT(65),IROWT(65),IRTN,KTO,START,NSTEP
     2	,MODE1(65),FINISH,NH(65),NT(65),LINKS,NODES,NPRINT(10),NSWTCH
     3	,NTERMS,NTRACE,NUMBC,NUMBL,NUMBR,SHORT,Y(65),Y2(65),Y1(65)
     4	,LIST4(65),YTERM2(65),YTERM1(65),IDATA
C
C
C
C	FOLLOWING ARE COMMON TO ALL SUBROUTINES (2090 WORDS)
C	THESE DO NOT MATCHUP WORD FOR WORD IN ALL SUBROUTINES
C
	DOUBLE PRECISION B,V,VO
C
	COMMON /MAIN2/OPEN,LABEL(200),B(50),KE,KI,LOCKS,NLTRMS,
     1	DELTA,V(50),VO(50),LISTE(5),LISTI(5),
     2	NUME(5),NUMI(5),JSTEP(10),JSTEPS(10),JLINE(10),LINK1D(65),
     3	LINK1E(65),NREC,MAJOR,ERROR2,ERROR3,ETIME(5,2),ATIME(5,2),
     4	ETR(5,65),AMPTR(5,65),XXX(188)
C
C
C
C	FOLLOWING ARE USED INDIVIDUALLY BY LANG.,DC,AC,TR. (668 WORDS)
C
	DOUBLE PRECISION FLUX,VALUE
C
	COMMON /MAIN3/FLUX(65),VALUE(65),LEVER(65),LEVERS(65)
     1	,LINK1A(65),TTAU(10),ESLOPE(5),ASLOPE(5),HOLD,LEAST,
     2	LIST,LATCH,LOCK,LOCKA,LOCKB,LOCKD,LOCKF,LOCKG,MINOR,
     3	NUMBER,PARTS,SAVE,STEP,T,TEST,THIGH,TLOW,TSTAR,TZERO,
     4	UNIT,JX1,YYY(162)
C
C
C
C	FOLLOWING USED WHERE EVER NEEDED THROUGH OUT ECAP (5000 WORDS)
C
	DOUBLE PRECISION H(50,50)
C
	COMMON /MAIN4/H
C
C
C
C	FOLLOWING ARE FOR INPUT AND OUTPUT SUBROUTINES
C
C	IDLG-DIALOG INPUT DEV.
C	IRSP-DIALOG OUTPUT DEV.
C	NDEVI-INPUT DEV.
C	NDEVO-OUTPUT DEV.
C
	COMMON /IOBLK/IDLG,IRSP,NDEVI,NDEVO,IDVI,IDVO,ICODE,IBNK,NAMI(2)
	COMMON /IOBLKA/NAMO(2),IPJ,IPG,NCOPYS,ITYCH
C
C
    1 IF ( NTRACE ) 3, 4, 3
    2 FORMAT ( 7H Y03   ,10X,7H NUMBC=,I4,10X,7H NUMBL=,I4 )
 3    WRITE(NDEVO, 2) NUMBC, NUMBL
    4 CONTINUE
      IF ( NUMBC ) 5000, 5000, 1000
 1000 DO 2000 I = 1, NUMBC
      LL = LINK1A(I)
 2000 Y(LL) = Y1(LL) / DELTA
 5000 IF( NUMBL ) 9000, 9000, 6000
 6000 INDEX = NUMBC + NUMBR
      DO 7000 I = 1, NUMBL
       INDEX = INDEX + 1
       LL = LINK1A(INDEX)
 7000 Y( LL ) = Y1( LL ) * DELTA / 2.0
 9000 RETURN
C
C
       END
	SUBROUTINE MATRIX
C
C	FOLLOWING ARE COMMON TO ALL SUBROUTINES (2141 WORDS)
C
	COMMON /MAIN1/AMPO(65),FLOW2(65),FLOW1(65),EO(65),BIAS2(65)
     1	,BIAS1(65),ERROR1,ICOLT(65),IROWT(65),IRTN,KTO,START,NSTEP
     2	,MODE1(65),FINISH,NH(65),NT(65),LINKS,NODES,NPRINT(10),NSWTCH
     3	,NTERMS,NTRACE,NUMBC,NUMBL,NUMBR,SHORT,Y(65),Y2(65),Y1(65)
     4	,LIST4(65),YTERM2(65),YTERM1(65),IDATA
C
C
C
C	FOLLOWING ARE COMMON TO ALL SUBROUTINES (2090 WORDS)
C	THESE DO NOT MATCHUP WORD FOR WORD IN ALL SUBROUTINES
C
	DOUBLE PRECISION B,V,VO
C
	COMMON /MAIN2/OPEN,LABEL(200),B(50),KE,KI,LOCKS,NLTRMS,
     1	DELTA,V(50),VO(50),LISTE(5),LISTI(5),
     2	NUME(5),NUMI(5),JSTEP(10),JSTEPS(10),JLINE(10),LINK1D(65),
     3	LINK1E(65),NREC,MAJOR,ERROR2,ERROR3,ETIME(5,2),ATIME(5,2),
     4	ETR(5,65),AMPTR(5,65),XXX(188)
C
C
C
C	FOLLOWING ARE USED INDIVIDUALLY BY LANG.,DC,AC,TR. (668 WORDS)
C
	DOUBLE PRECISION FLUX,VALUE
C
	COMMON /MAIN3/FLUX(65),VALUE(65),LEVER(65),LEVERS(65)
     1	,LINK1A(65),TTAU(10),ESLOPE(5),ASLOPE(5),HOLD,LEAST,
     2	LIST,LATCH,LOCK,LOCKA,LOCKB,LOCKD,LOCKF,LOCKG,MINOR,
     3	NUMBER,PARTS,SAVE,STEP,T,TEST,THIGH,TLOW,TSTAR,TZERO,
     4	UNIT,JX1,YYY(162)
C
C
C
C	FOLLOWING USED WHERE EVER NEEDED THROUGH OUT ECAP (5000 WORDS)
C
	DOUBLE PRECISION H(50,50)
C
	COMMON /MAIN4/H
C
C
C
C	FOLLOWING ARE FOR INPUT AND OUTPUT SUBROUTINES
C
C	IDLG-DIALOG INPUT DEV.
C	IRSP-DIALOG OUTPUT DEV.
C	NDEVI-INPUT DEV.
C	NDEVO-OUTPUT DEV.
C
	COMMON /IOBLK/IDLG,IRSP,NDEVI,NDEVO,IDVI,IDVO,ICODE,IBNK,NAMI(2)
	COMMON /IOBLKA/NAMO(2),IPJ,IPG,NCOPYS,ITYCH
C
C
    1 IF ( NTRACE ) 3, 4, 3
    2 FORMAT ( 7H MATRIX )
 3    WRITE(NDEVO, 2)
    4 CONTINUE
C
       DO  1000  J=1,NODES
       DO  1000  I=1,NODES
 1000  H(I,J) = 0.0
C
      DO 5000 I = 1, LINKS
      J = NT( I )
      K = NH( I )
      IF ( J )2000,1500,2000
 1500 IF ( K )1600,5000,1600
 2000 IF ( K )3000,2500,3000
 2500 K = J
      GO TO 1600
 3000 H(J,J)=H(J,J)-Y(I)
      H(K,J)=H(K,J)+Y(I)
      H(J,K)=H(J,K)+Y(I)
 1600 H(K,K)=H(K,K)-Y(I)
 5000 CONTINUE
C
C
      IF ( NTERMS ) 7000, 7000, 5500
 5500 DO 6500 N=1,NTERMS
      LR = IROWT(N)
      LC = ICOLT(N)
      TERM = YTERM1( N ) * Y( LC ) / Y1( LC )
      I = NT(LR)
      IF ( I ) 6000, 6000, 5600
 5600 J = NH(LC)
      IF ( J ) 5800, 5800, 5700
 5700 H( I, J ) = H( I, J ) + TERM
 5800 J = NT(LC)
      IF ( J ) 6000, 6000, 5900
 5900 H( I, J ) = H( I, J ) - TERM
 6000 I = NH(LR)
      IF ( I ) 6500, 6500, 6100
 6100 J = NT(LC)
      IF ( J ) 6300, 6300, 6200
 6200 H( I, J ) = H( I, J ) + TERM
 6300 J = NH(LC)
      IF ( J ) 6500, 6500, 6400
 6400 H( I, J ) = H( I, J ) - TERM
 6500 CONTINUE
C
C
C
C
 7000 RETURN
       END
	SUBROUTINE REDUCE
C
C	FOLLOWING ARE COMMON TO ALL SUBROUTINES (2150 WORDS)
C
	COMMON /MAIN1/AMPO(65),FLOW2(65),FLOW1(65),EO(65),BIAS2(65)
     1	,BIAS1(65),ERROR1,ICOLT(65),IROWT(65),IRTN,KTO,START,NSTEP
     2	,MODE1(65),FINISH,NH(65),NT(65),LINKS,NODES,NPRINT(10),NSWTCH
     3	,NTERMS,NTRACE,NUMBC,NUMBL,NUMBR,SHORT,Y(65),Y2(65),Y1(65)
     4	,LIST4(65),YTERM2(65),YTERM1(65),IDATA
C
C
C
C	FOLLOWING ARE COMMON TO ALL SUBROUTINES (2090 WORDS)
C	THESE DO NOT MATCHUP WORD FOR WORD IN ALL SUBROUTINES
C
	DOUBLE PRECISION B,V,VO
C
	COMMON /MAIN2/OPEN,LABEL(200),B(50),KE,KI,LOCKS,NLTRMS,
     1	DELTA,V(50),VO(50),LISTE(5),LISTI(5),
     2	NUME(5),NUMI(5),JSTEP(10),JSTEPS(10),JLINE(10),LINK1D(65),
     3	LINK1E(65),NREC,MAJOR,ERROR2,ERROR3,ETIME(5,2),ATIME(5,2),
     4	ETR(5,65),AMPTR(5,65),XXX(188)
C
C
C
C	FOLLOWING ARE USED INDIVIDUALLY BY LANG.,DC,AC,TR. (668 WORDS)
C
	DOUBLE PRECISION FLUX,VALUE
C
	COMMON /MAIN3/FLUX(65),VALUE(65),LEVER(65),LEVERS(65)
     1	,LINK1A(65),TTAU(10),ESLOPE(5),ASLOPE(5),HOLD,LEAST,
     2	LIST,LATCH,LOCK,LOCKA,LOCKB,LOCKD,LOCKF,LOCKG,MINOR,
     3	NUMBER,PARTS,SAVE,STEP,T,TEST,THIGH,TLOW,TSTAR,TZERO,
     4	UNIT,JX1,YYY(162)
C
C
C
C	FOLLOWING USED WHERE EVER NEEDED THROUGH OUT ECAP (5000 WORDS)
C
	DOUBLE PRECISION H(50,50)
C
	COMMON /MAIN4/H
C
C
C
C	FOLLOWING ARE FOR INPUT AND OUTPUT SUBROUTINES
C
C	IDLG-DIALOG INPUT DEV.
C	IRSP-DIALOG OUTPUT DEV.
C	NDEVI-INPUT DEV.
C	NDEVO-OUTPUT DEV.
C
	COMMON /IOBLK/IDLG,IRSP,NDEVI,NDEVO,IDVI,IDVO,ICODE,IBNK,NAMI(2)
	COMMON /IOBLKA/NAMO(2),IPJ,IPG,NCOPYS,ITYCH
C
C
	DOUBLE PRECISION HZERO
    1 IF ( NTRACE ) 3, 4, 3
    2 FORMAT ( 7H REDUCE )
 3    WRITE(NDEVO, 2)
    4 CONTINUE
      IF( NODES - 1 ) 1000, 1000, 1500
 1000 H( 1, 1 ) = 1.0/H( 1, 1 )
      GO TO 9000
 1500 MINUS = NODES - 1
      I = 1
      M = 2
 2000 HZERO = H( I, I )
      H( I, I ) = 1.0
      DO 2500 J = 1, NODES
 2500 H( I, J ) = H( I, J ) / HZERO
      DO 6000 K = M, NODES
      IF( DABS(H(K,I))-1.0E-20)3000,3000,4000
 3000 H( K, I ) = 0.0
      GO TO 6000
 4000 HZERO = H( K, I )
      DO 5000 J = M, NODES
 5000 H( K, J ) = H( K, J ) - H( I, J ) * HZERO
 6000 CONTINUE
 7000 IF( I - MINUS ) 7500, 8000, 8000
 7500 I = I + 1
      M = I + 1
      GO TO 2000
 8000 HZERO = H( NODES, NODES )
      H( NODES, NODES ) = 1.0
      DO 8500 J = 1, NODES
 8500 H( NODES, J ) = H( NODES, J ) / HZERO
 9000 RETURN
      END
	SUBROUTINE MODIFY
C
C	FOLLOWING ARE COMMON TO ALL SUBROUTINES (2141 WORDS)
C
	COMMON /MAIN1/AMPO(65),FLOW2(65),FLOW1(65),EO(65),BIAS2(65)
     1	,BIAS1(65),ERROR1,ICOLT(65),IROWT(65),IRTN,KTO,START,NSTEP
     2	,MODE1(65),FINISH,NH(65),NT(65),LINKS,NODES,NPRINT(10),NSWTCH
     3	,NTERMS,NTRACE,NUMBC,NUMBL,NUMBR,SHORT,Y(65),Y2(65),Y1(65)
     4	,LIST4(65),YTERM2(65),YTERM1(65),IDATA
C
C
C
C	FOLLOWING ARE COMMON TO ALL SUBROUTINES (2090 WORDS)
C	THESE DO NOT MATCHUP WORD FOR WORD IN ALL SUBROUTINES
C
	DOUBLE PRECISION B,V,VO
C
	COMMON /MAIN2/OPEN,LABEL(200),B(50),KE,KI,LOCKS,NLTRMS,
     1	DELTA,V(50),VO(50),LISTE(5),LISTI(5),
     2	NUME(5),NUMI(5),JSTEP(10),JSTEPS(10),JLINE(10),LINK1D(65),
     3	LINK1E(65),NREC,MAJOR,ERROR2,ERROR3,ETIME(5,2),ATIME(5,2),
     4	ETR(5,65),AMPTR(5,65),XXX(188)
C
C
C
C	FOLLOWING ARE USED INDIVIDUALLY BY LANG.,DC,AC,TR. (668 WORDS)
C
	DOUBLE PRECISION FLUX,VALUE
C
	COMMON /MAIN3/FLUX(65),VALUE(65),LEVER(65),LEVERS(65)
     1	,LINK1A(65),TTAU(10),ESLOPE(5),ASLOPE(5),HOLD,LEAST,
     2	LIST,LATCH,LOCK,LOCKA,LOCKB,LOCKD,LOCKF,LOCKG,MINOR,
     3	NUMBER,PARTS,SAVE,STEP,T,TEST,THIGH,TLOW,TSTAR,TZERO,
     4	UNIT,JX1,YYY(162)
C
C
C
C	FOLLOWING USED WHERE EVER NEEDED THROUGH OUT ECAP (5000 WORDS)
C
	DOUBLE PRECISION H(50,50)
C
	COMMON /MAIN4/H
C
C
C
C	FOLLOWING ARE FOR INPUT AND OUTPUT SUBROUTINES
C
C	IDLG-DIALOG INPUT DEV.
C	IRSP-DIALOG OUTPUT DEV.
C	NDEVI-INPUT DEV.
C	NDEVO-OUTPUT DEV.
C
	COMMON /IOBLK/IDLG,IRSP,NDEVI,NDEVO,IDVI,IDVO,ICODE,IBNK,NAMI(2)
	COMMON /IOBLKA/NAMO(2),IPJ,IPG,NCOPYS,ITYCH
C
C
    1 IF ( NTRACE ) 3, 4, 3
    2 FORMAT ( 7H MODIFY, 10X, 7H LOCK= , I4, 7H LOCKB=, I4 )
 3    WRITE(NDEVO, 2)LOCK, LOCKB
    4 CONTINUE
      LOCKF = 0
      COEFF = 1.0 / ERROR3
      GO TO ( 2000, 4000, 5000, 6000, 7000, 9000 ), LOCK
 2000 LOCK=2
      LOCKB=1
      UNIT=DELTA
      PARTS = COEFF
 2250 PARTS =.3333333*(PARTS+PARTS+COEFF/(PARTS*PARTS))
      DIFF = PARTS*PARTS*PARTS/COEFF - 1.0
      IF ( ABS ( DIFF ) - 0.000001 ) 2500, 2500, 2250
 2500 DELTA = UNIT / COEFF
      GO TO 7500
 4000 LOCK=3
      DELTA = UNIT / ( PARTS * PARTS ) - UNIT / COEFF
      GO TO 7500
 5000 LOCK=4
      DELTA=UNIT/PARTS-UNIT/(PARTS*PARTS)
      GO TO 7500
 6000 LOCK=5
      DELTA=UNIT-UNIT/PARTS
      GO TO 7500
 7000 LOCK=6
      DELTA=SAVE
 7500 LOCKF = 1
 9000 RETURN
      END
	SUBROUTINE SWITCH
C
C	FOLLOWING ARE COMMON TO ALL SUBROUTINES (2141 WORDS)
C
	COMMON /MAIN1/AMPO(65),FLOW2(65),FLOW1(65),EO(65),BIAS2(65)
     1	,BIAS1(65),ERROR1,ICOLT(65),IROWT(65),IRTN,KTO,START,NSTEP
     2	,MODE1(65),FINISH,NH(65),NT(65),LINKS,NODES,NPRINT(10),NSWTCH
     3	,NTERMS,NTRACE,NUMBC,NUMBL,NUMBR,SHORT,Y(65),Y2(65),Y1(65)
     4	,LIST4(65),YTERM2(65),YTERM1(65),IDATA
C
C
C
C	FOLLOWING ARE COMMON TO ALL SUBROUTINES (2090 WORDS)
C	THESE DO NOT MATCHUP WORD FOR WORD IN ALL SUBROUTINES
C
	DOUBLE PRECISION B,V,VO
C
	COMMON /MAIN2/OPEN,LABEL(200),B(50),KE,KI,LOCKS,NLTRMS,
     1	DELTA,V(50),VO(50),LISTE(5),LISTI(5),
     2	NUME(5),NUMI(5),JSTEP(10),JSTEPS(10),JLINE(10),LINK1D(65),
     3	LINK1E(65),NREC,MAJOR,ERROR2,ERROR3,ETIME(5,2),ATIME(5,2),
     4	ETR(5,65),AMPTR(5,65),XXX(188)
C
C
C
C	FOLLOWING ARE USED INDIVIDUALLY BY LANG.,DC,AC,TR. (668 WORDS)
C
	DOUBLE PRECISION FLUX,VALUE
C
	COMMON /MAIN3/FLUX(65),VALUE(65),LEVER(65),LEVERS(65)
     1	,LINK1A(65),TTAU(10),ESLOPE(5),ASLOPE(5),HOLD,LEAST,
     2	LIST,LATCH,LOCK,LOCKA,LOCKB,LOCKD,LOCKF,LOCKG,MINOR,
     3	NUMBER,PARTS,SAVE,STEP,T,TEST,THIGH,TLOW,TSTAR,TZERO,
     4	UNIT,JX1,YYY(162)
C
C
C
C	FOLLOWING USED WHERE EVER NEEDED THROUGH OUT ECAP (5000 WORDS)
C
	DOUBLE PRECISION H(50,50)
C
	COMMON /MAIN4/H
C
C
C
C	FOLLOWING ARE FOR INPUT AND OUTPUT SUBROUTINES
C
C	IDLG-DIALOG INPUT DEV.
C	IRSP-DIALOG OUTPUT DEV.
C	NDEVI-INPUT DEV.
C	NDEVO-OUTPUT DEV.
C
	COMMON /IOBLK/IDLG,IRSP,NDEVI,NDEVO,IDVI,IDVO,ICODE,IBNK,NAMI(2)
	COMMON /IOBLKA/NAMO(2),IPJ,IPG,NCOPYS,ITYCH
C
C
    1 IF ( NTRACE ) 3, 4, 3
    2 FORMAT( 7H SWITCH, 10X, 7H LOCKB=, I4, 7H LIST= , I4 )
 3    WRITE(NDEVO, 2)LOCKB, LIST
    4 CONTINUE
 1000 LOCKB = 2
      IF ( LIST ) 9000, 9000, 2000
 2000 DO 4000 M=1,LIST
      N=LEVER(M)
       LASTC = 0
       DO  3000  I=1,N
 3000  LASTC = LASTC + LIST4(I)
       LASTB = LASTC - LIST4(N) + 1
       DO  4000  I=LASTB,LASTC
       L = LINK1E(I)
      TRADE=BIAS1(L)
      BIAS1(L)=BIAS2(L)
      BIAS2(L)=TRADE
      TRADE=FLOW1(L)
      FLOW1(L)=FLOW2(L)
      FLOW2(L)=TRADE
      TRADE=Y1(L)
      Y1(L)=Y2(L)
      Y2(L)=TRADE
       IF(NTERMS) 4000, 4000, 3700
 3700 DO 3900 J = 1, NTERMS
      IF ( L-ICOLT(J) ) 3900, 3800, 3900
 3800 TRADE = YTERM1(J)
      YTERM1(J) = YTERM2(J)
      YTERM2(J) = TRADE
 3900 CONTINUE
 4000 CONTINUE
      RATIO = ( T - TSTAR ) / SAVE
      IF ( RATIO - 0.5 ) 5100, 5400, 5400
 5100 IF ( RATIO - ERROR2 ) 5300, 5300, 5000
 5300 T = TSTAR
      LOCKF = - 1
      GO TO 9000
 5400 IF ( 1.0 - RATIO - ERROR2 ) 5500, 5500, 5000
 5500 T = TSTAR + SAVE
      DELTA = SAVE
      TZERO = T
      MINOR = NUMBER
      LOCKB = 1
      IF ( NUMBER - MAJOR ) 5000, 5700, 5700
 5700 NUMBER = 0
      MINOR = 0
 5000 LOCKF = 1
 9000 RETURN
      END
	SUBROUTINE SCAN
C
C	FOLLOWING ARE COMMON TO ALL SUBROUTINES (2141 WORDS)
C
	COMMON /MAIN1/AMPO(65),FLOW2(65),FLOW1(65),EO(65),BIAS2(65)
     1	,BIAS1(65),ERROR1,ICOLT(65),IROWT(65),IRTN,KTO,START,NSTEP
     2	,MODE1(65),FINISH,NH(65),NT(65),LINKS,NODES,NPRINT(10),NSWTCH
     3	,NTERMS,NTRACE,NUMBC,NUMBL,NUMBR,SHORT,Y(65),Y2(65),Y1(65)
     4	,LIST4(65),YTERM2(65),YTERM1(65),IDATA
C
C
C
C	FOLLOWING ARE COMMON TO ALL SUBROUTINES (2090 WORDS)
C	THESE DO NOT MATCHUP WORD FOR WORD IN ALL SUBROUTINES
C
	DOUBLE PRECISION B,V,VO
C
	COMMON /MAIN2/OPEN,LABEL(200),B(50),KE,KI,LOCKS,NLTRMS,
     1	DELTA,V(50),VO(50),LISTE(5),LISTI(5),
     2	NUME(5),NUMI(5),JSTEP(10),JSTEPS(10),JLINE(10),LINK1D(65),
     3	LINK1E(65),NREC,MAJOR,ERROR2,ERROR3,ETIME(5,2),ATIME(5,2),
     4	ETR(5,65),AMPTR(5,65),XXX(188)
C
C
C
C	FOLLOWING ARE USED INDIVIDUALLY BY LANG.,DC,AC,TR. (668 WORDS)
C
	DOUBLE PRECISION FLUX,VALUE
C
	COMMON /MAIN3/FLUX(65),VALUE(65),LEVER(65),LEVERS(65)
     1	,LINK1A(65),TTAU(10),ESLOPE(5),ASLOPE(5),HOLD,LEAST,
     2	LIST,LATCH,LOCK,LOCKA,LOCKB,LOCKD,LOCKF,LOCKG,MINOR,
     3	NUMBER,PARTS,SAVE,STEP,T,TEST,THIGH,TLOW,TSTAR,TZERO,
     4	UNIT,JX1,YYY(162)
C
C
C
C	FOLLOWING USED WHERE EVER NEEDED THROUGH OUT ECAP (5000 WORDS)
C
	DOUBLE PRECISION H(50,50)
C
	COMMON /MAIN4/H
C
C
C
C	FOLLOWING ARE FOR INPUT AND OUTPUT SUBROUTINES
C
C	IDLG-DIALOG INPUT DEV.
C	IRSP-DIALOG OUTPUT DEV.
C	NDEVI-INPUT DEV.
C	NDEVO-OUTPUT DEV.
C
	COMMON /IOBLK/IDLG,IRSP,NDEVI,NDEVO,IDVI,IDVO,ICODE,IBNK,NAMI(2)
	COMMON /IOBLKA/NAMO(2),IPJ,IPG,NCOPYS,ITYCH
C
C
    1 IF ( NTRACE ) 3, 4, 3
    2 FORMAT ( 7H SCAN  , 10X, 7H LOCKS=, I4, 7H LOCKA=, I4, 7H LOCKB=,
     1   I4 )
    3 WRITE(NDEVO,2)LOCKS,LOCKA,LOCKB
    4 CONTINUE
      LOCKG = 0
      STEP = DELTA
      GO TO ( 1000, 2000, 5000, 2000, 9000 ), LOCKA
 1000 TSTAR = T - DELTA
      TLOW = 0.0
      HOLD = SAVE - ( T - STEP - TZERO )
      LEAST = 0
      IF ( ERROR2 - 0.01001 ) 1200, 1200, 1500
 1200 TEST = 1.001*ERROR2
      GO TO 2000
 1500 TEST = 0.01001
C
C
C
 2000 LIST = 0
      DO 2500 N = 1, LOCKS
      LEVER( N ) = 0
      LL = LINK1D( N )
      LATCH = LABEL( N )
      GO TO ( 2100, 2200 ), LATCH
 2100 IF( FLUX( LL )) 2500, 2400, 2400
 2200 IF( FLUX( LL )) 2400, 2400, 2500
 2400 LIST = LIST + 1
      LEVER( LIST ) = N
 2500 CONTINUE
      GO TO ( 2600, 3000, 3000, 3000 ), LOCKA
 2600 IF( LIST - 1 ) 8000, 2800, 2800
 2800 LOCKB = 1
C
C
 3000 IF( LIST - 1 ) 3400, 3300, 3100
C
C
 3100 LOCKA = 2
      LEAST = LIST
      DO 3200 I = 1, LIST
 3200 LEVERS( I ) = LEVER( I )
      THIGH = STEP
      GO TO 4000
C
C
 3300 LOCKA = 3
      LEAST = 1
      LEVERS( 1 ) = LEVER( 1 )
      THIGH = STEP
      GO TO 6000
C
C
 3400 LOCKA = 4
      TLOW = STEP
C
C
C
 4000 SPAN = THIGH - TLOW
      RATIO = SPAN / SAVE
      IF( RATIO - TEST ) 8000, 8000, 4500
C
C
 4500 DELTA = 0.5 * ( THIGH + TLOW )
      T = TSTAR + DELTA
      GO TO 7000
C
C
 5000 N = LEVERS( 1 )
      LL = LINK1D( N )
      LATCH = LABEL( N )
      GO TO ( 5100, 5200 ), LATCH
 5100 IF( FLUX( LL )) 5600, 8000, 5800
 5200 IF( FLUX( LL )) 5800, 8000, 5600
 5600 TLOW = STEP
      GO TO 6000
 5800 THIGH = STEP
C
C
 6000 SPAN = THIGH - TLOW
      DELTA = 0.5 * ( THIGH + TLOW )
      RATIO = SPAN / SAVE
      IF( RATIO - ERROR2 * 1.001 ) 8000, 8000, 6600
 6600 T = TSTAR + DELTA
C
C
C
 7000 LOCKG = 1
      GO TO 9000
C
C
 8000 GO TO ( 8100, 8500 ), LOCKB
 8100 LIST = LEAST
      IF( LIST - 1 ) 9000, 8200, 8200
 8200 DO 8400 I = 1, LIST
 8400 LEVER( I ) = LEVERS( I )
C
 8500 LOCKA = 5
C
C
C
 9000 RETURN
      END
	SUBROUTINE FLOW03
C
C	FOLLOWING ARE COMMON TO ALL SUBROUTINES (2141 WORDS)
C
	COMMON /MAIN1/AMPO(65),FLOW2(65),FLOW1(65),EO(65),BIAS2(65)
     1	,BIAS1(65),ERROR1,ICOLT(65),IROWT(65),IRTN,KTO,START,NSTEP
     2	,MODE1(65),FINISH,NH(65),NT(65),LINKS,NODES,NPRINT(10),NSWTCH
     3	,NTERMS,NTRACE,NUMBC,NUMBL,NUMBR,SHORT,Y(65),Y2(65),Y1(65)
     4	,LIST4(65),YTERM2(65),YTERM1(65),IDATA
C
C
C
C	FOLLOWING ARE COMMON TO ALL SUBROUTINES (2090 WORDS)
C	THESE DO NOT MATCHUP WORD FOR WORD IN ALL SUBROUTINES
C
	DOUBLE PRECISION B,V,VO
C
	COMMON /MAIN2/OPEN,LABEL(200),B(50),KE,KI,LOCKS,NLTRMS,
     1	DELTA,V(50),VO(50),LISTE(5),LISTI(5),
     2	NUME(5),NUMI(5),JSTEP(10),JSTEPS(10),JLINE(10),LINK1D(65),
     3	LINK1E(65),NREC,MAJOR,ERROR2,ERROR3,ETIME(5,2),ATIME(5,2),
     4	ETR(5,65),AMPTR(5,65),XXX(188)
C
C
C
C	FOLLOWING ARE USED INDIVIDUALLY BY LANG.,DC,AC,TR. (668 WORDS)
C
	DOUBLE PRECISION FLUX,VALUE
C
	COMMON /MAIN3/FLUX(65),VALUE(65),LEVER(65),LEVERS(65)
     1	,LINK1A(65),TTAU(10),ESLOPE(5),ASLOPE(5),HOLD,LEAST,
     2	LIST,LATCH,LOCK,LOCKA,LOCKB,LOCKD,LOCKF,LOCKG,MINOR,
     3	NUMBER,PARTS,SAVE,STEP,T,TEST,THIGH,TLOW,TSTAR,TZERO,
     4	UNIT,JX1,YYY(162)
C
C
C
C	FOLLOWING USED WHERE EVER NEEDED THROUGH OUT ECAP (5000 WORDS)
C
	DOUBLE PRECISION H(50,50)
C
	COMMON /MAIN4/H
C
C
C
C	FOLLOWING ARE FOR INPUT AND OUTPUT SUBROUTINES
C
C	IDLG-DIALOG INPUT DEV.
C	IRSP-DIALOG OUTPUT DEV.
C	NDEVI-INPUT DEV.
C	NDEVO-OUTPUT DEV.
C
	COMMON /IOBLK/IDLG,IRSP,NDEVI,NDEVO,IDVI,IDVO,ICODE,IBNK,NAMI(2)
	COMMON /IOBLKA/NAMO(2),IPJ,IPG,NCOPYS,ITYCH
C
C
      DOUBLE PRECISION VI, VOI, VJ, VOJ
C
    1 IF ( NTRACE ) 3, 4, 3
    2 FORMAT ( 7H FLOW03, 10X, 7H NUMBL=, I4, 7H LATCH=, I4 )
 3    WRITE(NDEVO, 2)NUMBL,LATCH
    4 CONTINUE
      IF( NUMBL ) 9000, 9000, 1000
 1000 GO TO (1095,1050,1095),LATCH
 1050 IF(NTERMS)1075,1075,1080
 1080 DO 1090 I=1,NTERMS
      LL=IROWT(I)
      IF(MODE1(LL)-3)1090,1085,1090
 1085 L=ICOLT(I)
      FLUX(LL)=FLUX(LL)-FLUX(L)*YTERM1(I)/Y1(L)
 1090 CONTINUE
 1075 LATCH=1
C
 1095 INDEX=NUMBC+NUMBR
      DO 8000 I = 1, NUMBL
       INDEX = INDEX + 1
       LL = LINK1A(INDEX)
      II = NT(LL)
      IF( II ) 1100, 1100, 1150
 1150 VI = V(II)
      VOI = VO(II)
      GO TO 1200
 1100 VI = 0.0
      VOI = 0.0
 1200 JJ = NH(LL)
      IF( JJ ) 1300, 1300, 1350
 1350 VJ = V(JJ)
      VOJ = VO(JJ)
      GO TO 1400
 1300 VJ = 0.0
      VOJ = 0.0
 1400 GO TO (3000,9000,5000),LATCH
 3000 VALUE(LL) = FLUX(LL) + Y(LL) * (VI - VJ + BIAS1(LL))
      GO TO 8000
 5000 VALUE(LL) = VALUE(LL) - Y(LL) * ( VOI - VOJ + BIAS1(LL))
      Y( LL ) = Y( LL ) * ( DELTA / STEP )
      VALUE(LL) = VALUE(LL) + Y(LL) * ( VOI - VOJ + BIAS1(LL))
 8000  CONTINUE
C
C
 9000  RETURN
       END
	SUBROUTINE CURRNT
C
C	FOLLOWING ARE COMMON TO ALL SUBROUTINES (2141 WORDS)
C
	COMMON /MAIN1/AMPO(65),FLOW2(65),FLOW1(65),EO(65),BIAS2(65)
     1	,BIAS1(65),ERROR1,ICOLT(65),IROWT(65),IRTN,KTO,START,NSTEP
     2	,MODE1(65),FINISH,NH(65),NT(65),LINKS,NODES,NPRINT(10),NSWTCH
     3	,NTERMS,NTRACE,NUMBC,NUMBL,NUMBR,SHORT,Y(65),Y2(65),Y1(65)
     4	,LIST4(65),YTERM2(65),YTERM1(65),IDATA
C
C
C
C	FOLLOWING ARE COMMON TO ALL SUBROUTINES (2090 WORDS)
C	THESE DO NOT MATCHUP WORD FOR WORD IN ALL SUBROUTINES
C
	DOUBLE PRECISION B,V,VO
C
	COMMON /MAIN2/OPEN,LABEL(200),B(50),KE,KI,LOCKS,NLTRMS,
     1	DELTA,V(50),VO(50),LISTE(5),LISTI(5),
     2	NUME(5),NUMI(5),JSTEP(10),JSTEPS(10),JLINE(10),LINK1D(65),
     3	LINK1E(65),NREC,MAJOR,ERROR2,ERROR3,ETIME(5,2),ATIME(5,2),
     4	ETR(5,65),AMPTR(5,65),XXX(188)
C
C
C
C	FOLLOWING ARE USED INDIVIDUALLY BY LANG.,DC,AC,TR. (668 WORDS)
C
	DOUBLE PRECISION FLUX,VALUE
C
	COMMON /MAIN3/FLUX(65),VALUE(65),LEVER(65),LEVERS(65)
     1	,LINK1A(65),TTAU(10),ESLOPE(5),ASLOPE(5),HOLD,LEAST,
     2	LIST,LATCH,LOCK,LOCKA,LOCKB,LOCKD,LOCKF,LOCKG,MINOR,
     3	NUMBER,PARTS,SAVE,STEP,T,TEST,THIGH,TLOW,TSTAR,TZERO,
     4	UNIT,JX1,YYY(162)
C
C
C
C	FOLLOWING USED WHERE EVER NEEDED THROUGH OUT ECAP (5000 WORDS)
C
	DOUBLE PRECISION H(50,50)
C
	COMMON /MAIN4/H
C
C
C
C	FOLLOWING ARE FOR INPUT AND OUTPUT SUBROUTINES
C
C	IDLG-DIALOG INPUT DEV.
C	IRSP-DIALOG OUTPUT DEV.
C	NDEVI-INPUT DEV.
C	NDEVO-OUTPUT DEV.
C
	COMMON /IOBLK/IDLG,IRSP,NDEVI,NDEVO,IDVI,IDVO,ICODE,IBNK,NAMI(2)
	COMMON /IOBLKA/NAMO(2),IPJ,IPG,NCOPYS,ITYCH
C
C
      DOUBLE PRECISION VI, VOI, VJ, VOJ
C
C
    1 IF ( NTRACE ) 3, 4, 3
    2 FORMAT ( 7H CURRNT )
 3    WRITE(NDEVO, 2)
    4 CONTINUE
C
      DO 4000 LL = 1, LINKS
      II = NT( LL )
      IF ( II ) 1201, 1201, 1202
 1201 VI = 0.0
      VOI = 0.0
      GO TO 1200
 1202 VI = V( II )
      VOI = VO( II )
 1200 JJ = NH( LL )
      IF ( JJ ) 1401, 1401, 1402
 1401 VJ = 0.0
      VOJ = 0.0
      GO TO 1400
 1402 VJ = V( JJ )
      VOJ = VO( JJ )
 1400 MODE = MODE1( LL )
      GO TO ( 1000, 2000, 2000 ), MODE
 1000 IF( LOCK ) 1500, 2000, 1500
 1500 FLUX( LL ) = Y( LL ) * ( VI - VJ - VOI + VOJ )
      GO TO 4000
 2000 FLUX( LL ) = Y( LL ) * ( VI - VJ + BIAS1( LL ))
      GO TO (4100, 4000, 3000 ), MODE
 3000 FLUX( LL ) = FLUX( LL ) + VALUE( LL )
      GO TO 4000
 4100 FLUX( LL ) = FLUX( LL ) + Y( LL ) * EO( LL )
 4000 CONTINUE
      GO TO ( 4500, 7400 ), LOCKD
 4500 IF(LOCK)4600,7400,4600
 4600 DO 7000 I = 1, 5
      IF( LISTE( I )) 7400, 7400, 6000
 6000 LL = LISTE( I )
      IF( MODE1( LL ) - 1 ) 7000, 6500, 7000
 6500 FLUX( LL ) = FLUX( LL ) + Y1( LL ) * ESLOPE( I )
 7000 CONTINUE
 7400 IF( NTERMS ) 9000, 9000, 7500
 7500 DO 8000 I = 1, NTERMS
      L = ICOLT( I )
      LL = IROWT( I )
 8000 FLUX( LL ) = FLUX( LL ) + FLUX( L ) * YTERM1( I ) / Y1( L )
 9000 DO 9100 K = 1, NODES
 9100 B( K ) = 0.0
      DO 9500 LL = 1, LINKS
      II = NH(LL)
      JJ = NT(LL)
      IF ( II ) 9300, 9300, 9200
 9200 B( II ) = B( II ) - FLUX( LL ) + FLOW1( LL )
 9300 IF ( JJ ) 9500, 9500, 9400
 9400 B( JJ ) = B( JJ ) + FLUX( LL ) - FLOW1( LL )
 9500 CONTINUE
 9900 RETURN
C
C
       END
	SUBROUTINE SOLVE
C
C	FOLLOWING ARE COMMON TO ALL SUBROUTINES (2141 WORDS)
C
	COMMON /MAIN1/AMPO(65),FLOW2(65),FLOW1(65),EO(65),BIAS2(65)
     1	,BIAS1(65),ERROR1,ICOLT(65),IROWT(65),IRTN,KTO,START,NSTEP
     2	,MODE1(65),FINISH,NH(65),NT(65),LINKS,NODES,NPRINT(10),NSWTCH
     3	,NTERMS,NTRACE,NUMBC,NUMBL,NUMBR,SHORT,Y(65),Y2(65),Y1(65)
     4	,LIST4(65),YTERM2(65),YTERM1(65),IDATA
C
C
C
C	FOLLOWING ARE COMMON TO ALL SUBROUTINES (2090 WORDS)
C	THESE DO NOT MATCHUP WORD FOR WORD IN ALL SUBROUTINES
C
	DOUBLE PRECISION B,V,VO
C
	COMMON /MAIN2/OPEN,LABEL(200),B(50),KE,KI,LOCKS,NLTRMS,
     1	DELTA,V(50),VO(50),LISTE(5),LISTI(5),
     2	NUME(5),NUMI(5),JSTEP(10),JSTEPS(10),JLINE(10),LINK1D(65),
     3	LINK1E(65),NREC,MAJOR,ERROR2,ERROR3,ETIME(5,2),ATIME(5,2),
     4	ETR(5,65),AMPTR(5,65),XXX(188)
C
C
C
C	FOLLOWING ARE USED INDIVIDUALLY BY LANG.,DC,AC,TR. (668 WORDS)
C
	DOUBLE PRECISION FLUX,VALUE
C
	COMMON /MAIN3/FLUX(65),VALUE(65),LEVER(65),LEVERS(65)
     1	,LINK1A(65),TTAU(10),ESLOPE(5),ASLOPE(5),HOLD,LEAST,
     2	LIST,LATCH,LOCK,LOCKA,LOCKB,LOCKD,LOCKF,LOCKG,MINOR,
     3	NUMBER,PARTS,SAVE,STEP,T,TEST,THIGH,TLOW,TSTAR,TZERO,
     4	UNIT,JX1,YYY(162)
C
C
C
C	FOLLOWING USED WHERE EVER NEEDED THROUGH OUT ECAP (5000 WORDS)
C
	DOUBLE PRECISION H(50,50)
C
	COMMON /MAIN4/H
C
C
C
C	FOLLOWING ARE FOR INPUT AND OUTPUT SUBROUTINES
C
C	IDLG-DIALOG INPUT DEV.
C	IRSP-DIALOG OUTPUT DEV.
C	NDEVI-INPUT DEV.
C	NDEVO-OUTPUT DEV.
C
	COMMON /IOBLK/IDLG,IRSP,NDEVI,NDEVO,IDVI,IDVO,ICODE,IBNK,NAMI(2)
	COMMON /IOBLKA/NAMO(2),IPJ,IPG,NCOPYS,ITYCH
C
C
	DOUBLE PRECISION SUM
    1 IF ( NTRACE ) 3, 4, 3
    2 FORMAT ( 7H SOLVE )
 3    WRITE(NDEVO, 2)
    4 CONTINUE
      B( 1 ) = B( 1 )*H( 1, 1 )
      IF ( NODES - 1 ) 1000, 1000, 2000
 1000 V( 1 ) = B( 1 )
      GO TO 9000
 2000 DO 3000 I = 2, NODES
      B( I ) = B( I )*H( I, I )
      LAST = I - 1
      DO 3000 K = 1, LAST
 3000 B( I ) = B( I ) - H( I, K )*B( K )
      V( NODES ) = B( NODES )
      DO 5000 I = 2, NODES
      K = NODES + 1 - I
      M = K + 1
      SUM = 0.0
      DO 4000 J = M, NODES
 4000 SUM = SUM + H( K, J )*V( J )
 5000 V( K ) = B( K ) - SUM
 9000 RETURN
      END
	SUBROUTINE FLOWS
C
C	FOLLOWING ARE COMMON TO ALL SUBROUTINES (2141 WORDS)
C
	COMMON /MAIN1/AMPO(65),FLOW2(65),FLOW1(65),EO(65),BIAS2(65)
     1	,BIAS1(65),ERROR1,ICOLT(65),IROWT(65),IRTN,KTO,START,NSTEP
     2	,MODE1(65),FINISH,NH(65),NT(65),LINKS,NODES,NPRINT(10),NSWTCH
     3	,NTERMS,NTRACE,NUMBC,NUMBL,NUMBR,SHORT,Y(65),Y2(65),Y1(65)
     4	,LIST4(65),YTERM2(65),YTERM1(65),IDATA
C
C
C
C	FOLLOWING ARE COMMON TO ALL SUBROUTINES (2090 WORDS)
C	THESE DO NOT MATCHUP WORD FOR WORD IN ALL SUBROUTINES
C
	DOUBLE PRECISION B,V,VO
C
	COMMON /MAIN2/OPEN,LABEL(200),B(50),KE,KI,LOCKS,NLTRMS,
     1	DELTA,V(50),VO(50),LISTE(5),LISTI(5),
     2	NUME(5),NUMI(5),JSTEP(10),JSTEPS(10),JLINE(10),LINK1D(65),
     3	LINK1E(65),NREC,MAJOR,ERROR2,ERROR3,ETIME(5,2),ATIME(5,2),
     4	ETR(5,65),AMPTR(5,65),XXX(188)
C
C
C
C	FOLLOWING ARE USED INDIVIDUALLY BY LANG.,DC,AC,TR. (668 WORDS)
C
	DOUBLE PRECISION FLUX,VALUE
C
	COMMON /MAIN3/FLUX(65),VALUE(65),LEVER(65),LEVERS(65)
     1	,LINK1A(65),TTAU(10),ESLOPE(5),ASLOPE(5),HOLD,LEAST,
     2	LIST,LATCH,LOCK,LOCKA,LOCKB,LOCKD,LOCKF,LOCKG,MINOR,
     3	NUMBER,PARTS,SAVE,STEP,T,TEST,THIGH,TLOW,TSTAR,TZERO,
     4	UNIT,JX1,YYY(162)
C
C
C
C	FOLLOWING USED WHERE EVER NEEDED THROUGH OUT ECAP (5000 WORDS)
C
	DOUBLE PRECISION H(50,50)
C
	COMMON /MAIN4/H
C
C
C
C	FOLLOWING ARE FOR INPUT AND OUTPUT SUBROUTINES
C
C	IDLG-DIALOG INPUT DEV.
C	IRSP-DIALOG OUTPUT DEV.
C	NDEVI-INPUT DEV.
C	NDEVO-OUTPUT DEV.
C
	COMMON /IOBLK/IDLG,IRSP,NDEVI,NDEVO,IDVI,IDVO,ICODE,IBNK,NAMI(2)
	COMMON /IOBLKA/NAMO(2),IPJ,IPG,NCOPYS,ITYCH
C
C
    1 IF ( NTRACE ) 3, 4, 3
    2 FORMAT ( 7H FLOWS )
 3    WRITE(NDEVO, 2)
    4 CONTINUE
C
C
      LATCH = 0
      SUM=0.
      DO 3000 K=1,NODES
 3000 SUM = SUM + DABS( B(K))
C
C
      IF(SUM-ERROR1) 9000, 9000, 7000
C
C
 7000 WRITE(NDEVO, 40) T
	WRITE(IDLG,40) T
 40   FORMAT(//' SOLUTION NOT OBTAINED TO DESIRED TOLERANCE',/,
     1  ' AT TIME = ',E16.7,///)
      DO  8000  K=1,NODES
      BB = - B( K )
 8000 WRITE(NDEVO, 50 ) K, BB
   50 FORMAT ( 10H NODE NO. I4,6X,21H CURRENT UNBALANCE = E11.4 )
      WRITE(NDEVO, 60 )
      NREC = NREC + 1
      IF ( NSWTCH ) 8400, 8400, 9000
 8400 IF ( NREC - 20 ) 9000, 9000, 8500
 8500 LATCH = 1
   60 FORMAT(///)
 9000 RETURN
      END
	SUBROUTINE SORT
C
C	FOLLOWING ARE COMMON TO ALL SUBROUTINES (2141 WORDS)
C
	COMMON /MAIN1/AMPO(65),FLOW2(65),FLOW1(65),EO(65),BIAS2(65)
     1	,BIAS1(65),ERROR1,ICOLT(65),IROWT(65),IRTN,KTO,START,NSTEP
     2	,MODE1(65),FINISH,NH(65),NT(65),LINKS,NODES,NPRINT(10),NSWTCH
     3	,NTERMS,NTRACE,NUMBC,NUMBL,NUMBR,SHORT,Y(65),Y2(65),Y1(65)
     4	,LIST4(65),YTERM2(65),YTERM1(65),IDATA
C
C
C
C	FOLLOWING ARE COMMON TO ALL SUBROUTINES (2090 WORDS)
C	THESE DO NOT MATCHUP WORD FOR WORD IN ALL SUBROUTINES
C
	DOUBLE PRECISION B,V,VO
C
	COMMON /MAIN2/OPEN,LABEL(200),B(50),KE,KI,LOCKS,NLTRMS,
     1	DELTA,V(50),VO(50),LISTE(5),LISTI(5),
     2	NUME(5),NUMI(5),JSTEP(10),JSTEPS(10),JLINE(10),LINK1D(65),
     3	LINK1E(65),NREC,MAJOR,ERROR2,ERROR3,ETIME(5,2),ATIME(5,2),
     4	ETR(5,65),AMPTR(5,65),XXX(188)
C
C
C
C	FOLLOWING ARE USED INDIVIDUALLY BY LANG.,DC,AC,TR. (668 WORDS)
C
	DOUBLE PRECISION FLUX,VALUE
C
	COMMON /MAIN3/FLUX(65),VALUE(65),LEVER(65),LEVERS(65)
     1	,LINK1A(65),TTAU(10),ESLOPE(5),ASLOPE(5),HOLD,LEAST,
     2	LIST,LATCH,LOCK,LOCKA,LOCKB,LOCKD,LOCKF,LOCKG,MINOR,
     3	NUMBER,PARTS,SAVE,STEP,T,TEST,THIGH,TLOW,TSTAR,TZERO,
     4	UNIT,JX1,YYY(162)
C
C
C
C	FOLLOWING USED WHERE EVER NEEDED THROUGH OUT ECAP (5000 WORDS)
C
	DOUBLE PRECISION H(50,50)
C
	COMMON /MAIN4/H
C
C
C
C	FOLLOWING ARE FOR INPUT AND OUTPUT SUBROUTINES
C
C	IDLG-DIALOG INPUT DEV.
C	IRSP-DIALOG OUTPUT DEV.
C	NDEVI-INPUT DEV.
C	NDEVO-OUTPUT DEV.
C
	COMMON /IOBLK/IDLG,IRSP,NDEVI,NDEVO,IDVI,IDVO,ICODE,IBNK,NAMI(2)
	COMMON /IOBLKA/NAMO(2),IPJ,IPG,NCOPYS,ITYCH
C
C
    1 IF ( NTRACE ) 3, 4, 3
    2 FORMAT ( 7H SORT  )
 3    WRITE(NDEVO, 2)
    4 CONTINUE
      LOCKG = 0
      DO 1000  K = 1, NODES
       V(K) = 0.0
 1000  VO(K) = 0.0
       DO  2000  LL=1,LINKS
 2000  FLUX(LL) = AMPO(LL)
       INDEX = 0
       DO  5000  M=1,3
       DO  5000  LL=1,LINKS
       IF(MODE1(LL)-M) 5000, 3000, 5000
 3000  INDEX = INDEX + 1
       LINK1A(INDEX) = LL
 5000  CONTINUE
      RETURN
      END
	SUBROUTINE UPDATE(IA,IB)
C
C	FOLLOWING ARE COMMON TO ALL SUBROUTINES (2141 WORDS)
C
	COMMON /MAIN1/AMPO(65),FLOW2(65),FLOW1(65),EO(65),BIAS2(65)
     1	,BIAS1(65),ERROR1,ICOLT(65),IROWT(65),IRTN,KTO,START,NSTEP
     2	,MODE1(65),FINISH,NH(65),NT(65),LINKS,NODES,NPRINT(10),NSWTCH
     3	,NTERMS,NTRACE,NUMBC,NUMBL,NUMBR,SHORT,Y(65),Y2(65),Y1(65)
     4	,LIST4(65),YTERM2(65),YTERM1(65),IDATA
C
C
C
C	FOLLOWING ARE COMMON TO ALL SUBROUTINES (2090 WORDS)
C	THESE DO NOT MATCHUP WORD FOR WORD IN ALL SUBROUTINES
C
	DOUBLE PRECISION B,V,VO
C
	COMMON /MAIN2/OPEN,LABEL(200),B(50),KE,KI,LOCKS,NLTRMS,
     1	DELTA,V(50),VO(50),LISTE(5),LISTI(5),
     2	NUME(5),NUMI(5),JSTEP(10),JSTEPS(10),JLINE(10),LINK1D(65),
     3	LINK1E(65),NREC,MAJOR,ERROR2,ERROR3,ETIME(5,2),ATIME(5,2),
     4	ETR(5,65),AMPTR(5,65),XXX(188)
C
C
C
C	FOLLOWING ARE USED INDIVIDUALLY BY LANG.,DC,AC,TR. (668 WORDS)
C
	DOUBLE PRECISION FLUX,VALUE
C
	COMMON /MAIN3/FLUX(65),VALUE(65),LEVER(65),LEVERS(65)
     1	,LINK1A(65),TTAU(10),ESLOPE(5),ASLOPE(5),HOLD,LEAST,
     2	LIST,LATCH,LOCK,LOCKA,LOCKB,LOCKD,LOCKF,LOCKG,MINOR,
     3	NUMBER,PARTS,SAVE,STEP,T,TEST,THIGH,TLOW,TSTAR,TZERO,
     4	UNIT,JX1,YYY(162)
C
C
C
C	FOLLOWING USED WHERE EVER NEEDED THROUGH OUT ECAP (5000 WORDS)
C
	DOUBLE PRECISION H(50,50)
C
	COMMON /MAIN4/H
C
C
C
C	FOLLOWING ARE FOR INPUT AND OUTPUT SUBROUTINES
C
C	IDLG-DIALOG INPUT DEV.
C	IRSP-DIALOG OUTPUT DEV.
C	NDEVI-INPUT DEV.
C	NDEVO-OUTPUT DEV.
C
	COMMON /IOBLK/IDLG,IRSP,NDEVI,NDEVO,IDVI,IDVO,ICODE,IBNK,NAMI(2)
	COMMON /IOBLKA/NAMO(2),IPJ,IPG,NCOPYS,ITYCH
C
C
    1 IF ( NTRACE ) 3, 4, 3
    2 FORMAT ( 7H UPDATE )
 3    WRITE(NDEVO, 2)
    4 CONTINUE
      GO TO ( 10, 20 ), IB
   10 JLINE( IA ) = JLINE( IA ) + 1
      LA = JLINE( IA )
      IF( OPEN/SHORT - 1.0 ) 3001,3001,1000
 1000 IF(LA-NUME(IA))2000,3000,9000
 2000 ESLOPE( IA ) = (ETR(IA,LA+1)-ETR(IA,LA))/TTAU(IA)
      GO TO 9000
 3000 IF ( ETIME( IA, 2 )) 3001, 3002, 3002
 3001 ESLOPE( IA ) = 0.0
      JSTEPS( IA ) = 0
      NSTEP = NSTEP - 1
      GO TO 9000
 3002 ESLOPE( IA ) = (ETR(IA, 1 ) - ETR( IA, LA ))/TTAU( IA )
      JLINE( IA ) = 0
      GO TO 9000
   20 IC = IA + 5
      JLINE( IC ) = JLINE( IC ) + 1
      LA = JLINE( IC )
      IF ( LA - NUMI( IA )) 7000, 8000, 9000
 7000 ASLOPE(IA)=(AMPTR(IA,LA+1)-AMPTR(IA,LA))/TTAU(IC)
      GO TO 9000
 8000 IF(ATIME(IA,2))8001,8002,8002
 8001 ASLOPE( IA ) = 0.0
      JSTEPS( IC ) = 0
      NSTEP = NSTEP - 1
      GO TO 9000
 8002 ASLOPE(IA)=(AMPTR(IA,1)-AMPTR(IA,LA))/TTAU(IC)
      JLINE( IC ) = 0
 9000 RETURN
      END
	SUBROUTINE CURVES
C
C	FOLLOWING ARE COMMON TO ALL SUBROUTINES (2141 WORDS)
C
	COMMON /MAIN1/AMPO(65),FLOW2(65),FLOW1(65),EO(65),BIAS2(65)
     1	,BIAS1(65),ERROR1,ICOLT(65),IROWT(65),IRTN,KTO,START,NSTEP
     2	,MODE1(65),FINISH,NH(65),NT(65),LINKS,NODES,NPRINT(10),NSWTCH
     3	,NTERMS,NTRACE,NUMBC,NUMBL,NUMBR,SHORT,Y(65),Y2(65),Y1(65)
     4	,LIST4(65),YTERM2(65),YTERM1(65),IDATA
C
C
C
C	FOLLOWING ARE COMMON TO ALL SUBROUTINES (2090 WORDS)
C	THESE DO NOT MATCHUP WORD FOR WORD IN ALL SUBROUTINES
C
	DOUBLE PRECISION B,V,VO
C
	COMMON /MAIN2/OPEN,LABEL(200),B(50),KE,KI,LOCKS,NLTRMS,
     1	DELTA,V(50),VO(50),LISTE(5),LISTI(5),
     2	NUME(5),NUMI(5),JSTEP(10),JSTEPS(10),JLINE(10),LINK1D(65),
     3	LINK1E(65),NREC,MAJOR,ERROR2,ERROR3,ETIME(5,2),ATIME(5,2),
     4	ETR(5,65),AMPTR(5,65),XXX(188)
C
C
C
C	FOLLOWING ARE USED INDIVIDUALLY BY LANG.,DC,AC,TR. (668 WORDS)
C
	DOUBLE PRECISION FLUX,VALUE
C
	COMMON /MAIN3/FLUX(65),VALUE(65),LEVER(65),LEVERS(65)
     1	,LINK1A(65),TTAU(10),ESLOPE(5),ASLOPE(5),HOLD,LEAST,
     2	LIST,LATCH,LOCK,LOCKA,LOCKB,LOCKD,LOCKF,LOCKG,MINOR,
     3	NUMBER,PARTS,SAVE,STEP,T,TEST,THIGH,TLOW,TSTAR,TZERO,
     4	UNIT,JX1,YYY(162)
C
C
C
C	FOLLOWING USED WHERE EVER NEEDED THROUGH OUT ECAP (5000 WORDS)
C
	DOUBLE PRECISION H(50,50)
C
	COMMON /MAIN4/H
C
C
C
C	FOLLOWING ARE FOR INPUT AND OUTPUT SUBROUTINES
C
C	IDLG-DIALOG INPUT DEV.
C	IRSP-DIALOG OUTPUT DEV.
C	NDEVI-INPUT DEV.
C	NDEVO-OUTPUT DEV.
C
	COMMON /IOBLK/IDLG,IRSP,NDEVI,NDEVO,IDVI,IDVO,ICODE,IBNK,NAMI(2)
	COMMON /IOBLKA/NAMO(2),IPJ,IPG,NCOPYS,ITYCH
C
C
    1 IF ( NTRACE ) 3, 4, 3
    2 FORMAT ( 7H CURVES, 10X, 7H LATCH=, I4 )
 3    WRITE(NDEVO, 2) LATCH
    4 CONTINUE
      IF(KE)5000,5000,1000
 1000 DO 4000 N=1,KE
      K=LISTE(N)
      GO TO ( 2000, 2500 ), LATCH
 2000 BIAS1(K)=BIAS1(K)+ESLOPE(N)*DELTA
      GO TO 3000
 2500 BIAS1(K)=BIAS1(K)+ESLOPE(N)*(DELTA-STEP)
 3000 BIAS2(K)=BIAS1(K)
 4000 CONTINUE
 5000 IF(KI)9000,9000,6000
 6000 DO 8000 N=1,KI
      K=LISTI(N)
      GO TO ( 7000, 7500 ), LATCH
 7000 FLOW1(K)=FLOW1(K)+ASLOPE(N)*DELTA
      GO TO 8000
 7500 FLOW1(K)=FLOW1(K)+ASLOPE(N)*(DELTA-STEP)
 8000 FLOW2(K)=FLOW1(K)
 9000 RETURN
      END
	SUBROUTINE PRINT1
C
C	FOLLOWING ARE COMMON TO ALL SUBROUTINES (2141 WORDS)
C
	COMMON /MAIN1/AMPO(65),FLOW2(65),FLOW1(65),EO(65),BIAS2(65)
     1	,BIAS1(65),ERROR1,ICOLT(65),IROWT(65),IRTN,KTO,START,NSTEP
     2	,MODE1(65),FINISH,NH(65),NT(65),LINKS,NODES,NPRINT(10),NSWTCH
     3	,NTERMS,NTRACE,NUMBC,NUMBL,NUMBR,SHORT,Y(65),Y2(65),Y1(65)
     4	,LIST4(65),YTERM2(65),YTERM1(65),IDATA
C
C
C
C	FOLLOWING ARE COMMON TO ALL SUBROUTINES (2090 WORDS)
C	THESE DO NOT MATCHUP WORD FOR WORD IN ALL SUBROUTINES
C
	DOUBLE PRECISION B,V,VO
C
	COMMON /MAIN2/OPEN,LABEL(200),B(50),KE,KI,LOCKS,NLTRMS,
     1	DELTA,V(50),VO(50),LISTE(5),LISTI(5),
     2	NUME(5),NUMI(5),JSTEP(10),JSTEPS(10),JLINE(10),LINK1D(65),
     3	LINK1E(65),NREC,MAJOR,ERROR2,ERROR3,ETIME(5,2),ATIME(5,2),
     4	ETR(5,65),AMPTR(5,65),XXX(188)
C
C
C
C	FOLLOWING ARE USED INDIVIDUALLY BY LANG.,DC,AC,TR. (668 WORDS)
C
	DOUBLE PRECISION FLUX,VALUE
C
	COMMON /MAIN3/FLUX(65),VALUE(65),LEVER(65),LEVERS(65)
     1	,LINK1A(65),TTAU(10),ESLOPE(5),ASLOPE(5),HOLD,LEAST,
     2	LIST,LATCH,LOCK,LOCKA,LOCKB,LOCKD,LOCKF,LOCKG,MINOR,
     3	NUMBER,PARTS,SAVE,STEP,T,TEST,THIGH,TLOW,TSTAR,TZERO,
     4	UNIT,JX1,YYY(162)
C
C
C
C	FOLLOWING USED WHERE EVER NEEDED THROUGH OUT ECAP (5000 WORDS)
C
	DOUBLE PRECISION H(50,50)
C
	COMMON /MAIN4/H
C
C
C
C	FOLLOWING ARE FOR INPUT AND OUTPUT SUBROUTINES
C
C	IDLG-DIALOG INPUT DEV.
C	IRSP-DIALOG OUTPUT DEV.
C	NDEVI-INPUT DEV.
C	NDEVO-OUTPUT DEV.
C
	COMMON /IOBLK/IDLG,IRSP,NDEVI,NDEVO,IDVI,IDVO,ICODE,IBNK,NAMI(2)
	COMMON /IOBLKA/NAMO(2),IPJ,IPG,NCOPYS,ITYCH
C
C
    1 IF( NTRACE ) 3, 4, 3
    2 FORMAT( 7H PRINT1 )
 3    WRITE(NDEVO, 2)
    4 IF( OPEN / SHORT - 1.0 ) 1500, 1500, 1000
 1000 LOCK = 1
      IF(NUMBC+NUMBL+NSTEP)1500,1500,9000
 1500 LOCK = 0
      NPR =  NPRINT ( 1 ) + NPRINT ( 2 )
      IF( NPR ) 9000, 9000, 1600
 1600 WRITE(NDEVO, 20 )
   20 FORMAT(///22H STEADY STATE SOLUTION//)
 9000 RETURN
      END
	SUBROUTINE PRINT2
C
C	FOLLOWING ARE COMMON TO ALL SUBROUTINES (2141 WORDS)
C
	COMMON /MAIN1/AMPO(65),FLOW2(65),FLOW1(65),EO(65),BIAS2(65)
     1	,BIAS1(65),ERROR1,ICOLT(65),IROWT(65),IRTN,KTO,START,NSTEP
     2	,MODE1(65),FINISH,NH(65),NT(65),LINKS,NODES,NPRINT(10),NSWTCH
     3	,NTERMS,NTRACE,NUMBC,NUMBL,NUMBR,SHORT,Y(65),Y2(65),Y1(65)
     4	,LIST4(65),YTERM2(65),YTERM1(65),IDATA
C
C
C
C	FOLLOWING ARE COMMON TO ALL SUBROUTINES (2090 WORDS)
C	THESE DO NOT MATCHUP WORD FOR WORD IN ALL SUBROUTINES
C
	DOUBLE PRECISION B,V,VO
C
	COMMON /MAIN2/OPEN,LABEL(200),B(50),KE,KI,LOCKS,NLTRMS,
     1	DELTA,V(50),VO(50),LISTE(5),LISTI(5),
     2	NUME(5),NUMI(5),JSTEP(10),JSTEPS(10),JLINE(10),LINK1D(65),
     3	LINK1E(65),NREC,MAJOR,ERROR2,ERROR3,ETIME(5,2),ATIME(5,2),
     4	ETR(5,65),AMPTR(5,65),XXX(188)
C
C
C
C	FOLLOWING ARE USED INDIVIDUALLY BY LANG.,DC,AC,TR. (668 WORDS)
C
	DOUBLE PRECISION FLUX,VALUE
C
	COMMON /MAIN3/FLUX(65),VALUE(65),LEVER(65),LEVERS(65)
     1	,LINK1A(65),TTAU(10),ESLOPE(5),ASLOPE(5),HOLD,LEAST,
     2	LIST,LATCH,LOCK,LOCKA,LOCKB,LOCKD,LOCKF,LOCKG,MINOR,
     3	NUMBER,PARTS,SAVE,STEP,T,TEST,THIGH,TLOW,TSTAR,TZERO,
     4	UNIT,JX1,YYY(162)
C
C
C
C	FOLLOWING USED WHERE EVER NEEDED THROUGH OUT ECAP (5000 WORDS)
C
	DOUBLE PRECISION H(50,50)
C
	COMMON /MAIN4/H
C
C
C
C	FOLLOWING ARE FOR INPUT AND OUTPUT SUBROUTINES
C
C	IDLG-DIALOG INPUT DEV.
C	IRSP-DIALOG OUTPUT DEV.
C	NDEVI-INPUT DEV.
C	NDEVO-OUTPUT DEV.
C
	COMMON /IOBLK/IDLG,IRSP,NDEVI,NDEVO,IDVI,IDVO,ICODE,IBNK,NAMI(2)
	COMMON /IOBLKA/NAMO(2),IPJ,IPG,NCOPYS,ITYCH
C
C
	DIMENSION X(65),OUTPUT(60,6),ICONT(6)
	DOUBLE PRECISION LINE(0/13)
    1 IF( NTRACE ) 3, 4, 3
    2 FORMAT( 7H PRINT2 )
 3    WRITE(NDEVO, 2)
 4    NPR = 0
	IC=0
	DO 950 I=1,60
	DO 950 J=1,6
950	OUTPUT(I,J)=0
	NUMC=0
	DASH='-'
	LINE(0)='NODE OR'
	LINE(1)='  NODE '
	LINE(2)='BRANCH '
	LINE(3)='BRANCH '
	LINE(4)='POWER  '
	LINE(5)='ELEMENT'
	LINE(6)='ELEMENT'
	LINE(7)='BRANCH '
	LINE(8)='VOLTAGE'
	LINE(9)='VOLTAGE'
	LINE(10)='CURRENT'
	LINE(11)='LOSSES '
	LINE(12)='VOLTAGE'
	LINE(13)='CURRENT'
      DO 5 I=1,6
 5    NPR = NPR +NPRINT(I)
      IF ( LOCKF ) 8100, 500, 500
 500  IF(LOCK) 1000, 1007, 1000
 1000 IF( JX1 ) 1001, 1001, 8000
 1001 CALL SSWTCH ( 1,LOST)
      GO TO ( 1004 , 1003 ), LOST
 1003 IF( NPR ) 1005, 1005, 1004
 1004 WRITE(NDEVO, 10 ) T
 10   FORMAT(///,'    T = ', 1PG15.7, /)
	IF(IDATA.EQ.1) WRITE(20,951) T
951	FORMAT(1PG15.7)
 1005 GO TO ( 1008, 1007 ), LOST
 1007 IF( NPRINT(1)) 1010, 1010, 1008
C
C	NODE VOLTAGES
C
 1008 NUMC=NUMC+1
	ICONT(NUMC)=1
	DO 1009 I=1,NODES
	X(I)=V(I)
1009	OUTPUT(I,NUMC)=V(I)
 1010 IF( NPRINT(5)+NPRINT(6)+NPRINT(3))1023,1023,1011
 1011 DO 1015 I = 1, LINKS
      J = NT(I)
      IF(J)1013,1013,1012
 1012 X(I) = V(J)
 1013 J= NH(I)
      IF( J ) 1015,1015,1014
 1014 X(I)=X(I) - V(J)
 1015 CONTINUE
      IF ( NPRINT( 5 )) 1018, 1018, 1016
C
C	BRANCH VOLTAGES
C
 1016 NUMC=NUMC+1
	ICONT(NUMC)=2
	DO 1017 I=1,LINKS
1017	OUTPUT(I,NUMC)=X(I)
 1018 IF( NPRINT(6) + NPRINT(3)) 1023, 1023, 1019
 1019 DO 1020  I = 1, LINKS
 1020 X(I) =X(I)+ BIAS1(I)
      IF(NPRINT(3))1023,1023,1021
C
C	ELEMENT VOLTAGES
C
 1021 NUMC=NUMC+1
	ICONT(NUMC)=5
	DO 1022 I=1,LINKS
1022	OUTPUT(I,NUMC)=X(I)
 1023 GO TO ( 1026, 1025 ), LOST
 1025 IF ( NPRINT(2)) 1027, 1027, 1026
C
C	ELEMENT CURRENTS
C
 1026 NUMC=NUMC+1
	ICONT(NUMC)=6
	DO 1029 I=1,LINKS
1029	OUTPUT(I,NUMC)=FLUX(I)
 1027 IF (NPRINT(6)) 1031, 1031, 1028
C
C	INSTANTANEOUS POWER
C
 1028 NUMC=NUMC+1
	ICONT(NUMC)=4
	DO 30 I=1,LINKS
	X(I)=X(I)*FLUX(I)
30	OUTPUT(I,NUMC)=X(I)
 1031 IF( NPRINT(4)) 8001, 8001, 1032
C
C	BRANCH CURRENTS
C
 1032 NUMC=NUMC+1
	ICONT(NUMC)=3
	DO 1033 I=1,LINKS
	X(I)=FLUX(I)-FLOW1(I)
1033	OUTPUT(I,NUMC)=X(I)
C
C	OUTPUT RESULTS
C
8001	IF(NUMC.EQ.0) GOTO 8000
	IF(IDVO.EQ.'TTY') GOTO 806
	WRITE(NDEVO,803)
803	FORMAT(//)
	WRITE(NDEVO,801) LINE(0),(LINE(ICONT(I)),I=1,NUMC)
	WRITE(NDEVO,801) LINE(7),(LINE(ICONT(I)+7),I=1,NUMC)
	WRITE(NDEVO,804) (DASH,I=1,NUMC*16+13)
	KMAX=NODES
	DO 987 II=2,6
987	IF((LINKS.GT.NODES).AND.(NPRINT(II).EQ.1))KMAX=LINKS
	DO 800 I=1,KMAX
800	WRITE(NDEVO,802) I,(OUTPUT(I,J),J=1,NUMC)
	IF(IDATA) 810,810,811
810	GOTO 8000
806	LIN=NUMC
	IF(NUMC.GT.4) LIN=4
	WRITE(NDEVO,803)
	WRITE(NDEVO,807) LINE(0),(LINE(ICONT(I+IC)),I=1,LIN)
	WRITE(NDEVO,807) LINE(7),(LINE(ICONT(I+IC)+7),I=1,LIN)
	WRITE(NDEVO,804) (DASH,I=1,LIN*14+13)
	KMAX=NODES
	DO 988 II=2,6
988	IF((LINKS.GT.NODES).AND.(NPRINT(II).EQ.1))KMAX=LINKS
	DO 808 I=1,KMAX
808	WRITE(NDEVO,809) I,(OUTPUT(I,J+IC),J=1,LIN)
	IF(NUMC.LE.4) GOTO 777
	IC=4
	NUMC=NUMC-4
	GOTO 806
777	IF(IDATA) 810,810,811
811	KMAX=NODES
	DO 989 II=2,6
989	IF((LINKS.GT.NODES).AND.(NPRINT(II).EQ.1))KMAX=LINKS
	DO 812 I=1,KMAX
812	WRITE(20,813) I,(OUTPUT(I,J),J=1,NUMC)
	GOTO 810
801	FORMAT(1X,A7,6X,6(5X,A7,4X))
802	FORMAT(4X,I2,8X,6(3X,1PE13.6))
804	FORMAT(1X,130A1)
807	FORMAT(1X,A7,6X,4(4X,A7,3X))
809	FORMAT(4X,I2,8X,4(3X,1PE11.4))
813	FORMAT(I,6E15.7)
 8000 IF ( LOCKF ) 9000, 9000, 8100
 8100 DO 8400 M = 1, LIST
      N = LEVER( M )
      LATCH = LABEL( N )
      GO TO ( 8200, 8250 ), LATCH
 8200 LABEL( N ) = 2
      WRITE(NDEVO,90) N
 90   FORMAT(//,' SWITCH',I3,' IS ON')
      GO TO 8400
 8250 LABEL( N ) = 1
      WRITE(NDEVO,91)N
 91   FORMAT(//,' SWITCH',I3,' IS OFF')
 8400 CONTINUE
      GO TO ( 8500, 8600 ), LOCKB
 8500 LOCKB = 2
      GO TO 8700
 8600 DELTA = HOLD - ( T - TSTAR )
 8700 LOCK = 1
      LOCKF = 0
 9000 RETURN
       END
	SUBROUTINE PRINT3
C
C	FOLLOWING ARE COMMON TO ALL SUBROUTINES (2141 WORDS)
C
	COMMON /MAIN1/AMPO(65),FLOW2(65),FLOW1(65),EO(65),BIAS2(65)
     1	,BIAS1(65),ERROR1,ICOLT(65),IROWT(65),IRTN,KTO,START,NSTEP
     2	,MODE1(65),FINISH,NH(65),NT(65),LINKS,NODES,NPRINT(10),NSWTCH
     3	,NTERMS,NTRACE,NUMBC,NUMBL,NUMBR,SHORT,Y(65),Y2(65),Y1(65)
     4	,LIST4(65),YTERM2(65),YTERM1(65),IDATA
C
C
C
C	FOLLOWING ARE COMMON TO ALL SUBROUTINES (2090 WORDS)
C	THESE DO NOT MATCHUP WORD FOR WORD IN ALL SUBROUTINES
C
	DOUBLE PRECISION B,V,VO
C
	COMMON /MAIN2/OPEN,LABEL(200),B(50),KE,KI,LOCKS,NLTRMS,
     1	DELTA,V(50),VO(50),LISTE(5),LISTI(5),
     2	NUME(5),NUMI(5),JSTEP(10),JSTEPS(10),JLINE(10),LINK1D(65),
     3	LINK1E(65),NREC,MAJOR,ERROR2,ERROR3,ETIME(5,2),ATIME(5,2),
     4	ETR(5,65),AMPTR(5,65),XXX(188)
C
C
C
C	FOLLOWING ARE USED INDIVIDUALLY BY LANG.,DC,AC,TR. (668 WORDS)
C
	DOUBLE PRECISION FLUX,VALUE
C
	COMMON /MAIN3/FLUX(65),VALUE(65),LEVER(65),LEVERS(65)
     1	,LINK1A(65),TTAU(10),ESLOPE(5),ASLOPE(5),HOLD,LEAST,
     2	LIST,LATCH,LOCK,LOCKA,LOCKB,LOCKD,LOCKF,LOCKG,MINOR,
     3	NUMBER,PARTS,SAVE,STEP,T,TEST,THIGH,TLOW,TSTAR,TZERO,
     4	UNIT,JX1,YYY(162)
C
C
C
C	FOLLOWING USED WHERE EVER NEEDED THROUGH OUT ECAP (5000 WORDS)
C
	DOUBLE PRECISION H(50,50)
C
	COMMON /MAIN4/H
C
C
C
C	FOLLOWING ARE FOR INPUT AND OUTPUT SUBROUTINES
C
C	IDLG-DIALOG INPUT DEV.
C	IRSP-DIALOG OUTPUT DEV.
C	NDEVI-INPUT DEV.
C	NDEVO-OUTPUT DEV.
C
	COMMON /IOBLK/IDLG,IRSP,NDEVI,NDEVO,IDVI,IDVO,ICODE,IBNK,NAMI(2)
	COMMON /IOBLKA/NAMO(2),IPJ,IPG,NCOPYS,ITYCH
C
C
    1 IF ( NTRACE ) 3, 4, 3
    2 FORMAT( 7H PRINT3 )
 3    WRITE(NDEVO, 2)
    4 CONTINUE
      NPR = NPRINT( 10 )
      IF ( NPR ) 9000, 9000, 1000
 1000 WRITE(NDEVO, 12 ) DELTA, MAJOR, ERROR1, ERROR2, ERROR3, SHORT, OPEN
	WRITE(IDLG,12) DELTA,MAJOR,ERROE1,ERROR2,ERROR3,SHORT,OPEN
      WRITE(NDEVO, 18 )
      DO 53 I = 1, NODES
      LAST = 0
   54  K=LAST + 1
       LAST = LAST + 4
       IF(LAST-NODES) 55, 55, 56
   56  LAST = NODES
   55 WRITE(NDEVO, 17 ) I, K, LAST, ( H( I, J ), J = K, LAST)
      IF ( NODES - LAST ) 53, 53, 54
   53  CONTINUE
      WRITE(NDEVO, 14 )
      DO 5000 K = 1, NODES
 5000 WRITE(NDEVO, 21 ) K, B( K )
   12 FORMAT( // 10H TIME STEP, 7X,2H= ,1PG15.8/,
     119H OUTPUT INTERVAL = ,I14/,7H 1ERROR,10X,2H= ,1PG15.8/,
     27H 2ERROR,10X,2H= ,1PG15.8/,7H 3ERROR,10X,2H= ,1PG15.8/,
     36H SHORT,11X,2H= ,1PG15.8/,5H OPEN,12X,2H= ,1PG15.8 // )
   14  FORMAT (//26H EQUIVALENT CURRENT VECTOR//
     1    9H NODE NO.5X7HCURRENT//)
   17 FORMAT( I3,I7,2H -I2,3X,41PG15.8 )
   18 FORMAT( //25H NODAL CONDUCTANCE MATRIX // 4H ROW, 6X,4HCOLS // )
   21  FORMAT (I6,4X,1PG15.8)
 9000 RETURN
      END
	SUBROUTINE TVSET
C
C	FOLLOWING ARE COMMON TO ALL SUBROUTINES (2141 WORDS)
C
	COMMON /MAIN1/AMPO(65),FLOW2(65),FLOW1(65),EO(65),BIAS2(65)
     1	,BIAS1(65),ERROR1,ICOLT(65),IROWT(65),IRTN,KTO,START,NSTEP
     2	,MODE1(65),FINISH,NH(65),NT(65),LINKS,NODES,NPRINT(10),NSWTCH
     3	,NTERMS,NTRACE,NUMBC,NUMBL,NUMBR,SHORT,Y(65),Y2(65),Y1(65)
     4	,LIST4(65),YTERM2(65),YTERM1(65),IDATA
C
C
C
C	FOLLOWING ARE COMMON TO ALL SUBROUTINES (2090 WORDS)
C	THESE DO NOT MATCHUP WORD FOR WORD IN ALL SUBROUTINES
C
	DOUBLE PRECISION B,V,VO
C
	COMMON /MAIN2/OPEN,LABEL(200),B(50),KE,KI,LOCKS,NLTRMS,
     1	DELTA,V(50),VO(50),LISTE(5),LISTI(5),
     2	NUME(5),NUMI(5),JSTEP(10),JSTEPS(10),JLINE(10),LINK1D(65),
     3	LINK1E(65),NREC,MAJOR,ERROR2,ERROR3,ETIME(5,2),ATIME(5,2),
     4	ETR(5,65),AMPTR(5,65),XXX(188)
C
C
C
C	FOLLOWING ARE USED INDIVIDUALLY BY LANG.,DC,AC,TR. (668 WORDS)
C
	DOUBLE PRECISION FLUX,VALUE
C
	COMMON /MAIN3/FLUX(65),VALUE(65),LEVER(65),LEVERS(65)
     1	,LINK1A(65),TTAU(10),ESLOPE(5),ASLOPE(5),HOLD,LEAST,
     2	LIST,LATCH,LOCK,LOCKA,LOCKB,LOCKD,LOCKF,LOCKG,MINOR,
     3	NUMBER,PARTS,SAVE,STEP,T,TEST,THIGH,TLOW,TSTAR,TZERO,
     4	UNIT,JX1,YYY(162)
C
C
C
C	FOLLOWING USED WHERE EVER NEEDED THROUGH OUT ECAP (5000 WORDS)
C
	DOUBLE PRECISION H(50,50)
C
	COMMON /MAIN4/H
C
C
C
C	FOLLOWING ARE FOR INPUT AND OUTPUT SUBROUTINES
C
C	IDLG-DIALOG INPUT DEV.
C	IRSP-DIALOG OUTPUT DEV.
C	NDEVI-INPUT DEV.
C	NDEVO-OUTPUT DEV.
C
	COMMON /IOBLK/IDLG,IRSP,NDEVI,NDEVO,IDVI,IDVO,ICODE,IBNK,NAMI(2)
	COMMON /IOBLKA/NAMO(2),IPJ,IPG,NCOPYS,ITYCH
C
C
	IF(NTRACE) 4,4,3
    1 FORMAT( 14H TVSET ENTERED)
 3    WRITE(NDEVO, 1)
    4 CONTINUE
      IF ( KE ) 5000, 5000, 1000
 1000 DO 4000 I = 1, KE
      IF(ETIME(I,2))2500,2400,1100
 1100 EONE = ETR( I , 1 )
      EZRO = ETR( I , 2 )
      TZRO = ETR( I , 3 )
      TPD = ETIME( I , 1 )
      TTAU( I ) = SAVE
      JSTEPS( I ) = 1
      NUME(I)=TPD/SAVE+0.5
      IF ( NUME( I ) - 126 ) 1200, 1200, 1150
 1150 LE = LISTE( I )
      Z = 126. * SAVE
 1125 FORMAT(30H PERIOD OF SINE WAVE IN BRANCH,I4,12H IS TOO LONG
     1   / 27H SET TO 126. * TIME STEP = ,1PG15.8//)
      WRITE(NDEVO, 1125 ) LE, Z
	WRITE(IDLG,1125),LE,Z
      NUME( I ) = 126
 1200 IF(NUME(I)-3)1225,1250,1250
 1225 LE = LISTE( I )
      Z = 3. * SAVE
      WRITE(NDEVO, 1175 ) LE, Z
	WRITE(IDLG,1175) LE,Z
 1175 FORMAT(30H PERIOD OF SINE WAVE IN BRANCH,I4,13H IS TOO SHORT
     1   / 25H SET TO 3. * TIME STEP = ,1PG15.8 // )
      NUME(I)=3
 1250 NE=NUME(I)
      TIME = 0.
      DO 2000 K = 1, NE
      ETR(I,K)=EZRO + EONE * SIN( 6.283185 * ( TIME - TZRO )/TPD )
 2000 TIME = TIME + SAVE
      GO TO 3000
 2400 NUME(I)=NUME(I)-1
 2500 TPD = ETIME( I, 1 )
      TTAU( I ) = SAVE * TPD
      JSTEPS( I ) = TPD + 0.5
 3000 JSTEP( I ) = JSTEPS( I )
      JLINE( I ) = 0
      CALL UPDATE( I , 1 )
      JLINE( I ) = 0
      LE = LISTE( I )
      BIAS1( LE ) = ETR( I, 1 )
 4000 BIAS2( LE ) = BIAS1( LE )
      LOCKD = 1
 5000 IF ( KI ) 9000, 9000, 6000
 6000 DO 8000 I = 1, KI
      IF(ATIME(I,2))7500,7400,6100
 6100 EONE = AMPTR( I, 1 )
      EZRO = AMPTR( I, 2 )
      TZRO = AMPTR( I, 3 )
      TPD = ATIME( I, 1 )
      TTAU( I + 5 ) = SAVE
      JSTEPS( I + 5 ) = 1
      NUMI(I)=TPD/SAVE+0.5
      IF ( NUMI( I ) - 126 ) 6200, 6200, 6150
 6150 LE = LISTI( I )
      Z = 126. * SAVE
      WRITE(NDEVO, 1125 ) LE, Z
	WRITE(IDLG,1125) LE,Z
      NUMI( I ) = 126
 6200 IF(NUMI(I)-3)6250,6300,6300
 6250 LE = LISTI( I )
      Z = 3. * SAVE
      WRITE(NDEVO, 1175 ) LE, Z
	WRITE(IDLG,1175) LE,Z
      NUMI ( I ) = 3
 6300 NE=NUMI(I)
      TIME = 0.
      DO 7000 K = 1, NE
      AMPTR(I,K)=EZRO+EONE * SIN( 6.283185 * ( TIME - TZRO )/TPD )
 7000 TIME = TIME + SAVE
      GO TO 7800
 7400 NUMI(I)=NUMI(I)-1
 7500 TPD=ATIME(I,1)
      TTAU( I + 5 ) = SAVE * TPD
      JSTEPS( I + 5 ) = TPD + 0.5
 7800 JSTEP( I + 5 ) = JSTEPS( I + 5 )
      JLINE( I + 5 ) = 0
      CALL UPDATE( I , 2 )
      JLINE( I + 5 ) = 0
      LE = LISTI( I )
      FLOW1( LE ) = AMPTR( I , 1 )
 8000 FLOW2( LE ) = FLOW1 ( LE )
      LOCKD = 1
 9000 RETURN
      END
	SUBROUTINE TVS
C
C	FOLLOWING ARE COMMON TO ALL SUBROUTINES (2141 WORDS)
C
	COMMON /MAIN1/AMPO(65),FLOW2(65),FLOW1(65),EO(65),BIAS2(65)
     1	,BIAS1(65),ERROR1,ICOLT(65),IROWT(65),IRTN,KTO,START,NSTEP
     2	,MODE1(65),FINISH,NH(65),NT(65),LINKS,NODES,NPRINT(10),NSWTCH
     3	,NTERMS,NTRACE,NUMBC,NUMBL,NUMBR,SHORT,Y(65),Y2(65),Y1(65)
     4	,LIST4(65),YTERM2(65),YTERM1(65),IDATA
C
C
C
C	FOLLOWING ARE COMMON TO ALL SUBROUTINES (2090 WORDS)
C	THESE DO NOT MATCHUP WORD FOR WORD IN ALL SUBROUTINES
C
	DOUBLE PRECISION B,V,VO
C
	COMMON /MAIN2/OPEN,LABEL(200),B(50),KE,KI,LOCKS,NLTRMS,
     1	DELTA,V(50),VO(50),LISTE(5),LISTI(5),
     2	NUME(5),NUMI(5),JSTEP(10),JSTEPS(10),JLINE(10),LINK1D(65),
     3	LINK1E(65),NREC,MAJOR,ERROR2,ERROR3,ETIME(5,2),ATIME(5,2),
     4	ETR(5,65),AMPTR(5,65),XXX(188)
C
C
C
C	FOLLOWING ARE USED INDIVIDUALLY BY LANG.,DC,AC,TR. (668 WORDS)
C
	DOUBLE PRECISION FLUX,VALUE
C
	COMMON /MAIN3/FLUX(65),VALUE(65),LEVER(65),LEVERS(65)
     1	,LINK1A(65),TTAU(10),ESLOPE(5),ASLOPE(5),HOLD,LEAST,
     2	LIST,LATCH,LOCK,LOCKA,LOCKB,LOCKD,LOCKF,LOCKG,MINOR,
     3	NUMBER,PARTS,SAVE,STEP,T,TEST,THIGH,TLOW,TSTAR,TZERO,
     4	UNIT,JX1,YYY(162)
C
C
C
C	FOLLOWING USED WHERE EVER NEEDED THROUGH OUT ECAP (5000 WORDS)
C
	DOUBLE PRECISION H(50,50)
C
	COMMON /MAIN4/H
C
C
C
C	FOLLOWING ARE FOR INPUT AND OUTPUT SUBROUTINES
C
C	IDLG-DIALOG INPUT DEV.
C	IRSP-DIALOG OUTPUT DEV.
C	NDEVI-INPUT DEV.
C	NDEVO-OUTPUT DEV.
C
	COMMON /IOBLK/IDLG,IRSP,NDEVI,NDEVO,IDVI,IDVO,ICODE,IBNK,NAMI(2)
	COMMON /IOBLKA/NAMO(2),IPJ,IPG,NCOPYS,ITYCH
C
C
      IF ( NTRACE ) 4, 4, 3
    1 FORMAT(12H TVS ENTERED)
 3    WRITE(NDEVO, 1)
    4 CONTINUE
C
      IF ( KE )5000, 5000, 1000
 1000 DO 9 I = 1, KE
      IF ( JSTEP( I ) - JSTEPS( I )) 8, 2, 9
    2 JSTEP( I ) = 0
      CALL UPDATE( I, 1 )
    8 JSTEP( I ) = JSTEP( I ) + 1
    9 CONTINUE
 5000 IF ( KI ) 8000, 8000, 6000
 6000 DO 19 I = 1, KI
      J = I + 5
      IF ( JSTEP( J ) - JSTEPS( J )) 18, 12, 19
   12 JSTEP( J ) = 0
      CALL UPDATE( I, 2 )
   18 JSTEP( J ) = JSTEP( J ) + 1
   19 CONTINUE
 8000 IF ( NSTEP ) 21, 21, 9000
   21 LOCKD = 2
 9000 RETURN
      END
	SUBROUTINE SSWITCH(I,J)
C
C	FOLLOWING ARE COMMON TO ALL SUBROUTINES (2141 WORDS)
C
	COMMON /MAIN1/AMPO(65),FLOW2(65),FLOW1(65),EO(65),BIAS2(65)
     1	,BIAS1(65),ERROR1,ICOLT(65),IROWT(65),IRTN,KTO,START,NSTEP
     2	,MODE1(65),FINISH,NH(65),NT(65),LINKS,NODES,NPRINT(10),NSWTCH
     3	,NTERMS,NTRACE,NUMBC,NUMBL,NUMBR,SHORT,Y(65),Y2(65),Y1(65)
     4	,LIST4(65),YTERM2(65),YTERM1(65),IDATA
C
C
C
C	FOLLOWING ARE COMMON TO ALL SUBROUTINES (2090 WORDS)
C	THESE DO NOT MATCHUP WORD FOR WORD IN ALL SUBROUTINES
C
	DOUBLE PRECISION B,V,VO
C
	COMMON /MAIN2/OPEN,LABEL(200),B(50),KE,KI,LOCKS,NLTRMS,
     1	DELTA,V(50),VO(50),LISTE(5),LISTI(5),
     2	NUME(5),NUMI(5),JSTEP(10),JSTEPS(10),JLINE(10),LINK1D(65),
     3	LINK1E(65),NREC,MAJOR,ERROR2,ERROR3,ETIME(5,2),ATIME(5,2),
     4	ETR(5,65),AMPTR(5,65),XXX(188)
C
C
C
C	FOLLOWING ARE USED INDIVIDUALLY BY LANG.,DC,AC,TR. (668 WORDS)
C
	DOUBLE PRECISION FLUX,VALUE
C
	COMMON /MAIN3/FLUX(65),VALUE(65),LEVER(65),LEVERS(65)
     1	,LINK1A(65),TTAU(10),ESLOPE(5),ASLOPE(5),HOLD,LEAST,
     2	LIST,LATCH,LOCK,LOCKA,LOCKB,LOCKD,LOCKF,LOCKG,MINOR,
     3	NUMBER,PARTS,SAVE,STEP,T,TEST,THIGH,TLOW,TSTAR,TZERO,
     4	UNIT,JX1,YYY(162)
C
C
C
C	FOLLOWING USED WHERE EVER NEEDED THROUGH OUT ECAP (5000 WORDS)
C
	DOUBLE PRECISION H(50,50)
C
	COMMON /MAIN4/H
C
C
C
C	FOLLOWING ARE FOR INPUT AND OUTPUT SUBROUTINES
C
C	IDLG-DIALOG INPUT DEV.
C	IRSP-DIALOG OUTPUT DEV.
C	NDEVI-INPUT DEV.
C	NDEVO-OUTPUT DEV.
C
	COMMON /IOBLK/IDLG,IRSP,NDEVI,NDEVO,IDVI,IDVO,ICODE,IBNK,NAMI(2)
	COMMON /IOBLKA/NAMO(2),IPJ,IPG,NCOPYS,ITYCH
C
C
	IF(NTRACE) 4,4,3
1	FORMAT(' SSWITCH ENTERED')
3	WRITE(NDEVO,1)
4	CONTINUE
       J=NSWTCH/(2**(I-1))-(NSWTCH/(2**I))*2
       J=2-J
      RETURN
      END