Trailing-Edge
-
PDP-10 Archives
-
decuslib10-09
-
43,50466/ecapdc.f4
There are no other files named ecapdc.f4 in the archive.
SUBROUTINE ECA20
C
C FOLLOWING ARE COMMON TO ALL SUBROUTINES (2150 WORDS)
C
COMMON /MAIN1/AMP(65),AMPMAX(65),AMPMIN(65),E(65),EMAX(65)
1 ,EMIN(65),ERROR1,ICOLT(65),IROWT(65),IRTN,KTO,ISEQ,MO,MODE1
2 (65),MSEQ,NFIN(65),NINIT(65),NMAX,NNODE,NPRINT(10),NSWTCH,
3 NTERMS,NTRACE,NUMBC,NUMBL,NUMBR,NUMMO,Y(65),YMAX(65),YMIN(65)
4 ,YTERM(65),YTERMH(65),YTERML(65),IDATA
C
C
C
C FOLLOWING ARE COMMON TO ALL SUBROUTINES (2090 WORDS)
C THEY DO NOT MATCHUP IN ALL SUBROUTINES
C
COMMON /MAIN2/VFIRST(50),VSECND(50),VLAST(50),MOBRN(50),
1 MOPARM(50),MOSTEP(50),IWCOUT(4),AX1,MATA(65,4,3),
2 DELTA,ITOL,JX1,JX4,JX5,L,M,EX(65),EB(65),XXX(326)
C
C
C
C FOLLOWING ARE USED INDIVIDUALLY BY LANG.,DC,AC,TR.(918 WORDS)
C
DOUBLE PRECISION SMLEP,CURR,SMLE,EQUCUR
C
COMMON /MAIN3/CURR(65),EQUCUR(50),SMLE(65),SMLEP(50),
1 STDSQ(50),VNOM(50),WCMAX(50),WCMIN(50)
C
C
C
C FOLLOWING ARE USED IN DC AND TR. (5000 WORDS)
C
DOUBLE PRECISION X,ZPRL
C
COMMON /MAIN4/AMPX(65),AMPB(65),YB(65),YX(65),YTERMX(65),
1 YTERMB(65),ZPRL(30,30),X(65),ZZZ(2680)
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 )41,41,40
2 FORMAT(' DC MAINLINE-ECA20 ENTERED. IRTN=',I3 )
40 WRITE(NDEVO, 2 ) IRTN
41 CONTINUE
GO TO (1,420,400),IRTN
1 JX4=0
DO 10 I=1,NMAX
YX(I)=Y(I)
EX(I)=E(I)
10 AMPX(I)=AMP(I)
IF( NTERMS ) 30, 5, 30
30 DO 11 I=1,NTERMS
11 YTERMX(I)=YTERM(I)
5 CALL ECA22
CALL ECA23
IF(NPRINT(10))7,7,8
8 JX1=1
CALL ECA24
7 CALL ECA26
IF(NPRINT(10))3,3,4
4 JX1=2
CALL ECA24
3 CALL ECA25
420 IF(JX4)419,419,20
419 I=ISEQ+1
GO TO (302,16,17,18,18),I
18 DO 19 I=1,NNODE
19 STDSQ(I)=0.0
IF(ISEQ-3)16,16,17
17 DO 25 K=1,3
DO 25 I=1,4
NUM=NMAX
IF(I-2)22,23,22
23 IF(NTERMS)25,25,21
21 NUM=NTERMS
22 DO 25 J=1,NUM
MATA(J,I,K)=0
25 CONTINUE
DO 24 I=1,NNODE
24 VNOM(I)=SMLEP(I)
16 L=1
M=NNODE
GO TO 850
20 L=JX5
M=JX5
850 CALL ECA28
IF ( JX4 ) 9995, 880, 820
880 IF(ISEQ-2)301,800,801
801 CALL ECA29
IF(ISEQ-3)301,301,800
800 JX5=0
ISEQ=0
WRITE(NDEVO,803)
803 FORMAT(/// 39H WORST CASE SOLUTIONS FOR NODE VOLTAGES///,
1 5H NODE,5X,5HWCMIN,14X,7HNOMINAL,12X,5HWCMAX/)
820 CALL ECA27
IF(JX4-1)302,5,5
301 ISEQ=0
302 IF(MO)9995,9995,400
400 IF(NUMMO)402,119,402
402 CALL ECA30
CALL ECA31
GO TO 5
119 ISEQ=MSEQ
IWCOUT(1)=IWCOUT(3)
IWCOUT(2)=IWCOUT(4)
IWCOUT(3)=0
IWCOUT(4)=0
MO=0
IF( ITOL )419,419,900
900 MOSTEP(ITOL)=0
GO TO 419
9995 IRTN=1
9996 IF( NTRACE )9999,9999,9998
9997 FORMAT(' DC MAINLINE-ECA20 EXIT. IRTN=',I3 )
9998 WRITE(NDEVO, 9997) IRTN
9999 RETURN
END
SUBROUTINE ECA22
C
C FOLLOWING ARE COMMON TO ALL SUBROUTINES (2150 WORDS)
C
COMMON /MAIN1/AMP(65),AMPMAX(65),AMPMIN(65),E(65),EMAX(65)
1 ,EMIN(65),ERROR1,ICOLT(65),IROWT(65),IRTN,KTO,ISEQ,MO,MODE1
2 (65),MSEQ,NFIN(65),NINIT(65),NMAX,NNODE,NPRINT(10),NSWTCH,
3 NTERMS,NTRACE,NUMBC,NUMBL,NUMBR,NUMMO,Y(65),YMAX(65),YMIN(65)
4 ,YTERM(65),YTERMH(65),YTERML(65),IDATA
C
C
C
C FOLLOWING ARE COMMON TO ALL SUBROUTINES (2090 WORDS)
C THEY DO NOT MATCHUP IN ALL SUBROUTINES
C
COMMON /MAIN2/VFIRST(50),VSECND(50),VLAST(50),MOBRN(50),
1 MOPARM(50),MOSTEP(50),IWCOUT(4),AX1,MATA(65,4,3),
2 DELTA,ITOL,JX1,JX4,JX5,L,M,EX(65),EB(65),XXX(326)
C
C
C
C FOLLOWING ARE USED INDIVIDUALLY BY LANG.,DC,AC,TR.(918 WORDS)
C
DOUBLE PRECISION SMLEP,CURR,SMLE,EQUCUR
C
COMMON /MAIN3/CURR(65),EQUCUR(50),SMLE(65),SMLEP(50),
1 STDSQ(50),VNOM(50),WCMAX(50),WCMIN(50)
C
C
C
C FOLLOWING ARE USED IN DC AND TR. (5000 WORDS)
C
DOUBLE PRECISION X,ZPRL
C
COMMON /MAIN4/AMPX(65),AMPB(65),YB(65),YX(65),YTERMX(65),
1 YTERMB(65),ZPRL(30,30),X(65),ZZZ(2680)
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(6H ECA22 )
3 WRITE(NDEVO,2)
4 CONTINUE
DO 10 J=1,NNODE
DO 10 K=1,NNODE
10 ZPRL(J,K)=0.0
DO 20 I=1,NMAX
NI = NINIT(I)
NF = NFIN(I)
IF ( NI ) 21, 22, 21
22 IF ( NF ) 23, 20, 23
21 IF( NF ) 24, 25, 24
25 NF = NI
GO TO 23
24 ZPRL(NI,NI)= ZPRL(NI,NI) + YX(I)
ZPRL(NI,NF)= ZPRL(NI,NF) - YX(I)
ZPRL(NF,NI)= ZPRL(NF,NI) - YX(I)
23 ZPRL(NF,NF)= ZPRL(NF,NF) + YX(I)
20 CONTINUE
IF(NTERMS)7000,7000,5500
5500 DO 6500 N=1,NTERMS
LR =IROWT(N)
LC=ICOLT(N)
TERM=YTERMX(N)
I=NINIT(LR)
IF(I)6000,6000,5600
5600 J=NFIN(LC)
IF(J)5800,5800,5700
5700 ZPRL(I,J)=ZPRL(I,J)-TERM
5800 J=NINIT(LC)
IF(J)6000,6000,5900
5900 ZPRL(I,J)=ZPRL(I,J)+TERM
6000 I=NFIN(LR)
IF(I)6500,6500,6100
6100 J=NINIT(LC)
IF(J)6300,6300,6200
6200 ZPRL(I,J)=ZPRL(I,J)-TERM
6300 J=NFIN(LC)
IF(J)6500,6500,6400
6400 ZPRL(I,J)=ZPRL(I,J)+TERM
6500 CONTINUE
7000 RETURN
END
SUBROUTINE ECA23
C
C FOLLOWING ARE COMMON TO ALL SUBROUTINES (2150 WORDS)
C
COMMON /MAIN1/AMP(65),AMPMAX(65),AMPMIN(65),E(65),EMAX(65)
1 ,EMIN(65),ERROR1,ICOLT(65),IROWT(65),IRTN,KTO,ISEQ,MO,MODE1
2 (65),MSEQ,NFIN(65),NINIT(65),NMAX,NNODE,NPRINT(10),NSWTCH,
3 NTERMS,NTRACE,NUMBC,NUMBL,NUMBR,NUMMO,Y(65),YMAX(65),YMIN(65)
4 ,YTERM(65),YTERMH(65),YTERML(65),IDATA
C
C
C
C FOLLOWING ARE COMMON TO ALL SUBROUTINES (2090 WORDS)
C THEY DO NOT MATCHUP IN ALL SUBROUTINES
C
COMMON /MAIN2/VFIRST(50),VSECND(50),VLAST(50),MOBRN(50),
1 MOPARM(50),MOSTEP(50),IWCOUT(4),AX1,MATA(65,4,3),
2 DELTA,ITOL,JX1,JX4,JX5,L,M,EX(65),EB(65),XXX(326)
C
C
C
C FOLLOWING ARE USED INDIVIDUALLY BY LANG.,DC,AC,TR.(918 WORDS)
C
DOUBLE PRECISION SMLEP,CURR,SMLE,EQUCUR
C
COMMON /MAIN3/CURR(65),EQUCUR(50),SMLE(65),SMLEP(50),
1 STDSQ(50),VNOM(50),WCMAX(50),WCMIN(50)
C
C
C
C FOLLOWING ARE USED IN DC AND TR. (5000 WORDS)
C
DOUBLE PRECISION X,ZPRL
C
COMMON /MAIN4/AMPX(65),AMPB(65),YB(65),YX(65),YTERMX(65),
1 YTERMB(65),ZPRL(30,30),X(65),ZZZ(2680)
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(6H ECA23 )
3 WRITE(NDEVO,2)
4 CONTINUE
DO 4000 LL=1,NMAX
4000 CURR(LL) = YX(LL) * EX(LL) - AMPX(LL)
IF(NTERMS)9000,9000,7500
7500 DO 8000 I = 1, NTERMS
L = ICOLT( I )
LL = IROWT( I )
8000 CURR( LL ) = CURR( LL ) + YTERMX( I ) * EX( L )
9000 DO 9100 K=1,NNODE
9100 EQUCUR(K)=0.0
DO 9500 LL=1,NMAX
II=NINIT(LL)
JJ=NFIN(LL)
IF(II)9300,9300,9200
9200 EQUCUR(II) = EQUCUR(II) - CURR(LL)
9300 IF(JJ)9500,9500,9400
9400 EQUCUR(JJ)=EQUCUR(JJ)+CURR(LL)
9500 CONTINUE
RETURN
END
SUBROUTINE ECA24
C
C FOLLOWING ARE COMMON TO ALL SUBROUTINES (2150 WORDS)
C
COMMON /MAIN1/AMP(65),AMPMAX(65),AMPMIN(65),E(65),EMAX(65)
1 ,EMIN(65),ERROR1,ICOLT(65),IROWT(65),IRTN,KTO,ISEQ,MO,MODE1
2 (65),MSEQ,NFIN(65),NINIT(65),NMAX,NNODE,NPRINT(10),NSWTCH,
3 NTERMS,NTRACE,NUMBC,NUMBL,NUMBR,NUMMO,Y(65),YMAX(65),YMIN(65)
4 ,YTERM(65),YTERMH(65),YTERML(65),IDATA
C
C
C
C FOLLOWING ARE COMMON TO ALL SUBROUTINES (2090 WORDS)
C THEY DO NOT MATCHUP IN ALL SUBROUTINES
C
COMMON /MAIN2/VFIRST(50),VSECND(50),VLAST(50),MOBRN(50),
1 MOPARM(50),MOSTEP(50),IWCOUT(4),AX1,MATA(65,4,3),
2 DELTA,ITOL,JX1,JX4,JX5,L,M,EX(65),EB(65),XXX(326)
C
C
C
C FOLLOWING ARE USED INDIVIDUALLY BY LANG.,DC,AC,TR.(918 WORDS)
C
DOUBLE PRECISION SMLEP,CURR,SMLE,EQUCUR
C
COMMON /MAIN3/CURR(65),EQUCUR(50),SMLE(65),SMLEP(50),
1 STDSQ(50),VNOM(50),WCMAX(50),WCMIN(50)
C
C
C
C FOLLOWING ARE USED IN DC AND TR. (5000 WORDS)
C
DOUBLE PRECISION X,ZPRL
C
COMMON /MAIN4/AMPX(65),AMPB(65),YB(65),YX(65),YTERMX(65),
1 YTERMB(65),ZPRL(30,30),X(65),ZZZ(2680)
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 ) 2, 3, 2
1 FORMAT(6H ECA24 )
2 WRITE(NDEVO,1)
3 CONTINUE
C
C
C
C
GO TO (2550,3400),JX1
3400 WRITE(NDEVO, 2000 )
2000 FORMAT( // 23H NODAL IMPEDANCE MATRIX / )
GO TO 51
2550 WRITE(NDEVO, 50 )
50 FORMAT( //25H NODAL CONDUCTANCE MATRIX / )
51 WRITE(NDEVO, 2001 )
2001 FORMAT( 4H ROW, 2X, 4HCOLS // )
DO 53 I = 1, NNODE
LAST=0
54 K=LAST+1
LAST =LAST+4
IF(LAST-NNODE)55,55,56
56 LAST=NNODE
55 WRITE(NDEVO, 57 ) I, K, LAST, (ZPRL( I, J ), J = K, LAST )
IF ( NNODE - LAST ) 53, 53, 54
57 FORMAT( I3, I4, 1H-I2, 1X, 4(1PG15.8 ))
53 CONTINUE
2500 IF(JX1-1)9996,940,9996
940 WRITE(NDEVO, 60 )
60 FORMAT( //26H EQUIVALENT CURRENT VECTOR //
1 9H NODE NO. 5X7HCURRENT // )
DO 62 I = 1, NNODE
62 WRITE(NDEVO, 63 ) I, EQUCUR( I )
63 FORMAT(I6,4X,1PG15.8)
9996 RETURN
END
SUBROUTINE ECA25
C
C FOLLOWING ARE COMMON TO ALL SUBROUTINES (2150 WORDS)
C
COMMON /MAIN1/AMP(65),AMPMAX(65),AMPMIN(65),E(65),EMAX(65)
1 ,EMIN(65),ERROR1,ICOLT(65),IROWT(65),IRTN,KTO,ISEQ,MO,MODE1
2 (65),MSEQ,NFIN(65),NINIT(65),NMAX,NNODE,NPRINT(10),NSWTCH,
3 NTERMS,NTRACE,NUMBC,NUMBL,NUMBR,NUMMO,Y(65),YMAX(65),YMIN(65)
4 ,YTERM(65),YTERMH(65),YTERML(65),IDATA
C
C
C
C FOLLOWING ARE COMMON TO ALL SUBROUTINES (2090 WORDS)
C THEY DO NOT MATCHUP IN ALL SUBROUTINES
C
COMMON /MAIN2/VFIRST(50),VSECND(50),VLAST(50),MOBRN(50),
1 MOPARM(50),MOSTEP(50),IWCOUT(4),AX1,MATA(65,4,3),
2 DELTA,ITOL,JX1,JX4,JX5,L,M,EX(65),EB(65),XXX(326)
C
C
C
C FOLLOWING ARE USED INDIVIDUALLY BY LANG.,DC,AC,TR.(918 WORDS)
C
DOUBLE PRECISION SMLEP,CURR,SMLE,EQUCUR
C
COMMON /MAIN3/CURR(65),EQUCUR(50),SMLE(65),SMLEP(50),
1 STDSQ(50),VNOM(50),WCMAX(50),WCMIN(50)
C
C
C
C FOLLOWING ARE USED IN DC AND TR. (5000 WORDS)
C
DOUBLE PRECISION X,ZPRL
C
COMMON /MAIN4/AMPX(65),AMPB(65),YB(65),YX(65),YTERMX(65),
1 YTERMB(65),ZPRL(30,30),X(65),ZZZ(2680)
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
C
DOUBLE PRECISION LINE(0/13)
DIMENSION OUTPUT(60,6),ICONT(6)
EQUIVALENCE (LINE(0),ZZZ(1)),(ICONT(1),ZZZ(29)),(
1OUTPUT(1,1),ZZZ(35))
1 IF(NTRACE)3,4,3
2 FORMAT(6H ECA25 )
3 WRITE(NDEVO,2)
4 DO 850 I=1,400
850 ZZZ(I)=0
IC=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'
IF(JX4)8,8,101
C
C OUTPUT NODE VOLTAGES
C
8 IF(NPRINT(1))101,101,99
99 NUMC=NUMC+1
ICONT(NUMC)=1
DO 5 I=1,NNODE
5 OUTPUT(I,NUMC)=SMLEP(I)
C
C BRANCH VOLTAGES
C
101 DO 10 I=1,NMAX
SMLE(I) = 0.0
J=NINIT(I)
IF(J)11,11,12
12 SMLE(I) = SMLEP(J)
11 K=NFIN(I)
IF ( K ) 10, 10, 14
14 SMLE(I) = SMLE(I) - SMLEP(K)
10 CONTINUE
IF(JX4)9,9,102
9 IF(NPRINT(5))102,102,15
15 NUMC=NUMC+1
ICONT(NUMC)=2
DO 16 I=1,NMAX
16 OUTPUT(I,NUMC)=SMLE(I)
C
C ELEMENT VOLTAGES
C
102 DO 17 I=1,NMAX
17 SMLE(I)=SMLE(I)+EX(I)
IF(JX4)7,7,103
7 IF(NPRINT(3))103,103,18
18 NUMC=NUMC+1
ICONT(NUMC)=5
DO 19 I=1,NMAX
19 OUTPUT(I,NUMC)=SMLE(I)
C
C ELEMENT CURRENTS
C
103 DO 20 I=1,NMAX
20 CURR(I)=YX(I)*SMLE(I)
IF(NTERMS)21,22,21
21 DO 23 I=1,NTERMS
NR=IROWT(I)
NC=ICOLT(I)
IF(SMLE(NC))24,23,24
24 CURR(NR)=CURR(NR)+YTERMX(I)*SMLE(NC)
23 CONTINUE
22 IF(JX4)25,25,105
25 IF(NPRINT(2))104,104,26
26 NUMC=NUMC+1
ICONT(NUMC)=6
DO 27 I=1,NMAX
27 OUTPUT(I,NUMC)=CURR(I)
C
C BRANCH POWER LOSSES
C
104 IF(NPRINT(6))105,105,28
28 NUMC=NUMC+1
ICONT(NUMC)=4
DO 29 I=1,NMAX
29 OUTPUT(I,NUMC)=CURR(I)*SMLE(I)
C
C BRANCH CURRENTS
C
105 DO 30 I=1,NMAX
30 CURR(I)=CURR(I)-AMPX(I)
C
C CHECK UNBALANCES
C
DO 33 I=1,NNODE
33 X(I)=0.
DO 36 I=1,NMAX
J=NINIT(I)
K=NFIN(I)
IF(K)34,34,35
35 X(K)=X(K)+CURR(I)
34 IF(J)36,36,37
37 X(J)=X(J)-CURR(I)
36 CONTINUE
SUM=0.
DO 38 I=1,NNODE
38 SUM = SUM + DABS( X( I ))
GOTO 106
40 KMAX=NNODE
WRITE(NDEVO,141)
WRITE(NDEVO,142)
WRITE(IDLG,141)
WRITE(IDLG,142)
141 FORMAT( // 43H SOLUTION NOT OBTAINED TO DESIRED TOLERANCE//)
142 FORMAT( 6H NODES,15X,19H CURRENT UNBALANCES /)
GO TO 100
106 IF(JX4)300,300,900
300 IF(NPRINT(4))900,900,41
41 NUMC=NUMC+1
ICONT(NUMC)=3
DO 42 I=1,NMAX
42 OUTPUT(I,NUMC)=CURR(I)
GOTO 900
C
C OUTPUT ROUTINE
C
100 LAST=0
150 K=LAST+1
LAST=LAST+4
IF(LAST-KMAX)200,200,201
201 LAST=KMAX
200 WRITE(NDEVO,203)K,LAST,(X(J),J=K,LAST)
203 FORMAT(1X,I3,1H-,I3,4(1X,1PG15.8))
IF(KMAX-LAST)500,500,150
C
500 RETURN
900 IF(NUMC.EQ.0) GOTO 500
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=NNODE
DO 987 II=2,6
987 IF((NMAX.GT.NNODE).AND.(NPRINT(II).EQ.1))KMAX=NMAX
DO 800 I=1,KMAX
800 WRITE(NDEVO,802)I,(OUTPUT(I,J),J=1,NUMC)
IF(IDATA) 810,810,811
810 IF(SUM-ERROR1) 500,500,40
806 LEN=NUMC
IF(NUMC.GT.4) LEN=4
WRITE(NDEVO,803)
WRITE(NDEVO,807)LINE(0),(LINE(ICONT(I+IC)),I=1,LEN)
WRITE(NDEVO,807) LINE(7),(LINE(ICONT(I+IC)+7),I=1,LEN)
WRITE(NDEVO,804)(DASH,I=1,LEN*14+13)
KMAX=NNODE
DO 988 II=2,6
988 IF((NMAX.GT.NNODE).AND.(NPRINT(II).EQ.1))KMAX=NMAX
DO 808 I=1,KMAX
808 WRITE(NDEVO,809)I,(OUTPUT(I,J+IC),J=1,LEN)
IF(NUMC.LE.4) GOTO 777
IC=4
NUMC=NUMC-4
GOTO 806
777 IF(IDATA) 810,810,811
811 KMAX=NNODE
DO 989 II=2,6
989 IF((NMAX.GT.NNODE).AND.(NPRINT(II).EQ.1))KMAX=NMAX
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)
END
SUBROUTINE ECA26
C
C FOLLOWING ARE COMMON TO ALL SUBROUTINES (2150 WORDS)
C
COMMON /MAIN1/AMP(65),AMPMAX(65),AMPMIN(65),E(65),EMAX(65)
1 ,EMIN(65),ERROR1,ICOLT(65),IROWT(65),IRTN,KTO,ISEQ,MO,MODE1
2 (65),MSEQ,NFIN(65),NINIT(65),NMAX,NNODE,NPRINT(10),NSWTCH,
3 NTERMS,NTRACE,NUMBC,NUMBL,NUMBR,NUMMO,Y(65),YMAX(65),YMIN(65)
4 ,YTERM(65),YTERMH(65),YTERML(65),IDATA
C
C
C
C FOLLOWING ARE COMMON TO ALL SUBROUTINES (2090 WORDS)
C THEY DO NOT MATCHUP IN ALL SUBROUTINES
C
COMMON /MAIN2/VFIRST(50),VSECND(50),VLAST(50),MOBRN(50),
1 MOPARM(50),MOSTEP(50),IWCOUT(4),AX1,MATA(65,4,3),
2 DELTA,ITOL,JX1,JX4,JX5,L,M,EX(65),EB(65),XXX(326)
C
C
C
C FOLLOWING ARE USED INDIVIDUALLY BY LANG.,DC,AC,TR.(918 WORDS)
C
DOUBLE PRECISION SMLEP,CURR,SMLE,EQUCUR
C
COMMON /MAIN3/CURR(65),EQUCUR(50),SMLE(65),SMLEP(50),
1 STDSQ(50),VNOM(50),WCMAX(50),WCMIN(50)
C
C
C
C FOLLOWING ARE USED IN DC AND TR. (5000 WORDS)
C
DOUBLE PRECISION X,ZPRL
C
COMMON /MAIN4/AMPX(65),AMPB(65),YB(65),YX(65),YTERMX(65),
1 YTERMB(65),ZPRL(30,30),X(65),ZZZ(2680)
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 AMAX,SWAP,T
C
DIMENSION INDEX(50,2),IPIV(50)
C
EQUIVALENCE (INDEX(1,1),ZZZ(1)),(IPIV(1),ZZZ(101))
C
N=NNODE
IF ( NTRACE ) 2, 3, 2
2 WRITE(NDEVO,1)
1 FORMAT(6H ECA26 )
3 DO 20 J=1,N
20 IPIV(J)=0
DO 550 I=1,N
AMAX=0.
DO 105 J=1,N
IF(IPIV(J)-1)60,105,60
60 DO 100 K=1,N
IF(IPIV(K)-1)80,100,750
80 IF( DABS( ZPRL( J, K )) - DABS( AMAX )) 100, 100, 85
85 IROW=J
ICOL=K
AMAX=ZPRL(J,K)
100 CONTINUE
105 CONTINUE
IPIV(ICOL)=IPIV(ICOL)+1
IF(IROW-ICOL)140,260,140
140 DO 200 L=1,N
SWAP=ZPRL(IROW,L)
ZPRL(IROW,L)=ZPRL(ICOL,L)
200 ZPRL(ICOL,L)=SWAP
260 INDEX(I,1)=IROW
INDEX(I,2)=ICOL
ZPRL(ICOL,ICOL)=1.0
DO 350 L=1,N
350 ZPRL(ICOL,L)=ZPRL(ICOL,L)/AMAX
DO 550 L1=1,N
IF(L1-ICOL)400,550,400
400 T=ZPRL(L1,ICOL)
ZPRL(L1,ICOL)=0.0
DO 450 L=1,N
450 ZPRL(L1,L)=ZPRL(L1,L)-ZPRL(ICOL,L)*T
550 CONTINUE
DO 710 I=1,N
L=N+1-I
IF(INDEX(L,1)-INDEX(L,2))630,710,630
630 IROW=INDEX(L,1)
ICOL=INDEX(L,2)
DO 705 K=1,N
SWAP=ZPRL(K,IROW)
ZPRL(K,IROW)=ZPRL(K,ICOL)
ZPRL(K,ICOL)=SWAP
705 CONTINUE
710 CONTINUE
750 CONTINUE
DO 4 I=1,N
SMLEP(I)=0.0
DO 4 J=1,N
4 SMLEP(I)=SMLEP(I)+ZPRL(I,J)*EQUCUR(J)
9999 RETURN
END
SUBROUTINE ECA27
C
C FOLLOWING ARE COMMON TO ALL SUBROUTINES (2150 WORDS)
C
COMMON /MAIN1/AMP(65),AMPMAX(65),AMPMIN(65),E(65),EMAX(65)
1 ,EMIN(65),ERROR1,ICOLT(65),IROWT(65),IRTN,KTO,ISEQ,MO,MODE1
2 (65),MSEQ,NFIN(65),NINIT(65),NMAX,NNODE,NPRINT(10),NSWTCH,
3 NTERMS,NTRACE,NUMBC,NUMBL,NUMBR,NUMMO,Y(65),YMAX(65),YMIN(65)
4 ,YTERM(65),YTERMH(65),YTERML(65),IDATA
C
C
C
C FOLLOWING ARE COMMON TO ALL SUBROUTINES (2090 WORDS)
C THEY DO NOT MATCHUP IN ALL SUBROUTINES
C
COMMON /MAIN2/VFIRST(50),VSECND(50),VLAST(50),MOBRN(50),
1 MOPARM(50),MOSTEP(50),IWCOUT(4),AX1,MATA(65,4,3),
2 DELTA,ITOL,JX1,JX4,JX5,L,M,EX(65),EB(65),XXX(326)
C
C
C
C FOLLOWING ARE USED INDIVIDUALLY BY LANG.,DC,AC,TR.(918 WORDS)
C
DOUBLE PRECISION SMLEP,CURR,SMLE,EQUCUR
C
COMMON /MAIN3/CURR(65),EQUCUR(50),SMLE(65),SMLEP(50),
1 STDSQ(50),VNOM(50),WCMAX(50),WCMIN(50)
C
C
C
C FOLLOWING ARE USED IN DC AND TR. (5000 WORDS)
C
DOUBLE PRECISION X,ZPRL
C
COMMON /MAIN4/AMPX(65),AMPB(65),YB(65),YX(65),YTERMX(65),
1 YTERMB(65),ZPRL(30,30),X(65),ZZZ(2680)
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)3,4,3
3 WRITE(NDEVO,2)
2 FORMAT(6H ECA27)
4 CONTINUE
IF(JX4-1)10,20,30
C
C OUTPUT WORST CASE
C
20 WRITE(NDEVO,21)JX5,AX1,VNOM(JX5),SMLEP(JX5)
21 FORMAT(1X,I2,2X,3(4X,1PG15.8))
10 JX4=2
11 JX5=JX5+1
IF(JX5-NNODE)13,13,25
13 J=(JX5-1)/25+1
L = MOD(JX5-1, 25 ) + 1
M=IWCOUT(J)/(2**(L-1))-(IWCOUT(J)/(2**L))*2
IF(M)11,11,12
25 DO 26 I=1,NMAX
YX(I)=Y(I)
EX(I)=E(I)
26 AMPX(I)=AMP(I)
IF(NTERMS)15,16,15
15 DO 27 I=1,NTERMS
27 YTERMX(I)=YTERM(I)
16 JX4=0
GO TO 996
C
C SET VALUES FOR WORST CASE
C
12 L = MOD( JX5-1, 19 ) + 1
J1=3**(L-1)
J2=3**L
L = (JX5-1)/19 + 1
DO 71 ICHG=1,4
NUM=NMAX
IF(ICHG-2)62,60,62
60 IF(NTERMS)61,71,61
61 NUM=NTERMS
62 DO 69 I=1,NUM
GO TO (65,65,63,64),ICHG
63 IF(EMAX(I)-EMIN(I))69,69,65
64 IF(AMPMAX(I)-AMPMIN(I))69,69,65
65 K=MATA(I,ICHG,L)/J1-(MATA(I,ICHG,L)/J2)*3
IF(K-1)110,100,120
110 GO TO (101,102,103,104),ICHG
101 YX(I)=YMIN(I)
YB(I)=YMAX(I)
GO TO 69
102 J=ICOLT(I)
YTERMX(I)=YX(J)*YTERMH(I)/Y(J)
YTERMB(I)=YB(J)*YTERML(I)/Y(J)
GO TO 69
103 EX(I)=EMAX(I)
EB(I)=EMIN(I)
GO TO 69
104 AMPX(I)=AMPMAX(I)
AMPB(I)=AMPMIN(I)
GO TO 69
100 GO TO (201,202,203,204),ICHG
201 YX(I)=Y(I)
YB(I)=Y(I)
GO TO 69
202 J=ICOLT(I)
YTERMX(I)=YX(J)*YTERM(I)/Y(J)
YTERMB(I)=YB(J)*YTERM(I)/Y(J)
GO TO 69
203 EX(I)=E(I)
EB(I)=E(I)
GO TO 69
204 AMPX(I)=AMP(I)
AMPB(I)=AMP(I)
GO TO 69
120 GO TO (301,302,303,304),ICHG
301 YX(I)=YMAX(I)
YB(I)=YMIN(I)
GO TO 69
302 J=ICOLT(I)
YTERMX(I)=YX(J)*YTERML(I)/Y(J)
YTERMB(I)=YB(J)*YTERMH(I)/Y(J)
GO TO 69
303 EX(I)=EMIN(I)
EB(I)=EMAX(I)
GO TO 69
304 AMPX(I)=AMPMIN(I)
AMPB(I)=AMPMAX(I)
69 CONTINUE
71 CONTINUE
GO TO 996
30 JX4=1
AX1=SMLEP(JX5)
DO 550 I=1,NMAX
YX(I)=YB(I)
IF(EMAX(I)-EMIN(I))500,500,510
510 EX(I)=EB(I)
500 IF(AMPMAX(I)-AMPMIN(I))550,550,520
520 AMPX(I)=AMPB(I)
550 CONTINUE
IF(NTERMS)560,996,560
560 DO 501 I=1,NTERMS
501 YTERMX(I)=YTERMB(I)
996 RETURN
END
SUBROUTINE ECA28
C
C FOLLOWING ARE COMMON TO ALL SUBROUTINES (2150 WORDS)
C
COMMON /MAIN1/AMP(65),AMPMAX(65),AMPMIN(65),E(65),EMAX(65)
1 ,EMIN(65),ERROR1,ICOLT(65),IROWT(65),IRTN,KTO,ISEQ,MO,MODE1
2 (65),MSEQ,NFIN(65),NINIT(65),NMAX,NNODE,NPRINT(10),NSWTCH,
3 NTERMS,NTRACE,NUMBC,NUMBL,NUMBR,NUMMO,Y(65),YMAX(65),YMIN(65)
4 ,YTERM(65),YTERMH(65),YTERML(65),IDATA
C
C
C
C FOLLOWING ARE COMMON TO ALL SUBROUTINES (2090 WORDS)
C THEY DO NOT MATCHUP IN ALL SUBROUTINES
C
COMMON /MAIN2/VFIRST(50),VSECND(50),VLAST(50),MOBRN(50),
1 MOPARM(50),MOSTEP(50),IWCOUT(4),AX1,MATA(65,4,3),
2 DELTA,ITOL,JX1,JX4,JX5,L,M,EX(65),EB(65),XXX(326)
C
C
C
C FOLLOWING ARE USED INDIVIDUALLY BY LANG.,DC,AC,TR.(918 WORDS)
C
DOUBLE PRECISION SMLEP,CURR,SMLE,EQUCUR
C
COMMON /MAIN3/CURR(65),EQUCUR(50),SMLE(65),SMLEP(50),
1 STDSQ(50),VNOM(50),WCMAX(50),WCMIN(50)
C
C
C
C FOLLOWING ARE USED IN DC AND TR. (5000 WORDS)
C
DOUBLE PRECISION X,ZPRL
C
COMMON /MAIN4/AMPX(65),AMPB(65),YB(65),YX(65),YTERMX(65),
1 YTERMB(65),ZPRL(30,30),X(65),ZZZ(2680)
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)3,3,1
1 WRITE(NDEVO,2)
2 FORMAT(6H ECA28 )
3 CONTINUE
C
C CALCULATE PARTIALS
C
DO 971 ICHG=1,4
KFIRST=1
NUM=NMAX
IF(ICHG-2)962,960,962
960 IF(NTERMS)961,971,961
961 NUM=NTERMS
962 DO 969 I=1,NUM
9500 GO TO (965,965,963,964),ICHG
963 IF(ABS(E(I))+EMAX(I)-EMIN(I))965,969,965
964 IF(ABS(AMP(I))+AMPMAX(I)-AMPMIN(I) )965,969,965
965 DO 33 J=L,M
33 CURR(J)=0.
GO TO(12,10,210,201),ICHG
12 TEMP1=YX(I)*YX(I)*SMLE(I)
II = I
NT = 1
GO TO 500
501 IF(NTERMS)110,851,110
110 J=1
111 IF(I-ICOLT(J))502,120,502
120 II=IROWT(J)
TEMP1=YX(I)*YTERMX(J)*SMLE(I)
NT = 2
GO TO 500
502 J=J+1
IF(J-NTERMS)111,111,851
10 II= IROWT(I)
JJ = ICOLT(I)
TEMP1=-SMLE(JJ)*YX(JJ)
NT = 3
GO TO 500
210 IF( NTERMS )215,19,215
215 J=1
216 IF(I-ICOLT(J))504,225,504
225 II= IROWT(J)
TEMP1=-YTERMX(J)
NT = 4
GO TO 500
504 J=J+1
IF(J-NTERMS)216,216,19
19 II=I
TEMP1=-YX(I)
NT =3
GO TO 500
201 II = I
TEMP1 = 1.0
NT = 3
500 IF( NINIT(II) ) 22, 24, 22
22 NI = NINIT(II)
DO 23 N = L,M
23 CURR(N)=CURR(N)+ZPRL(N,NI)*TEMP1
24 IF( NFIN(II) ) 25, 27, 25
25 NI = NFIN(II)
DO 26 N= L,M
26 CURR(N)=CURR(N)-ZPRL(N,NI)*TEMP1
27 GO TO ( 501,502,851,504),NT
851 IF(JX4)855,855,860
855 IF(NPRINT(7))11,11,302
11 IF(ISEQ-1)858,302,858
C
C OUTPUT PARTIALS
C
302 IF(KFIRST)351,351,350
350 KFIRST=0
GO TO (90,91,92,93),ICHG
90 WRITE(NDEVO,190)
190 FORMAT(///55H PARTIAL DERIVATIVES AND SENSITIVITIES OF NODE VOLTAG
1ES///,28H WITH RESPECT TO RESISTANCES//,
2 7H BRANCH,3X,4HNODE,7X,8HPARTIALS,12X,13HSENSITIVITIES/)
GO TO 351
91 WRITE(NDEVO,191)
191 FORMAT(/22H WITH RESPECT TO BETAS//,
1 5H BETA,5X,4HNODE,7X,8HPARTIALS,12X,13HSENSITIVITIES/)
GO TO 351
92 WRITE(NDEVO,192)
192 FORMAT(/ 32H WITH RESPECT TO VOLTAGE SOURCES//,
1 7H BRANCH,3X,4HNODE,7X,8HPARTIALS,12X,13HSENSITIVITIES/)
GO TO 351
93 WRITE(NDEVO,193)
193 FORMAT(/ 32H WITH RESPECT TO CURRENT SOURCES//,
1 7H BRANCH,3X,4HNODE,7X,8HPARTIALS,12X,13HSENSITIVITIES/)
351 GO TO (990,991,992,993),ICHG
990 TEMP1=.01/Y(I)
GO TO 179
991 J=ICOLT(I)
TEMP1=0.01*YTERM(I)/Y(J)
GO TO 179
992 TEMP1 = 0.01 * E( I )
GO TO 179
993 TEMP1 = 0.01 * AMP( I )
179 DO 89 N=1,NNODE
TEMP=CURR(N)*ABS(TEMP1)
89 WRITE(NDEVO,181)I,N,CURR(N),TEMP
181 FORMAT(1X,I3,7X,I2,2X,2(5X,1PG15.8))
858 IF(ISEQ-2)969,600,870
C
C CALCULATE STANDARD DEVIATIONS
C
870 GO TO (402,403,404,405),ICHG
402 TEMP1=1./YMIN(I)-1./YMAX(I)
GO TO 410
403 J=ICOLT(I)
TEMP1=YTERMH(I)/Y(J) -YTERML(I)/Y(J)
GO TO 410
404 TEMP1=EMAX(I)-EMIN(I)
GO TO 410
405 TEMP1=AMPMAX(I)-AMPMIN(I)
410 TEMP1=TEMP1*TEMP1/36.0
DO 420 J=1,NNODE
IF( CURR(J))421,420,421
421 STDSQ(J)=STDSQ(J)+ CURR(J)*CURR(J)*TEMP1
420 CONTINUE
IF(ISEQ-4)969,600,969
C
C STORE SIGNS OF PARTIALS
C
600 DO 610 J=1,NNODE
IF( CURR(J))610,602,603
602 K=1
GO TO 609
603 K=2
609 MM= 3**(MOD(J-1,19))
LL= (J-1)/19 + 1
MATA(I,ICHG,LL)=MATA(I,ICHG,LL)+MM*K
610 CONTINUE
GO TO 969
C
C COMPARE SIGNS OF PARTIALS
C
860 J = MOD(JX5-1,19) + 1
NJ = (JX5-1)/19 + 1
K=MATA(I,ICHG,NJ)/(3**(J-1))-(MATA(I,ICHG,NJ)/(3**J))*3+1
GO TO (700,969,702),K
700 IF( CURR(JX5))969,969,750
702 IF( CURR(JX5))750,969,969
750 GO TO (751,752,753,754),ICHG
751 NJ = 'R'
GO TO 755
752 NJ = 'T'
GO TO 755
753 NJ = 'E'
GO TO 755
754 NJ = 'I'
755 IF(JX4-1)756,756,757
757 WRITE(NDEVO,760)JX5,NJ,I
760 FORMAT( / 1X,I2,2X,16HPARTIAL W.R.T. ,A1,I3,2X,
1 23HHAS CHANGED SIGN AT MIN/)
GO TO 969
756 WRITE(NDEVO,761)JX5,NJ,I
761 FORMAT( / 1X,I2,2X,16HPARTIAL W.R.T. ,A1,I3,2X,
1 23HHAS CHANGED SIGN AT MAX/)
969 CONTINUE
971 CONTINUE
RETURN
END
SUBROUTINE ECA29
C
C FOLLOWING ARE COMMON TO ALL SUBROUTINES (2150 WORDS)
C
COMMON /MAIN1/AMP(65),AMPMAX(65),AMPMIN(65),E(65),EMAX(65)
1 ,EMIN(65),ERROR1,ICOLT(65),IROWT(65),IRTN,KTO,ISEQ,MO,MODE1
2 (65),MSEQ,NFIN(65),NINIT(65),NMAX,NNODE,NPRINT(10),NSWTCH,
3 NTERMS,NTRACE,NUMBC,NUMBL,NUMBR,NUMMO,Y(65),YMAX(65),YMIN(65)
4 ,YTERM(65),YTERMH(65),YTERML(65),IDATA
C
C
C
C FOLLOWING ARE COMMON TO ALL SUBROUTINES (2090 WORDS)
C THEY DO NOT MATCHUP IN ALL SUBROUTINES
C
COMMON /MAIN2/VFIRST(50),VSECND(50),VLAST(50),MOBRN(50),
1 MOPARM(50),MOSTEP(50),IWCOUT(4),AX1,MATA(65,4,3),
2 DELTA,ITOL,JX1,JX4,JX5,L,M,EX(65),EB(65),XXX(326)
C
C
C
C FOLLOWING ARE USED INDIVIDUALLY BY LANG.,DC,AC,TR.(918 WORDS)
C
DOUBLE PRECISION SMLEP,CURR,SMLE,EQUCUR
C
COMMON /MAIN3/CURR(65),EQUCUR(50),SMLE(65),SMLEP(50),
1 STDSQ(50),VNOM(50),WCMAX(50),WCMIN(50)
C
C
C
C FOLLOWING ARE USED IN DC AND TR. (5000 WORDS)
C
DOUBLE PRECISION X,ZPRL
C
COMMON /MAIN4/AMPX(65),AMPB(65),YB(65),YX(65),YTERMX(65),
1 YTERMB(65),ZPRL(30,30),X(65),ZZZ(2680)
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)3,3,1
1 WRITE(NDEVO,2)
2 FORMAT(6H ECA29 )
3 CONTINUE
WRITE(NDEVO,303)
WRITE(NDEVO,304)
303 FORMAT(///37H STANDARD DEVIATIONS OF NODE VOLTAGES//)
304 FORMAT(5H NODE,4X,9HSTD. DEV.,10X,14HNOM.-STD. DEV.,5X,7HNOMINAL,
1 4X,14HNOM.+STD. DEV./)
DO 305 I=1,NNODE
TEMP=SQRT(STDSQ(I))
TEMP1=SMLEP(I)-TEMP
TEMP2=SMLEP(I)+TEMP
305 WRITE(NDEVO,306)I,TEMP,TEMP1,SMLEP(I),TEMP2
306 FORMAT(1X,I2,1X,4(1X,1PG15.8))
RETURN
END
SUBROUTINE ECA30
C
C FOLLOWING ARE COMMON TO ALL SUBROUTINES (2150 WORDS)
C
COMMON /MAIN1/AMP(65),AMPMAX(65),AMPMIN(65),E(65),EMAX(65)
1 ,EMIN(65),ERROR1,ICOLT(65),IROWT(65),IRTN,KTO,ISEQ,MO,MODE1
2 (65),MSEQ,NFIN(65),NINIT(65),NMAX,NNODE,NPRINT(10),NSWTCH,
3 NTERMS,NTRACE,NUMBC,NUMBL,NUMBR,NUMMO,Y(65),YMAX(65),YMIN(65)
4 ,YTERM(65),YTERMH(65),YTERML(65),IDATA
C
C
C
C FOLLOWING ARE COMMON TO ALL SUBROUTINES (2090 WORDS)
C THEY DO NOT MATCHUP IN ALL SUBROUTINES
C
COMMON /MAIN2/VFIRST(50),VSECND(50),VLAST(50),MOBRN(50),
1 MOPARM(50),MOSTEP(50),IWCOUT(4),AX1,MATA(65,4,3),
2 DELTA,ITOL,JX1,JX4,JX5,L,M,EX(65),EB(65),XXX(326)
C
C
C
C FOLLOWING ARE USED INDIVIDUALLY BY LANG.,DC,AC,TR.(918 WORDS)
C
DOUBLE PRECISION SMLEP,CURR,SMLE,EQUCUR
C
COMMON /MAIN3/CURR(65),EQUCUR(50),SMLE(65),SMLEP(50),
1 STDSQ(50),VNOM(50),WCMAX(50),WCMIN(50)
C
C
C
C FOLLOWING ARE USED IN DC AND TR. (5000 WORDS)
C
DOUBLE PRECISION X,ZPRL
C
COMMON /MAIN4/AMPX(65),AMPB(65),YB(65),YX(65),YTERMX(65),
1 YTERMB(65),ZPRL(30,30),X(65),ZZZ(2680)
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,3,4
1 FORMAT(31H DCMOD1-ECA30 ENTERED. NUMMO=I2,8H ITRANS=I2 )
4 WRITE(NDEVO,1)NUMMO,ITRANS
3 GO TO (2,21,210),MO
2 ITOL = 0
C
C
DO 10 MA=1,NUMMO
M=MA
7 N = MOBRN(M)
MM=IABS(MOPARM(M))
GO TO (11,12,13,14),MM
C
C R + G DATA
C
11 IF( MOPARM(M))110,29,111
111 IF(MOSTEP(M))503,501,503
501 YMAX(N) = 1.0/VSECND(M)
YMIN(N) = 1.0/VLAST(M)
503 Y(N)= 1.0/VFIRST(M)
YX(N)=Y(N)
GO TO 29
110 IF(MOSTEP(M))508,506,508
506 YMAX(N) = VLAST(M)
YMIN(N) = VSECND(M)
508 Y(N)= VFIRST(M)
YX(N)=Y(N)
GO TO 29
C
C BETA + GM DATA
C
12 IF( MOPARM(M))112,29,113
112 IF(MOSTEP(M))602,601,602
601 YTERML(N) = VSECND(M)
YTERMH(N) = VLAST(M)
602 YTERM(N)=VFIRST(M)
YTERMX(N)=YTERM(N)
GO TO 29
113 II = ICOLT(N)
IF(MOSTEP(M)) 606,604,606
604 YTERML(N) = VSECND(M)*Y(II)
YTERMH(N) = VLAST(M)*Y(II)
606 YTERM(N)=VFIRST(M)*Y(II)
YTERMX(N)=YTERM(N)
GO TO 29
C E DATA
13 IF(MOSTEP(M))703,701,703
701 EMIN(N) = VSECND(M)
EMAX(N) = VLAST(M)
703 E(N)=VFIRST(M)
EX(N)=E(N)
GO TO 29
C I DATA
14 IF(MOSTEP(M))803,801,803
801 AMPMIN(N) = VSECND(M)
AMPMAX(N) = VLAST(M)
803 AMP(N)=VFIRST(M)
AMPX(N)=AMP(N)
29 IF(MO-2)99,9996,9996
99 IF(MOSTEP(M))6,10,6
6 ITOL = M
10 CONTINUE
IF(ITOL)850,850,851
850 NUMMO=0
GO TO 9996
851 MO=2
GO TO 9996
C CHECK FOR ITERATED PARAMETER
21 MO=3
DELTA = (VLAST(ITOL)-VFIRST(ITOL))/VSECND(ITOL)
210 VFIRST(ITOL) = VFIRST(ITOL)+DELTA
24 IF(VLAST(ITOL)-VFIRST(ITOL))38,38,39
38 NUMMO=0
39 M = ITOL
GO TO 7
9996 IF( NTRACE )9998,9999,9998
9998 WRITE(NDEVO, 9997)ITRANS
9997 FORMAT(28H DCMOD1-ECA30 EXIT. ITRANS=,I2 )
9999 RETURN
END
SUBROUTINE ECA31
C
C FOLLOWING ARE COMMON TO ALL SUBROUTINES (2150 WORDS)
C
COMMON /MAIN1/AMP(65),AMPMAX(65),AMPMIN(65),E(65),EMAX(65)
1 ,EMIN(65),ERROR1,ICOLT(65),IROWT(65),IRTN,KTO,ISEQ,MO,MODE1
2 (65),MSEQ,NFIN(65),NINIT(65),NMAX,NNODE,NPRINT(10),NSWTCH,
3 NTERMS,NTRACE,NUMBC,NUMBL,NUMBR,NUMMO,Y(65),YMAX(65),YMIN(65)
4 ,YTERM(65),YTERMH(65),YTERML(65),IDATA
C
C
C
C FOLLOWING ARE COMMON TO ALL SUBROUTINES (2090 WORDS)
C THEY DO NOT MATCHUP IN ALL SUBROUTINES
C
COMMON /MAIN2/VFIRST(50),VSECND(50),VLAST(50),MOBRN(50),
1 MOPARM(50),MOSTEP(50),IWCOUT(4),AX1,MATA(65,4,3),
2 DELTA,ITOL,JX1,JX4,JX5,L,M,EX(65),EB(65),XXX(326)
C
C
C
C FOLLOWING ARE USED INDIVIDUALLY BY LANG.,DC,AC,TR.(918 WORDS)
C
DOUBLE PRECISION SMLEP,CURR,SMLE,EQUCUR
C
COMMON /MAIN3/CURR(65),EQUCUR(50),SMLE(65),SMLEP(50),
1 STDSQ(50),VNOM(50),WCMAX(50),WCMIN(50)
C
C
C
C FOLLOWING ARE USED IN DC AND TR. (5000 WORDS)
C
DOUBLE PRECISION X,ZPRL
C
COMMON /MAIN4/AMPX(65),AMPB(65),YB(65),YX(65),YTERMX(65),
1 YTERMB(65),ZPRL(30,30),X(65),ZZZ(2680)
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)2,4,2
2 WRITE(NDEVO,3)
3 FORMAT(23H DCMOD2-ECA31 ENTERED. )
C
4 IF(ITOL)55,9996,55
55 IF(NPRINT(1)+NPRINT(2)+NPRINT(3)+NPRINT(4)+NPRINT(5)+NPRINT(6)+
1NPRINT(10))511,9996,511
511 LL = IABS(MOPARM(ITOL))
GO TO ( 500, 501, 502, 503 ), LL
500 IF( MOPARM(ITOL) ) 505, 505, 504
501 IF(MOPARM(ITOL))506,505,507
505 MART = 'G'
GO TO 510
504 MART = 'R'
GO TO 510
506 MART = 'GM'
GO TO 510
507 MART = 'BETA'
GO TO 510
502 MART = 'E'
GO TO 510
503 MART = 'I'
510 WRITE(NDEVO,525) MART,VFIRST(ITOL)
525 FORMAT(//1X,A4,2H =,E16.8 )
9996 IF(NTRACE)9998,9999,9998
9998 WRITE(NDEVO, 9997)
9997 FORMAT(20H DCMOD2-ECA31 EXIT. )
9999 RETURN
END