Trailing-Edge
-
PDP-10 Archives
-
decuslib20-05
-
decus/20-0137/ecap/ecaptr.for
There is 1 other file named ecaptr.for in the archive. Click here to see a list.
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