Trailing-Edge
-
PDP-10 Archives
-
decuslib10-09
-
43,50466/ecapac.f4
There are no other files named ecapac.f4 in the archive.
SUBROUTINE ECA40
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 THESE DO NOT MATCHUP TO ALL SUBROUTINES
C
DOUBLE PRECISION EQUCRL,EQUCIM,EPRL,EPIM,CVOLTR,CAMPRL
C
COMMON /MAIN2/VFIRST(50),VSECND(50),VLAST(50),MOBRN(50),
1 MOPARM(50),MOSTEP(50),IWCOUT(4),NLTRMS,OMEGA,IROWM(50),
2 ICOLM(50),FLML(50),FLMH(50),FLM(50),EPHA(65),AMPPHA(65),NREC,
3 EQUCRL(50),EQUCIM(50),CIM(65),ELIM(65),EPRL(50),
4 EPIM(50),ELSAV(65),CVOLTR(65),CAMPRL(65),HNODE,
5 OMGINV,DELTA,ITOL,LL,ITRANS
C
C
C
C FOLLOWING ARE USED INDIVIDUALLY BY LANG.,DC,AC,TR.(918 WORDS)
C
DOUBLE PRECISION CAMPIM,CVOLTI
C
COMMON /MAIN3/FLMSAV(25),IRSAV(25),ICSAV(25),CVOLTI(65),
1 CAMPIM(65),YYY(325)
C
C
C
C FOLLOWING ARE USED IN DC,AC,TR. (5000 WORDS)
C
DOUBLE PRECISION DUM1,DUM2
C
COMMON /MAIN4/DUM1(30,30),DUM2(30,30),ZZZ(1400)
C
C
C
C FOLLOWING ARE USED ONLY IN AC
C
DIMENSION POWRL(65)
C
DOUBLE PRECISION EBIM(150),EBRL(65),BAMPRL(65),BAMPIM(65)
C
EQUIVALENCE (EQUCRL(1),POWRL(1)),(CVOLTI(1),EBIM(1)),
1 (CVOLTR(1),EBRL(1)),(CAMPRL(1),BAMPRL(1)),
2 (CAMPIM(1),BAMPIM(1))
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 ) 998, 997, 998
998 WRITE(NDEVO, 999) IRTN
999 FORMAT(' AC MAINLINE-ECA40 ENTERED. IRTN=',I3 )
997 IF( IRTN - 2 ) 898, 99, 99
898 CALL ECA41
20 CALL ECA42
IF ( IRTN - 2 ) 30,9995,30
30 CALL ECA43
IF ( IRTN - 2 ) 35,9995,35
35 CALL ECA44
CALL ECA45(1)
40 CALL ECA46
CALL ECA45(2)
CALL ECA47
CALL ECA48
CALL ECA49
99 IF(MO) 9996,9996,100
100 CALL ECA53
CALL ECA54
GO TO ( 20, 30, 30 ),ITRANS
9995 IRTN = 1
9996 IF(NTRACE)9997,9999,9997
9997 WRITE(NDEVO, 9998) IRTN
9998 FORMAT(' AC MAINLINE-ECA40 EXIT. IRTN=',I3 )
9999 RETURN
END
SUBROUTINE ECA41
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 THESE DO NOT MATCHUP TO ALL SUBROUTINES
C
DOUBLE PRECISION EQUCRL,EQUCIM,EPRL,EPIM,CVOLTR,CAMPRL
C
COMMON /MAIN2/VFIRST(50),VSECND(50),VLAST(50),MOBRN(50),
1 MOPARM(50),MOSTEP(50),IWCOUT(4),NLTRMS,OMEGA,IROWM(50),
2 ICOLM(50),FLML(50),FLMH(50),FLM(50),EPHA(65),AMPPHA(65),NREC,
3 EQUCRL(50),EQUCIM(50),CIM(65),ELIM(65),EPRL(50),
4 EPIM(50),ELSAV(65),CVOLTR(65),CAMPRL(65),HNODE,
5 OMGINV,DELTA,ITOL,LL,ITRANS
C
C
C
C FOLLOWING ARE USED INDIVIDUALLY BY LANG.,DC,AC,TR.(918 WORDS)
C
DOUBLE PRECISION CAMPIM,CVOLTI
C
COMMON /MAIN3/FLMSAV(25),IRSAV(25),ICSAV(25),CVOLTI(65),
1 CAMPIM(65),YYY(325)
C
C
C
C FOLLOWING ARE USED IN DC,AC,TR. (5000 WORDS)
C
DOUBLE PRECISION DUM1,DUM2
C
COMMON /MAIN4/DUM1(30,30),DUM2(30,30),ZZZ(1400)
C
C
C
C FOLLOWING ARE USED ONLY IN AC
C
DIMENSION POWRL(65)
C
DOUBLE PRECISION EBIM(150),EBRL(65),BAMPRL(65),BAMPIM(65)
C
EQUIVALENCE (EQUCRL(1),POWRL(1)),(CVOLTI(1),EBIM(1)),
1 (CVOLTR(1),EBRL(1)),(CAMPRL(1),BAMPRL(1)),
2 (CAMPIM(1),BAMPIM(1))
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, 997, 2
2 WRITE(NDEVO, 3)
3 FORMAT(14H ECA41 ENTERED)
997 DO 900 J = 1, NMAX
IF ( IABS( MODE1( J )) - 2 ) 800, 801, 802
800 CIM( J ) = Y( J )
ELIM(J)= 0.0
Y(J) = 0.0
GO TO 900
801 CIM( J ) = 0.0
ELIM( J ) = 0.0
GO TO 900
802 ELIM( J ) = Y( J )
CIM(J) = 0.0
Y(J) = 0.0
900 CONTINUE
OMGINV = 1.0 / OMEGA
IF( NLTRMS ) 10, 52, 10
C SAVE MUTUAL TERMS FOR FUTURE MODIFY
10 DO 11 K = 1, NLTRMS
FLMSAV(K) = FLM(K)
IRSAV(K) = IROWM(K)
11 ICSAV(K)=ICOLM(K)
DO 12 K = 1, NMAX
12 ELSAV(K)=ELIM(K)
21 DO 40 L = 1, NLTRMS
LL = L + NLTRMS
FLM(LL) = FLM(L)
IROWM( LL ) = ICOLM( L )
40 ICOLM( LL ) = IROWM( L )
52 DO 1015 J = 1, NMAX
IF( EPHA( J )) 1011, 1012, 1011
1011 ANG = EPHA( J )
C MAGNITUDE * COSINE OF ANG = REAL PART
C MAGNITUDE * SINE OF ANG = IMAG PART
EPHA( J ) = E( J ) * SIN( ANG )
E( J ) = E( J ) * COS( ANG )
1012 IF( AMPPHA( J ))1013, 1015, 1013
1013 ANG = AMPPHA( J )
AMPPHA( J ) = AMP( J ) * SIN( ANG )
AMP( J ) = AMP( J ) * COS( ANG )
1015 CONTINUE
IF(NTRACE)9997,9999,9997
9997 WRITE(NDEVO, 9998 )
9998 FORMAT(11H ECA41 EXIT)
9999 RETURN
END
SUBROUTINE ECA42
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 THESE DO NOT MATCHUP TO ALL SUBROUTINES
C
DOUBLE PRECISION EQUCRL,EQUCIM,EPRL,EPIM,CVOLTR,CAMPRL
C
COMMON /MAIN2/VFIRST(50),VSECND(50),VLAST(50),MOBRN(50),
1 MOPARM(50),MOSTEP(50),IWCOUT(4),NLTRMS,OMEGA,IROWM(50),
2 ICOLM(50),FLML(50),FLMH(50),FLM(50),EPHA(65),AMPPHA(65),NREC,
3 EQUCRL(50),EQUCIM(50),CIM(65),ELIM(65),EPRL(50),
4 EPIM(50),ELSAV(65),CVOLTR(65),CAMPRL(65),HNODE,
5 OMGINV,DELTA,ITOL,LL,ITRANS
C
C
C
C FOLLOWING ARE USED INDIVIDUALLY BY LANG.,DC,AC,TR.(918 WORDS)
C
DOUBLE PRECISION CAMPIM,CVOLTI
C
COMMON /MAIN3/FLMSAV(25),IRSAV(25),ICSAV(25),CVOLTI(65),
1 CAMPIM(65),YYY(325)
C
C
C
C FOLLOWING ARE USED IN DC,AC,TR. (5000 WORDS)
C
DOUBLE PRECISION DUM1,DUM2
C
COMMON /MAIN4/DUM1(30,30),DUM2(30,30),ZZZ(1400)
C
C
C
C FOLLOWING ARE USED ONLY IN AC
C
DIMENSION POWRL(65)
C
DOUBLE PRECISION EBIM(150),EBRL(65),BAMPRL(65),BAMPIM(65)
C
EQUIVALENCE (EQUCRL(1),POWRL(1)),(CVOLTI(1),EBIM(1)),
1 (CVOLTR(1),EBRL(1)),(CAMPRL(1),BAMPRL(1)),
2 (CAMPIM(1),BAMPIM(1))
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
DIMENSION MOBR(50)
DOUBLE PRECISION FWK(50),FWKA(50),TEMPA,TEMPB,ZPRL(30,30)
EQUIVALENCE (MOBR(1),ZZZ(1)),(FWK(1),ZZZ(51)),(FWKA(1),ZZZ(151))
1 ,(DUM1(1,1),ZPRL(1,1))
C INVERT + RCSTOR COMBINED
IRTN=1
IF(NTRACE) 41, 42, 41
41 WRITE(NDEVO, 40)
40 FORMAT(14H ECA42 ENTERED)
42 IF(NLTRMS) 43,20,43
43 N=0
DO 100 I = 1, NUMBL
DO 100 J = 1, NUMBL
100 ZPRL( I, J )= 0.0
NEQUIM=NLTRMS+NLTRMS
DO 3 NM = 1, NMAX
IF( MODE1(NM) - 3 ) 3, 2, 3
2 N = N + 1
MOBR ( N ) = NM
ZPRL( N, N ) = ELIM( NM )
3 CONTINUE
IF( N - NUMBL ) 19, 21, 19
21 DO 14 L = 1, NEQUIM
J = 0
DO 8 K = 1, NMAX
IF( MODE1(K) - 3 ) 8, 4, 8
4 J = J + 1
IF( IROWM( L ) - K ) 6, 5, 6
5 IR = J
GO TO 8
6 IF( ICOLM( L ) - K ) 8, 7, 8
7 IC = J
8 CONTINUE
TEMPA = 1.0/( ZPRL( IC, IR ) + 1.0/FLM ( L ))
DO 9 M = 1, J
FWK( M ) = ZPRL( M, IR )
9 FWKA( M ) = ZPRL( IC, M )
DO 13 M = 1, J
IF( ZPRL( M, IR )) 10, 13, 10
10 TEMPB = TEMPA * FWK( M )
DO 12 N = 1, J
IF( ZPRL( IC, N )) 11, 12, 11
11 ZPRL( M, N ) = ZPRL( M, N ) - TEMPB * FWKA( N )
12 CONTINUE
13 CONTINUE
14 CONTINUE
N = 0
DO 16 NM = 1, NMAX
IF( MODE1(NM) - 3 ) 16, 15, 16
15 N = N + 1
ELIM( NM ) = ZPRL( N, N )
16 CONTINUE
IF( N - NUMBL ) 19, 22, 19
22 L = 0
DO 18 N=1,NUMBL
DO 18 M=1,NUMBL
IF(N-M) 17,18,17
17 IF(ZPRL(N,M)) 31,18,31
31 L=L+1
FLM(L) = ZPRL(N,M)
IROWM ( L ) = MOBR ( N )
ICOLM ( L ) = MOBR ( M )
18 CONTINUE
IF( L - NUMBL * ( NUMBL - 1 ))20, 20, 19
19 WRITE(IDLG, 30 )
30 FORMAT(10H ERROR AC1 / 20H EXECUTION INHIBITED )
IRTN=2
20 IF(NTRACE)9997,9999,9997
9997 WRITE(NDEVO, 9998) IRTN
9998 FORMAT(' ECA42 EXIT. IRTN=',I3 )
9999 RETURN
END
SUBROUTINE ECA43
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 THESE DO NOT MATCHUP TO ALL SUBROUTINES
C
DOUBLE PRECISION EQUCRL,EQUCIM,EPRL,EPIM,CVOLTR,CAMPRL
C
COMMON /MAIN2/VFIRST(50),VSECND(50),VLAST(50),MOBRN(50),
1 MOPARM(50),MOSTEP(50),IWCOUT(4),NLTRMS,OMEGA,IROWM(50),
2 ICOLM(50),FLML(50),FLMH(50),FLM(50),EPHA(65),AMPPHA(65),NREC,
3 EQUCRL(50),EQUCIM(50),CIM(65),ELIM(65),EPRL(50),
4 EPIM(50),ELSAV(65),CVOLTR(65),CAMPRL(65),HNODE,
5 OMGINV,DELTA,ITOL,LL,ITRANS
C
C
C
C FOLLOWING ARE USED INDIVIDUALLY BY LANG.,DC,AC,TR.(918 WORDS)
C
DOUBLE PRECISION CAMPIM,CVOLTI
C
COMMON /MAIN3/FLMSAV(25),IRSAV(25),ICSAV(25),CVOLTI(65),
1 CAMPIM(65),YYY(325)
C
C
C
C FOLLOWING ARE USED IN DC,AC,TR. (5000 WORDS)
C
DOUBLE PRECISION DUM1,DUM2
C
COMMON /MAIN4/DUM1(30,30),DUM2(30,30),ZZZ(1400)
C
C
C
C FOLLOWING ARE USED ONLY IN AC
C
DIMENSION POWRL(65)
C
DOUBLE PRECISION EBIM(150),EBRL(65),BAMPRL(65),BAMPIM(65)
C
EQUIVALENCE (EQUCRL(1),POWRL(1)),(CVOLTI(1),EBIM(1)),
1 (CVOLTR(1),EBRL(1)),(CAMPRL(1),BAMPRL(1)),
2 (CAMPIM(1),BAMPIM(1))
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 TRIPRO AC
IRTN=1
1 IF(NTRACE) 11,3,11
11 WRITE(NDEVO, 2)
2 FORMAT(14H ECA43 ENTERED)
3 DO 10 J= 1, NNODE
DO 10 K = 1, NNODE
DUM1(J,K)=0.0
10 DUM2(J,K) =0.0
DO 20 I = 1, NMAX
NI = NINIT( I )
NF = NFIN( I )
IF( NI ) 21, 22, 21
21 IF( NF ) 24, 25, 24
22 IF( NF ) 23, 500, 23
25 NF = NI
23 IF ( IABS( MODE1( I ))- 2 ) 26, 27, 28
26 DUM2( NF, NF ) = DUM2( NF, NF ) + OMEGA * CIM( I )
GO TO 20
27 DUM1( NF, NF ) = DUM1( NF, NF ) + Y( I )
GO TO 20
28 DUM2( NF, NF ) = DUM2( NF, NF ) -OMGINV * ELIM( I )
GO TO 20
24 IF ( IABS( MODE1( I ))- 2 ) 29, 30, 31
29 PROD = OMEGA * CIM( I )
DUM2( NI, NI ) = DUM2( NI, NI ) + PROD
DUM2( NI, NF ) = DUM2( NI, NF ) - PROD
DUM2( NF, NI ) = DUM2( NF, NI ) - PROD
GO TO 26
30 DUM1( NI, NI ) = DUM1( NI, NI ) + Y( I )
DUM1( NI, NF ) = DUM1( NI, NF ) - Y( I )
DUM1( NF, NI ) = DUM1( NF, NI ) - Y( I )
GO TO 27
31 PROD = OMGINV * ELIM( I )
DUM2( NI, NI ) = DUM2( NI, NI ) - PROD
DUM2( NI, NF ) = DUM2( NI, NF ) + PROD
DUM2( NF, NI ) = DUM2( NF, NI ) + PROD
GO TO 28
20 CONTINUE
GO TO 601
500 WRITE(IDLG, 501 )
501 FORMAT(10H ERROR AC2 / 20H EXECUTION INHIBITED )
IRTN=2
601 IF(NTRACE) 9997,9999,9997
9997 WRITE(NDEVO, 9998) IRTN
9998 FORMAT(' ECA43 EXIT. IRTN=',I3 )
9999 RETURN
END
SUBROUTINE ECA44
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 THESE DO NOT MATCHUP TO ALL SUBROUTINES
C
DOUBLE PRECISION EQUCRL,EQUCIM,EPRL,EPIM,CVOLTR,CAMPRL
C
COMMON /MAIN2/VFIRST(50),VSECND(50),VLAST(50),MOBRN(50),
1 MOPARM(50),MOSTEP(50),IWCOUT(4),NLTRMS,OMEGA,IROWM(50),
2 ICOLM(50),FLML(50),FLMH(50),FLM(50),EPHA(65),AMPPHA(65),NREC,
3 EQUCRL(50),EQUCIM(50),CIM(65),ELIM(65),EPRL(50),
4 EPIM(50),ELSAV(65),CVOLTR(65),CAMPRL(65),HNODE,
5 OMGINV,DELTA,ITOL,LL,ITRANS
C
C
C
C FOLLOWING ARE USED INDIVIDUALLY BY LANG.,DC,AC,TR.(918 WORDS)
C
DOUBLE PRECISION CAMPIM,CVOLTI
C
COMMON /MAIN3/FLMSAV(25),IRSAV(25),ICSAV(25),CVOLTI(65),
1 CAMPIM(65),YYY(325)
C
C
C
C FOLLOWING ARE USED IN DC,AC,TR. (5000 WORDS)
C
DOUBLE PRECISION DUM1,DUM2
C
COMMON /MAIN4/DUM1(30,30),DUM2(30,30),ZZZ(1400)
C
C
C
C FOLLOWING ARE USED ONLY IN AC
C
DIMENSION POWRL(65)
C
DOUBLE PRECISION EBIM(150),EBRL(65),BAMPRL(65),BAMPIM(65)
C
EQUIVALENCE (EQUCRL(1),POWRL(1)),(CVOLTI(1),EBIM(1)),
1 (CVOLTR(1),EBRL(1)),(CAMPRL(1),BAMPRL(1)),
2 (CAMPIM(1),BAMPIM(1))
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 SPARSE AC
1 IF(NTRACE) 11,2,11
11 WRITE(NDEVO, 3)
3 FORMAT(14H ECA44 ENTERED)
2 KK = 0
NSUB = NTERMS
1000 IF( NSUB ) 900, 901, 900
900 DO 930 N = 1, NSUB
IF( KK - 1 ) 800, 801, 802
C KK = 0 @@T@@ CARD
C KK = 1 @@M@@ CARD
C KK = 2 @@RETURN@@
800 LR = IROWT( N )
KC = ICOLT( N )
GO TO 850
801 LR = IROWM( N )
KC = ICOLM( N )
850 NI1 = NINIT( LR )
NF1 = NFIN( LR )
NI2 = NINIT( KC )
NF2 = NFIN( KC )
IF( NI1 ) 101, 102, 101
101 IF( NI2 ) 103, 110, 103
103 IF( KK - 1 ) 51, 52, 802
102 IF( NF1 ) 104, 930, 104
104 IF( NI2 ) 105, 120, 105
105 IF( KK - 1 ) 61, 62, 802
120 IF( NF2 ) 106, 930, 106
106 IF( KK - 1 ) 71, 72, 802
110 IF( NF2 ) 107, 102, 107
107 IF( KK - 1 ) 81, 82, 802
C CORRECTION TERMS NI1 + NI2
51 DUM1( NI1, NI2 ) = DUM1( NI1, NI2 ) + YTERM( N )
GO TO 110
52 DUM2( NI1, NI2 ) = DUM2( NI1 , NI2 ) - OMGINV * FLM( N )
GO TO 110
C CORRECTION TERMS NF1 + NI2
61 DUM1( NF1, NI2 ) = DUM1( NF1, NI2 ) - YTERM( N )
GO TO 120
62 DUM2( NF1, NI2 ) = DUM2( NF1, NI2 ) + OMGINV * FLM( N )
GO TO 120
C CORRECTION TERMS NF1 + NF2
71 DUM1( NF1, NF2 ) = DUM1( NF1, NF2 ) + YTERM( N )
GO TO 930
72 DUM2( NF1, NF2 ) = DUM2( NF1, NF2 ) - OMGINV * FLM( N )
GO TO 930
C CORRECTION TERMS NI1, NF2
81 DUM1( NI1, NF2 ) = DUM1( NI1, NF2 ) - YTERM( N )
GO TO 102
82 DUM2( NI1, NF2 ) = DUM2( NI1, NF2 ) + OMGINV * FLM( N )
GO TO 102
930 CONTINUE
901 IF( KK - 1 ) 700, 802, 802
700 KK = 1
NSUB=NLTRMS+NLTRMS
GO TO 1000
802 CONTINUE
IF(NTRACE)9997,9999,9997
9997 WRITE(NDEVO, 9998)
9998 FORMAT(11H ECA44 EXIT)
9999 RETURN
END
SUBROUTINE ECA45(IA)
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 THESE DO NOT MATCHUP TO ALL SUBROUTINES
C
DOUBLE PRECISION EQUCRL,EQUCIM,EPRL,EPIM,CVOLTR,CAMPRL
C
COMMON /MAIN2/VFIRST(50),VSECND(50),VLAST(50),MOBRN(50),
1 MOPARM(50),MOSTEP(50),IWCOUT(4),NLTRMS,OMEGA,IROWM(50),
2 ICOLM(50),FLML(50),FLMH(50),FLM(50),EPHA(65),AMPPHA(65),NREC,
3 EQUCRL(50),EQUCIM(50),CIM(65),ELIM(65),EPRL(50),
4 EPIM(50),ELSAV(65),CVOLTR(65),CAMPRL(65),HNODE,
5 OMGINV,DELTA,ITOL,LL,ITRANS
C
C
C
C FOLLOWING ARE USED INDIVIDUALLY BY LANG.,DC,AC,TR.(918 WORDS)
C
DOUBLE PRECISION CAMPIM,CVOLTI
C
COMMON /MAIN3/FLMSAV(25),IRSAV(25),ICSAV(25),CVOLTI(65),
1 CAMPIM(65),YYY(325)
C
C
C
C FOLLOWING ARE USED IN DC,AC,TR. (5000 WORDS)
C
DOUBLE PRECISION DUM1,DUM2
C
COMMON /MAIN4/DUM1(30,30),DUM2(30,30),ZZZ(1400)
C
C
C
C FOLLOWING ARE USED ONLY IN AC
C
DIMENSION POWRL(65)
C
DOUBLE PRECISION EBIM(150),EBRL(65),BAMPRL(65),BAMPIM(65)
C
EQUIVALENCE (EQUCRL(1),POWRL(1)),(CVOLTI(1),EBIM(1)),
1 (CVOLTR(1),EBRL(1)),(CAMPRL(1),BAMPRL(1)),
2 (CAMPIM(1),BAMPIM(1))
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,44,2
2 WRITE(NDEVO, 3)
3 FORMAT(14H ECA45 ENTERED)
44 IF( NPRINT( 10 ) ) 4, 9996, 4
100 FORMAT(// 6X 3HROW, 4X 3HCOL)
101 FORMAT(5X 4HNODE, 3X 4HNODE, 10X 24H NODAL ADMITTANCE MATRIX // )
102 FORMAT( // 6X 5HNODES, 10X 26H EQUIVALENT CURRENT VECTOR //)
103 FORMAT(1X4HREAL, 1X I2, 1X I2, 1H-, I2, 4(E14.7))
104 FORMAT(1X4HIMAG, 9X 4(E14.7)//)
105 FORMAT(1X4HREAL, 1X I2, 1H-, I2, 4(E14.7))
106 FORMAT(1X4HIMAG, 6X 4(E14.7)//)
4 GO TO (30, 36 ), IA
30 WRITE(NDEVO, 100 )
WRITE(NDEVO, 101 )
36 DO 22 J=1,NNODE
LAST = 0
5 K=LAST+1
LAST = LAST +4
IF(LAST - NNODE)7,7,6
6 LAST = NNODE
7 GO TO ( 15, 16 ), IA
C WRIT NODAL ADMITTANCE MATRIX
15 WRITE(NDEVO, 103 ) J, K, LAST, (DUM1 (J, N ), N = K, LAST )
WRITE(NDEVO, 104 ) ( DUM2( J, N ), N = K, LAST )
GO TO 20
16 WRITE(NDEVO, 102 )
WRITE(NDEVO, 105 ) K, LAST, ( EQUCRL( N ), N = K, LAST )
WRITE(NDEVO, 106 ) ( EQUCIM( N ), N = K, LAST )
20 IF(LAST-NNODE)5,21,21
21 GO TO ( 22, 9996 ), IA
22 CONTINUE
9996 IF(NTRACE)9997,9999,9997
9997 WRITE(NDEVO, 9998)
9998 FORMAT(11H ECA45 EXIT )
9999 RETURN
END
SUBROUTINE ECA46
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 THESE DO NOT MATCHUP TO ALL SUBROUTINES
C
DOUBLE PRECISION EQUCRL,EQUCIM,EPRL,EPIM,CVOLTR,CAMPRL
C
COMMON /MAIN2/VFIRST(50),VSECND(50),VLAST(50),MOBRN(50),
1 MOPARM(50),MOSTEP(50),IWCOUT(4),NLTRMS,OMEGA,IROWM(50),
2 ICOLM(50),FLML(50),FLMH(50),FLM(50),EPHA(65),AMPPHA(65),NREC,
3 EQUCRL(50),EQUCIM(50),CIM(65),ELIM(65),EPRL(50),
4 EPIM(50),ELSAV(65),CVOLTR(65),CAMPRL(65),HNODE,
5 OMGINV,DELTA,ITOL,LL,ITRANS
C
C
C
C FOLLOWING ARE USED INDIVIDUALLY BY LANG.,DC,AC,TR.(918 WORDS)
C
DOUBLE PRECISION CAMPIM,CVOLTI
C
COMMON /MAIN3/FLMSAV(25),IRSAV(25),ICSAV(25),CVOLTI(65),
1 CAMPIM(65),YYY(325)
C
C
C
C FOLLOWING ARE USED IN DC,AC,TR. (5000 WORDS)
C
DOUBLE PRECISION DUM1,DUM2
C
COMMON /MAIN4/DUM1(30,30),DUM2(30,30),ZZZ(1400)
C
C
C
C FOLLOWING ARE USED ONLY IN AC
C
DIMENSION POWRL(65)
C
DOUBLE PRECISION EBIM(150),EBRL(65),BAMPRL(65),BAMPIM(65)
C
EQUIVALENCE (EQUCRL(1),POWRL(1)),(CVOLTI(1),EBIM(1)),
1 (CVOLTR(1),EBRL(1)),(CAMPRL(1),BAMPRL(1)),
2 (CAMPIM(1),BAMPIM(1))
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 ACECA / ACECB - LMVBM
1 IF(NTRACE) 11,3,11
11 WRITE(NDEVO, 2)
2 FORMAT(14H ECA46 ENTERED)
3 DO 4000 I = 1, NMAX
BAMPRL(I) = Y(I)*E(I)-(CIM(I)*OMEGA - ELIM(I)*OMGINV)*EPHA(I)
1 - AMP(I)
4000 BAMPIM(I) = Y(I)*EPHA(I)+(CIM(I)*OMEGA - ELIM(I)*OMGINV)*E(I)
1 - AMPPHA(I)
IF(NTERMS) 9000,9000,7500
7500 DO 8000 I = 1, NTERMS
L=ICOLT(I)
LL=IROWT(I)
BAMPRL(LL)=BAMPRL(LL)+YTERM(I)*E(L)
8000 BAMPIM(LL)=BAMPIM(LL)+YTERM(I)*EPHA(L)
9000 IF(NLTRMS)9099,9099,9001
9001 NEQUIM=NLTRMS+NLTRMS
DO 9098 I=1,NEQUIM
L=ICOLM(I)
LL=IROWM(I)
BAMPRL(LL)=BAMPRL(LL)+FLM(I)*EPHA(L)*OMGINV
9098 BAMPIM(LL)=BAMPIM(LL)-FLM(I)*E(L)*OMGINV
9099 DO 9100 K=1,NNODE
EQUCIM(K)=0.0
9100 EQUCRL(K)=0.0
DO 9500 I=1,NMAX
NI=NINIT(I)
NF=NFIN(I)
IF(NI)9300,9300,9200
9200 EQUCRL(NI)=EQUCRL(NI)-BAMPRL(I)
EQUCIM(NI)=EQUCIM(NI)-BAMPIM(I)
9300 IF(NF)9500,9500,9400
9400 EQUCRL(NF)=EQUCRL(NF)+BAMPRL(I)
EQUCIM(NF)=EQUCIM(NF)+BAMPIM(I)
9500 CONTINUE
IF(NTRACE) 9997,9999,9997
9997 WRITE(NDEVO,9998)
9998 FORMAT(11H ECA46 EXIT)
9999 RETURN
END
SUBROUTINE ECA47
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 THESE DO NOT MATCHUP TO ALL SUBROUTINES
C
DOUBLE PRECISION EQUCRL,EQUCIM,EPRL,EPIM,CVOLTR,CAMPRL
C
COMMON /MAIN2/VFIRST(50),VSECND(50),VLAST(50),MOBRN(50),
1 MOPARM(50),MOSTEP(50),IWCOUT(4),NLTRMS,OMEGA,IROWM(50),
2 ICOLM(50),FLML(50),FLMH(50),FLM(50),EPHA(65),AMPPHA(65),NREC,
3 EQUCRL(50),EQUCIM(50),CIM(65),ELIM(65),EPRL(50),
4 EPIM(50),ELSAV(65),CVOLTR(65),CAMPRL(65),HNODE,
5 OMGINV,DELTA,ITOL,LL,ITRANS
C
C
C
C FOLLOWING ARE USED INDIVIDUALLY BY LANG.,DC,AC,TR.(918 WORDS)
C
DOUBLE PRECISION CAMPIM,CVOLTI
C
COMMON /MAIN3/FLMSAV(25),IRSAV(25),ICSAV(25),CVOLTI(65),
1 CAMPIM(65),YYY(325)
C
C
C
C FOLLOWING ARE USED IN DC,AC,TR. (5000 WORDS)
C
DOUBLE PRECISION DUM1,DUM2
C
COMMON /MAIN4/DUM1(30,30),DUM2(30,30),ZZZ(1400)
C
C
C
C FOLLOWING ARE USED ONLY IN AC
C
DIMENSION POWRL(65)
C
DOUBLE PRECISION EBIM(150),EBRL(65),BAMPRL(65),BAMPIM(65)
C
EQUIVALENCE (EQUCRL(1),POWRL(1)),(CVOLTI(1),EBIM(1)),
1 (CVOLTR(1),EBRL(1)),(CAMPRL(1),BAMPRL(1)),
2 (CAMPIM(1),BAMPIM(1))
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 AR(30,30),AI(30,30),BR(50),BI(50),XR(50),XI(50)
1 ,TR,TI,T,T1R,T1I
EQUIVALENCE (AR(1,1),DUM1(1,1)),(AI(1,1),DUM2(1,1))
1 ,(BR(1),EQUCRL(1)),(BI(1),EQUCIM(1)),(XR(1),EPRL(1))
2 ,(XI(1),EPIM(1)),(NA,NNODE)
C COMPLEX SOLUTIONS
N = NA
1 IF (NTRACE) 899,901,899
899 WRITE(NDEVO,900)
900 FORMAT(14H ECA47 ENTERED)
C CHECK FOR SINGLE NON-DATUM NODE
901 IF(N-1) 40,40,41
41 TR=1.0/(AR(1,1) * AR(1,1) + AI(1,1) * AI(1,1))
TI = -AI( 1,1 ) * TR
TR = AR( 1,1 ) * TR
DO 111 J=2,N
T = AR( 1,J ) * TR - AI( 1,J ) * TI
AI( 1,J )=AR( 1,J ) * TI + AI( 1,J ) * TR
111 AR( 1,J ) = T
C CONSTANT VECTOR ELEMENT
T = BR( 1 ) * TR - BI( 1 ) * TI
BI( 1 ) = BR( 1 ) * TI + BI ( 1 ) * TR
BR( 1 ) = T
DO 7 L = 2, N
LM1 = L - 1
LP1 = L + 1
J = L
DO 3 I = J, N
TR = 0.
TI = 0.
DO 2 K = 1, LM1
TR = AR( I,K ) * AR( K,J ) - AI( I,K ) * AI( K, J ) + TR
2 TI = AR( I,K ) * AI( K,J ) + AI( I,K ) * AR( K,J )+TI
AR( I,J ) = AR( I,J ) - TR
3 AI( I,J ) = AI( I,J ) - TI
C
I = L
TR = 1.0 / ( AR( I,I ) * AR( I,I ) + AI( I,I ) * AI( I,I ))
TI = - AI( I,I ) * TR
TR = AR( I,I ) * TR
IF ( N - LP1 ) 60, 50, 50
50 DO 5 J = LP1, N
T1R = 0.0
T1I = 0.0
DO 4 K = 1, LM1
T1R = T1R + AR( I,K ) * AR( K,J ) - AI( I,K ) * AI( K,J )
4 T1I = T1I + AR( I,K ) * AI( K,J ) + AI( I,K ) * AR( K,J )
AR( I,J ) = AR( I,J ) - T1R
AI( I,J ) = AI( I,J ) - T1I
T = AR(I,J) *TR - AI(I,J) * TI
AI( I,J ) = AR( I,J ) * TI + AI( I,J ) * TR
5 AR( I,J ) = T
60 T1R = 0.0
T1I = 0.0
DO 6 K = 1, LM1
T1R = T1R + AR( I,K ) * BR( K ) - AI( I,K ) * BI( K )
6 T1I = T1I + AR( I,K ) * BI( K ) + AI( I,K ) * BR( K )
BR( I ) = BR( I ) - T1R
BI( I ) = BI( I ) - T1I
T = BR( I ) * TR - BI( I ) * TI
BI( I ) = BR( I ) * TI + BI( I) * TR
BR( I ) = T
7 CONTINUE
40 IF(NTRACE) 9997,9999,9997
9997 WRITE(NDEVO, 9998)
9998 FORMAT(11H ECA47 EXIT)
9999 RETURN
END
SUBROUTINE ECA48
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 THESE DO NOT MATCHUP TO ALL SUBROUTINES
C
DOUBLE PRECISION EQUCRL,EQUCIM,EPRL,EPIM,CVOLTR,CAMPRL
C
COMMON /MAIN2/VFIRST(50),VSECND(50),VLAST(50),MOBRN(50),
1 MOPARM(50),MOSTEP(50),IWCOUT(4),NLTRMS,OMEGA,IROWM(50),
2 ICOLM(50),FLML(50),FLMH(50),FLM(50),EPHA(65),AMPPHA(65),NREC,
3 EQUCRL(50),EQUCIM(50),CIM(65),ELIM(65),EPRL(50),
4 EPIM(50),ELSAV(65),CVOLTR(65),CAMPRL(65),HNODE,
5 OMGINV,DELTA,ITOL,LL,ITRANS
C
C
C
C FOLLOWING ARE USED INDIVIDUALLY BY LANG.,DC,AC,TR.(918 WORDS)
C
DOUBLE PRECISION CAMPIM,CVOLTI
C
COMMON /MAIN3/FLMSAV(25),IRSAV(25),ICSAV(25),CVOLTI(65),
1 CAMPIM(65),YYY(325)
C
C
C
C FOLLOWING ARE USED IN DC,AC,TR. (5000 WORDS)
C
DOUBLE PRECISION DUM1,DUM2
C
COMMON /MAIN4/DUM1(30,30),DUM2(30,30),ZZZ(1400)
C
C
C
C FOLLOWING ARE USED ONLY IN AC
C
DIMENSION POWRL(65)
C
DOUBLE PRECISION EBIM(150),EBRL(65),BAMPRL(65),BAMPIM(65)
C
EQUIVALENCE (EQUCRL(1),POWRL(1)),(CVOLTI(1),EBIM(1)),
1 (CVOLTR(1),EBRL(1)),(CAMPRL(1),BAMPRL(1)),
2 (CAMPIM(1),BAMPIM(1))
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 AR(30,30),AI(30,30),BR(50),BI(50),XR(50),XI(50)
1 ,TR,TI
EQUIVALENCE (DUM1(1,1),AR(1,1)),(DUM2(1,1),AI(1,1))
1 ,(EQUCRL(1),BR(1)),(EQUCIM(1),BI(1)),
2 (EPRL(1),XR(1)),(EPIM(1),XI(1)),(NA,NNODE)
C BACK SUBSTITUTION
N = NA
IF ( NTRACE ) 4, 4, 2
2 WRITE(NDEVO, 3)
3 FORMAT(14H ECA48 ENTERED)
4 IF(N-1) 40,40,41
41 XR( N ) = BR( N )
XI( N ) = BI( N )
DO 9 L = 2, N
I = N - L + 1
IP1 = I + 1
TR = 0.0
TI = 0.0
DO 8 K = IP1, N
TR = TR + AR( I,K ) * XR( K ) - AI( I,K ) * XI( K )
8 TI = TI + AR( I,K ) * XI( K ) + AI( I,K ) * XR( K )
XR( I ) = BR( I ) - TR
XI( I ) = BI( I ) - TI
9 CONTINUE
GO TO 10
C CALCULATION OF SINGLE NODE VOLTAGE
40 TR = AR( 1, 1) * AR( 1, 1) + AI( 1, 1) * AI( 1, 1)
XR(1)=(BR(1)*AR(1,1) + BI(1)*AI(1,1))/TR
XI(1)=(BI(1)*AR(1,1) - BR(1)*AI(1,1))/TR
10 IF(NTRACE)9997,9999,9997
9997 WRITE(NDEVO, 9998)
9998 FORMAT(11H ECA48 EXIT)
9999 RETURN
END
SUBROUTINE ECA49
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 THESE DO NOT MATCHUP TO ALL SUBROUTINES
C
DOUBLE PRECISION EQUCRL,EQUCIM,EPRL,EPIM,CVOLTR,CAMPRL
C
COMMON /MAIN2/VFIRST(50),VSECND(50),VLAST(50),MOBRN(50),
1 MOPARM(50),MOSTEP(50),IWCOUT(4),NLTRMS,OMEGA,IROWM(50),
2 ICOLM(50),FLML(50),FLMH(50),FLM(50),EPHA(65),AMPPHA(65),NREC,
3 EQUCRL(50),EQUCIM(50),CIM(65),ELIM(65),EPRL(50),
4 EPIM(50),ELSAV(65),CVOLTR(65),CAMPRL(65),HNODE,
5 OMGINV,DELTA,ITOL,LL,ITRANS
C
C
C
C FOLLOWING ARE USED INDIVIDUALLY BY LANG.,DC,AC,TR.(918 WORDS)
C
DOUBLE PRECISION CAMPIM,CVOLTI
C
COMMON /MAIN3/FLMSAV(25),IRSAV(25),ICSAV(25),CVOLTI(65),
1 CAMPIM(65),YYY(325)
C
C
C
C FOLLOWING ARE USED IN DC,AC,TR. (5000 WORDS)
C
DOUBLE PRECISION DUM1,DUM2
C
COMMON /MAIN4/DUM1(30,30),DUM2(30,30),ZZZ(1400)
C
C
C
C FOLLOWING ARE USED ONLY IN AC
C
DIMENSION POWRL(65)
C
DOUBLE PRECISION EBIM(150),EBRL(65),BAMPRL(65),BAMPIM(65)
C
EQUIVALENCE (EQUCRL(1),POWRL(1)),(CVOLTI(1),EBIM(1)),
1 (CVOLTR(1),EBRL(1)),(CAMPRL(1),BAMPRL(1)),
2 (CAMPIM(1),BAMPIM(1))
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
DIMENSION XR(65),XI(65)
EQUIVALENCE (ZZZ(251),XR(1)),(ZZZ(376),XI(1))
DOUBLE PRECISION LINE(0/13)
DIMENSION OUTPUT(60,12),ICONT(6)
EQUIVALENCE (LINE(0),ZZZ(630)),(ICONT(1),ZZZ(658)),(
1OUTPUT(1,1),ZZZ(664))
1 IF(NTRACE) 22,44,22
22 WRITE(NDEVO, 33)
33 FORMAT(14H ECA49 ENTERED)
44 DO 850 I=630,1400
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(NPRINT(1)+NPRINT(2)+NPRINT(3)+NPRINT(4)+NPRINT(5)+NPRINT(6)
1+NPRINT(10)) 740,741,740
740 FREQ=OMEGA/6.283185
WRITE(NDEVO,742) FREQ
IF(IDATA.EQ.1) WRITE(20,840) FREQ
742 FORMAT(///' FREQ=',1PG15.8/)
741 CALL ECA50(EPRL,EPIM,NNODE,XR,XI)
C
CODING TO OUTPUT NODE VOLTAGES
C
IF(NPRINT(1)) 601,601,599
599 NUMC=NUMC+1
ICONT(NUMC)=1
DO 605 I=1,NNODE
OUTPUT(I,NUMC)=XR(I)
605 OUTPUT(I,NUMC+6)=XI(I)
C
CODING TO OUTPUT BRANCH VOLTAGES
C
601 DO 5 J = 1, NMAX
EBRL( J ) = 0.0
EBIM( J ) = 0.0
NI = NINIT( J )
NF = NFIN( J )
IF( NI ) 2, 3, 2
2 EBRL( J ) = EPRL( NI )
EBIM( J ) = EPIM( NI )
3 IF( NF ) 4, 5, 4
4 EBRL( J ) = EBRL( J ) - EPRL( NF )
EBIM( J ) = EBIM( J ) - EPIM( NF )
5 CONTINUE
CALL ECA50(EBRL,EBIM,NMAX,XR,XI)
IF(NPRINT(5)) 602,602,615
615 NUMC=NUMC+1
ICONT(NUMC)=2
DO 616 I=1,NMAX
OUTPUT(I,NUMC)=XR(I)
616 OUTPUT(I,NUMC+6)=XI(I)
C
CODING TO OUTPUT ELEMENT VOLTAGES
C
602 DO 100 N = 1, NMAX
CVOLTR( N ) = EBRL( N ) + E( N )
CVOLTI( N ) = EBIM( N ) + EPHA( N )
IF ( IABS( MODE1( N )) - 2 ) 90, 91, 92
90 CAMPRL( N ) = - CIM( N ) * OMEGA * CVOLTI( N )
CAMPIM( N ) = CIM( N ) * OMEGA * CVOLTR( N )
GO TO 100
91 CAMPRL( N ) = Y( N ) * CVOLTR ( N )
CAMPIM( N ) = Y( N ) * CVOLTI( N )
GO TO 100
92 CAMPRL( N ) = ELIM( N ) * OMGINV * CVOLTI( N )
CAMPIM( N ) = - ELIM( N ) * OMGINV * CVOLTR( N )
100 CONTINUE
CALL ECA50(CVOLTR,CVOLTI,NMAX,XR,XI)
IF(NPRINT(3)) 603,603,618
618 NUMC=NUMC+1
ICONT(NUMC)=5
DO 619 I=1,NMAX
OUTPUT(I,NUMC)=XR(I)
619 OUTPUT(I,NUMC+6)=XI(I)
C
CODING TO OUTPUT ELEMENT CURRENTS
C
603 K = 0
NSUB = NTERMS
101 IF( NSUB ) 102, 200, 102
102 DO 199 M = 1, NSUB
IF( K ) 103, 104, 103
103 NR = IROWM( M )
NC = ICOLM( M )
GO TO 106
104 NR = IROWT( M )
NC = ICOLT( M )
IF( CVOLTR( NC )) 110, 199, 110
110 CAMPRL( NR ) = CAMPRL( NR ) + YTERM( M ) * CVOLTR( NC )
CAMPIM( NR ) = CAMPIM( NR ) + YTERM( M ) * CVOLTI( NC )
GO TO 199
106 IF( CVOLTR( NC )) 120, 199, 120
120 CAMPRL(NR) = CAMPRL(NR) + FLM(M) * OMGINV * CVOLTI(NC)
CAMPIM( NR ) = CAMPIM( NR ) - FLM( M ) * OMGINV * CVOLTR( NC )
199 CONTINUE
200 IF(K) 202,201,202
201 K= 1
NSUB = NLTRMS + NLTRMS
GO TO 101
202 CALL ECA50(CAMPRL,CAMPIM,NMAX,XR,XI)
IF(NPRINT(2)) 604,604,626
626 NUMC=NUMC+1
ICONT(NUMC)=6
DO 627 I=1,NMAX
OUTPUT(I,NUMC)=XR(I)
627 OUTPUT(I,NUMC+6)=XI(I)
C
CODING TO OUTPUT BRANCH POWER
C
604 DO 299 N= 1, NMAX
POWRL( N ) = CVOLTR( N ) * CAMPRL( N ) + CVOLTI( N ) * CAMPIM( N )
BAMPIM( N ) = CAMPIM( N ) - AMPPHA( N )
299 BAMPRL( N ) = CAMPRL( N ) - AMP( N )
IF(NPRINT(6)) 655,655,628
628 NUMC=NUMC+1
ICONT(NUMC)=4
DO 629 I=1,NMAX
629 OUTPUT(I,NUMC)=POWRL(I)
C
CODING TO OUTPUT BRANCH CURRENTS
C
655 DO 300 K = 1, NNODE
XR(K) = 0.0
300 XI(K) = 0.0
DO 304 I = 1,NMAX
NI = NINIT(I)
NF = NFIN(I)
IF(NI) 302,302,301
301 XR(NI) = XR(NI) - BAMPRL(I)
XI(NI)=XI(NI)-BAMPIM(I)
302 IF(NF) 304,304,303
303 XR(NF) = XR(NF) + BAMPRL(I)
XI(NF) = XI(NF) + BAMPIM(I)
304 CONTINUE
SUMR=0.0
SUMI=0.0
NEQUIM=NPRINT(4)
DO 305 I = 1, NNODE
SUMR = SUMR + ABS( XR(I))
305 SUMI = SUMI + ABS( XI(I))
IF(SUMR - ERROR1)306,306,307
306 IF(SUMI - ERROR1)308,308,307
307 NPRINT(4) = 1
CALL ECA51(11)
CALL ECA52(11,XR,XI)
308 IF(NPRINT(4)) 855,856,855
855 CALL ECA50(BAMPRL,BAMPIM,NMAX,XR,XI)
NUMC=NUMC+1
ICONT(NUMC)=3
DO 860 I=1,NMAX
OUTPUT(I,NUMC)=XR(I)
860 OUTPUT(I,NUMC+6)=XI(I)
856 NPRINT(4)=NEQUIM
IF(NUMC.EQ.0) GOTO 841
IF(IDVO.EQ.'TTY') GOTO 750
WRITE(NDEVO,703)
WRITE(NDEVO,701) LINE(0),(LINE(ICONT(I)),I=1,NUMC)
WRITE(NDEVO,701) LINE(7),(LINE(ICONT(I)+7),I=1,NUMC)
WRITE(NDEVO,704) (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 700 I=1,KMAX
WRITE(NDEVO,706) I,(OUTPUT(I,J),J=1,NUMC)
700 WRITE(NDEVO,778) I,(OUTPUT(I,J+6),J=1,NUMC)
GOTO 777
750 LEN=NUMC
IF(NUMC.GT.4) LEN=4
WRITE(NDEVO,703)
WRITE(NDEVO,707) LINE(0),(LINE(ICONT(I+IC)),I=1,LEN)
WRITE(NDEVO,707) LINE(7),(LINE(ICONT(I+IC)+7),I=1,LEN)
WRITE(NDEVO,704) (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 709 I=1,KMAX
WRITE(NDEVO,710) I,(OUTPUT(I,J+IC),J=1,LEN)
709 WRITE(NDEVO,779) I,(OUTPUT(I,J+IC+6),J=1,LEN)
IF(NUMC.LE.4) GOTO 777
IC=4
NUMC=NUMC-4
GOTO 750
777 IF(IDATA) 841,841,842
842 KMAX=NNODE
DO 989 II=2,6
989 IF((NMAX.GT.NNODE).AND.(NPRINT(II).EQ.1))KMAX=NMAX
DO 843 I=1,KMAX
WRITE(20,844) I,(OUTPUT(I,J),J=1,NUMC)
843 WRITE(20,844) I,(OUTPUT(I,J+6),J=1,NUMC)
841 IF(NTRACE) 9997,9999,9997
9997 WRITE(NDEVO,9998)
844 FORMAT(I,6E15.7)
840 FORMAT(F)
701 FORMAT(1X,A7,6X,6(5X,A7,4X))
703 FORMAT(//)
704 FORMAT(1X,132A1)
706 FORMAT(4X,I2,3X,'MAG',6(3X,1PE13.6))
778 FORMAT(4X,I2,3X,'PHA',6(3X,F13.6))
707 FORMAT(1X,A7,6X,4(4X,A7,3X))
710 FORMAT(4X,I2,3X,'MAG',4(3X,1PE11.4))
779 FORMAT(4X,I2,3X,'PHA',4(3X,F11.4))
9998 FORMAT(11H ECA49 EXIT)
9999 RETURN
END
SUBROUTINE ECA50(X,Z,NA,XR,XI)
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 THESE DO NOT MATCHUP TO ALL SUBROUTINES
C
DOUBLE PRECISION EQUCRL,EQUCIM,EPRL,EPIM,CVOLTR,CAMPRL
C
COMMON /MAIN2/VFIRST(50),VSECND(50),VLAST(50),MOBRN(50),
1 MOPARM(50),MOSTEP(50),IWCOUT(4),NLTRMS,OMEGA,IROWM(50),
2 ICOLM(50),FLML(50),FLMH(50),FLM(50),EPHA(65),AMPPHA(65),NREC,
3 EQUCRL(50),EQUCIM(50),CIM(65),ELIM(65),EPRL(50),
4 EPIM(50),ELSAV(65),CVOLTR(65),CAMPRL(65),HNODE,
5 OMGINV,DELTA,ITOL,LL,ITRANS
C
C
C
C FOLLOWING ARE USED INDIVIDUALLY BY LANG.,DC,AC,TR.(918 WORDS)
C
DOUBLE PRECISION CAMPIM,CVOLTI
C
COMMON /MAIN3/FLMSAV(25),IRSAV(25),ICSAV(25),CVOLTI(65),
1 CAMPIM(65),YYY(325)
C
C
C
C FOLLOWING ARE USED IN DC,AC,TR. (5000 WORDS)
C
DOUBLE PRECISION DUM1,DUM2
C
COMMON /MAIN4/DUM1(30,30),DUM2(30,30),ZZZ(1400)
C
C
C
C FOLLOWING ARE USED ONLY IN AC
C
DIMENSION POWRL(65)
C
DOUBLE PRECISION EBIM(150),EBRL(65),BAMPRL(65),BAMPIM(65)
C
EQUIVALENCE (EQUCRL(1),POWRL(1)),(CVOLTI(1),EBIM(1)),
1 (CVOLTR(1),EBRL(1)),(CAMPRL(1),BAMPRL(1)),
2 (CAMPIM(1),BAMPIM(1))
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 X(65),Z(65)
DIMENSION XR(65),XI(65),ANG(65)
EQUIVALENCE (ZZZ(501),ANG(1))
1 IF(NTRACE) 2,4,2
2 WRITE(NDEVO, 3)
3 FORMAT( 14H ECA50 ENTERED)
4 DO 50 I = 1, NA
IF(X(I))20,23,17
17 IF ( Z( I )) 19, 18, 18
18 ANG(I)= DATAN (Z(I)/X(I))
GO TO 27
19 ANG(I)= - DATAN ( -Z(I)/X(I))
GO TO 27
20 IF ( Z( I )) 22, 21, 21
21 ANG(I)= 3.141592653589793-DATAN(-Z(I)/X(I))
GO TO 27
22 ANG(I)= DATAN(Z(I)/X(I)) -3.141592653589793
GO TO 27
23 IF ( Z( I )) 24, 25, 26
24 ANG(I)= -1.570796326794896
GO TO 27
25 ANG(I)=0.
GO TO 27
26 ANG(I)= 1.570796326794896
27 XR(I)=DSQRT(Z(I)*Z(I)+X(I)*X(I))
XI(I)=ANG(I) * 57.2957795131
50 CONTINUE
IF(NTRACE)9997,9999,9997
9997 WRITE(NDEVO, 9998 )
9998 FORMAT(11H ECA50 EXIT)
9999 RETURN
END
SUBROUTINE ECA51(IA)
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 THESE DO NOT MATCHUP TO ALL SUBROUTINES
C
DOUBLE PRECISION EQUCRL,EQUCIM,EPRL,EPIM,CVOLTR,CAMPRL
C
COMMON /MAIN2/VFIRST(50),VSECND(50),VLAST(50),MOBRN(50),
1 MOPARM(50),MOSTEP(50),IWCOUT(4),NLTRMS,OMEGA,IROWM(50),
2 ICOLM(50),FLML(50),FLMH(50),FLM(50),EPHA(65),AMPPHA(65),NREC,
3 EQUCRL(50),EQUCIM(50),CIM(65),ELIM(65),EPRL(50),
4 EPIM(50),ELSAV(65),CVOLTR(65),CAMPRL(65),HNODE,
5 OMGINV,DELTA,ITOL,LL,ITRANS
C
C
C
C FOLLOWING ARE USED INDIVIDUALLY BY LANG.,DC,AC,TR.(918 WORDS)
C
DOUBLE PRECISION CAMPIM,CVOLTI
C
COMMON /MAIN3/FLMSAV(25),IRSAV(25),ICSAV(25),CVOLTI(65),
1 CAMPIM(65),YYY(325)
C
C
C
C FOLLOWING ARE USED IN DC,AC,TR. (5000 WORDS)
C
DOUBLE PRECISION DUM1,DUM2
C
COMMON /MAIN4/DUM1(30,30),DUM2(30,30),ZZZ(1400)
C
C
C
C FOLLOWING ARE USED ONLY IN AC
C
DIMENSION POWRL(65)
C
DOUBLE PRECISION EBIM(150),EBRL(65),BAMPRL(65),BAMPIM(65)
C
EQUIVALENCE (EQUCRL(1),POWRL(1)),(CVOLTI(1),EBIM(1)),
1 (CVOLTR(1),EBRL(1)),(CAMPRL(1),BAMPRL(1)),
2 (CAMPIM(1),BAMPIM(1))
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) IA
3 FORMAT(' ECA51 ENTERED. IA=',I3 )
4 IF ( IA - 1 ) 1000,552,1000
552 IF(NPRINT(1)+NPRINT(2)+NPRINT(3)+NPRINT(4)+NPRINT(5)+NPRINT(6)
1 +NPRINT(10))511,1000,511
511 FREQ = OMEGA/6.283185
WRITE(NDEVO,525) FREQ
525 FORMAT(//,' FREQ =',E16.8)
1000 IF(IA-11)1001,30,1001
1001 IF(NPRINT(IA))7,500,7
7 GO TO (21,22,23,24,25,26,27,28,29),IA
100 FORMAT( /// 7X 5HNODES, 10X 14H NODE VOLTAGES //)
101 FORMAT( /// 4X 8HBRANCHES 10X 17H ELEMENT CURRENTS //)
102 FORMAT( /// 4X 8HBRANCHES 10X 17H ELEMENT VOLTAGES //)
103 FORMAT(/// 4X 8HBRANCHES 10X 16H BRANCH CURRENTS //)
104 FORMAT(/// 4X 8HBRANCHES 10X 16H BRANCH VOLTAGES //)
105 FORMAT(/// 4X 8HBRANCHES 10X 13H BRANCH POWER //)
106 FORMAT( /// 1X 24H SENSITIVITIES NOT CALC. //)
107 FORMAT( /// 1X 21H WORST-CASE NOT CALC. //)
108 FORMAT( /// 1X 20H STD. DEV. NOT CALC. //)
109 FORMAT(///,' SOLUTION NOT OBTAINED TO DESIRED TOLERANCE',//)
110 FORMAT(7X,5HNODES,10X,19H CURRENT UNBALANCES,/)
21 WRITE(NDEVO, 100 )
GO TO 500
22 WRITE(NDEVO, 101 )
GO TO 500
23 WRITE(NDEVO, 102 )
GO TO 500
24 WRITE(NDEVO, 103 )
GO TO 500
25 WRITE(NDEVO, 104 )
GO TO 500
26 WRITE(NDEVO, 105 )
GO TO 500
27 WRITE(NDEVO, 106 )
GO TO 500
28 WRITE(NDEVO, 107 )
GO TO 500
29 WRITE(NDEVO, 108 )
GO TO 500
30 WRITE(NDEVO,109)
WRITE(NDEVO,110)
WRITE(IDLG,109)
WRITE(IDLG,110)
500 IF(NTRACE)9997,9999,9997
9997 WRITE(NDEVO, 9998)
9998 FORMAT(1X 11H ECA51 EXIT )
9999 RETURN
END
SUBROUTINE ECA52(IA,XR,XI)
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 THESE DO NOT MATCHUP TO ALL SUBROUTINES
C
DOUBLE PRECISION EQUCRL,EQUCIM,EPRL,EPIM,CVOLTR,CAMPRL
C
COMMON /MAIN2/VFIRST(50),VSECND(50),VLAST(50),MOBRN(50),
1 MOPARM(50),MOSTEP(50),IWCOUT(4),NLTRMS,OMEGA,IROWM(50),
2 ICOLM(50),FLML(50),FLMH(50),FLM(50),EPHA(65),AMPPHA(65),NREC,
3 EQUCRL(50),EQUCIM(50),CIM(65),ELIM(65),EPRL(50),
4 EPIM(50),ELSAV(65),CVOLTR(65),CAMPRL(65),HNODE,
5 OMGINV,DELTA,ITOL,LL,ITRANS
C
C
C
C FOLLOWING ARE USED INDIVIDUALLY BY LANG.,DC,AC,TR.(918 WORDS)
C
DOUBLE PRECISION CAMPIM,CVOLTI
C
COMMON /MAIN3/FLMSAV(25),IRSAV(25),ICSAV(25),CVOLTI(65),
1 CAMPIM(65),YYY(325)
C
C
C
C FOLLOWING ARE USED IN DC,AC,TR. (5000 WORDS)
C
DOUBLE PRECISION DUM1,DUM2
C
COMMON /MAIN4/DUM1(30,30),DUM2(30,30),ZZZ(1400)
C
C
C
C FOLLOWING ARE USED ONLY IN AC
C
DIMENSION POWRL(65)
C
DOUBLE PRECISION EBIM(150),EBRL(65),BAMPRL(65),BAMPIM(65)
C
EQUIVALENCE (EQUCRL(1),POWRL(1)),(CVOLTI(1),EBIM(1)),
1 (CVOLTR(1),EBRL(1)),(CAMPRL(1),BAMPRL(1)),
2 (CAMPIM(1),BAMPIM(1))
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
DIMENSION XR(65),XI(65)
1 IF(NTRACE)2,4,2
2 WRITE(NDEVO, 3) IA
3 FORMAT(' ECA52 ENTERED. IA=',I3 )
4 LIMIT = NMAX
IF ( IA - 11) 12,5,12
12 IF ( NPRINT(IA)) 9996,9996, 97
97 IF ( IA - 1 ) 6, 5, 6
5 LIMIT = NNODE
6 LAST = 0
666 K = LAST + 1
LAST = LAST + 4
IF(LAST - LIMIT )8,8,7
7 LAST = LIMIT
900 FORMAT(1X 3HMAG, I3, 1H- , I3, 4(1PG15.8))
901 FORMAT(1X 3HPHA, 7X 4(1PG15.8) //)
902 FORMAT(1X,4HREAL,1X,I3,1H-,I3,4(E14.7))
903 FORMAT(1X,4HIMAG,8X,4(E14.7)//)
8 IF (IA - 6 ) 100, 600, 700
100 WRITE(NDEVO, 900) K,LAST,(XR( J ), J=K, LAST )
WRITE(NDEVO, 901) (XI( J ), J=K, LAST )
GO TO 11
600 WRITE(NDEVO, 900 ) K, LAST, ( POWRL( J ), J = K, LAST )
GO TO 11
700 WRITE(NDEVO, 902) K,LAST,(XR( J ), J=K, LAST )
WRITE(NDEVO, 903) (XI( J ), J=K, LAST )
11 IF (LAST-LIMIT)666,9996,9996
9996 IF(NTRACE)9997,9999,9997
9997 WRITE(NDEVO, 9998)
9998 FORMAT(1X 11H ECA52 EXIT)
9999 RETURN
END
SUBROUTINE ECA53
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 THESE DO NOT MATCHUP TO ALL SUBROUTINES
C
DOUBLE PRECISION EQUCRL,EQUCIM,EPRL,EPIM,CVOLTR,CAMPRL
C
COMMON /MAIN2/VFIRST(50),VSECND(50),VLAST(50),MOBRN(50),
1 MOPARM(50),MOSTEP(50),IWCOUT(4),NLTRMS,OMEGA,IROWM(50),
2 ICOLM(50),FLML(50),FLMH(50),FLM(50),EPHA(65),AMPPHA(65),NREC,
3 EQUCRL(50),EQUCIM(50),CIM(65),ELIM(65),EPRL(50),
4 EPIM(50),ELSAV(65),CVOLTR(65),CAMPRL(65),HNODE,
5 OMGINV,DELTA,ITOL,LL,ITRANS
C
C
C
C FOLLOWING ARE USED INDIVIDUALLY BY LANG.,DC,AC,TR.(918 WORDS)
C
DOUBLE PRECISION CAMPIM,CVOLTI
C
COMMON /MAIN3/FLMSAV(25),IRSAV(25),ICSAV(25),CVOLTI(65),
1 CAMPIM(65),YYY(325)
C
C
C
C FOLLOWING ARE USED IN DC,AC,TR. (5000 WORDS)
C
DOUBLE PRECISION DUM1,DUM2
C
COMMON /MAIN4/DUM1(30,30),DUM2(30,30),ZZZ(1400)
C
C
C
C FOLLOWING ARE USED ONLY IN AC
C
DIMENSION POWRL(65)
C
DOUBLE PRECISION EBIM(150),EBRL(65),BAMPRL(65),BAMPIM(65)
C
EQUIVALENCE (EQUCRL(1),POWRL(1)),(CVOLTI(1),EBIM(1)),
1 (CVOLTR(1),EBRL(1)),(CAMPRL(1),BAMPRL(1)),
2 (CAMPIM(1),BAMPIM(1))
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) 998, 997, 998
998 WRITE(NDEVO, 999) MO
999 FORMAT(' ECA53 ENTERED. MO=', I3 )
997 GO TO ( 2, 21, 210 ) , MO
2 ITOL = 0
K = 0
MO = 0
MODM = 0
ITRANS = 0
OMGINV = 1.0/ OMEGA
IRTN=1
C
C
DO 10 MA = 1, NUMMO
M = MA
IF( K ) 8, 7, 8
7 N = MOBRN( M )
MP=IABS(MOPARM(M))
GO TO ( 11,12,13,14,15,16,17,18),MP
C @@R + G@@ DATA
11 IF( MOPARM( M )) 110, 29, 111
111 Y( N ) = 1.0/VFIRST( M )
GO TO 29
110 Y( N ) = VFIRST( M )
GO TO 29
C @@GM + BETA@@ DATA
12 IF( MOPARM( M )) 112, 29, 113
112 YTERM( N ) = VFIRST( M )
GO TO 29
113 L=ICOLT(N)
YTERM(N)=VFIRST(M)*Y(L)
GO TO 29
C @@E@@ DATA
13 E( N ) = VFIRST( M )
MM = M + 1
ANG=VFIRST(MM)* 0.01745329
EPHA( N ) = E( N ) * SIN( ANG )
E( N ) = E( N ) * COS( ANG )
K = 1
GO TO 29
C @@I@@ DATA
14 AMP( N ) = VFIRST( M )
MM = M + 1
ANG = VFIRST( MM ) * .01745329
AMPPHA( N ) = AMP( N ) * SIN( ANG )
AMP( N ) = AMP( N ) * COS( ANG )
K = 1
GO TO 29
C @@L@@ DATA
15 ELSAV( N ) = 1.0/VFIRST(M)
ELIM( N ) = ELSAV( N )
MODM= 1
GO TO 29
C @@C@@ DATA
16 CIM(N) = VFIRST( M )
GO TO 29
C @@M@@ DATA
17 FLMSAV( N ) = VFIRST( M )
MODM = 1
GO TO 29
C @@FREQUENCY@@ DATA
18 OMEGA = VFIRST( M ) * 6.283185
OMGINV = 1.0/OMEGA
GO TO 29
C BYPASS ONE ENTRY
8 K = 0
GO TO 10
C TEST FOR ITERATED PARAMETER
29 IF( MOSTEP( M )) 6, 10, 6
6 ITOL = M
MOSTEP( M ) = 0
MOSTEP( M + 1 ) = 0
MO = 2
LL = MP
10 CONTINUE
IF( MODM ) 19, 31, 19
19 IF ( NLTRMS ) 500, 31, 500
500 DO 200 K = 1, NMAX
200 ELIM( K ) = ELSAV( K )
DO 20 K = 1, NLTRMS
FLM( K ) = FLMSAV( K )
IROWM( K ) = IRSAV( K )
ICOLM( K ) = ICSAV( K )
FLM( KK ) = FLM( K )
IROWM( KK ) = ICOLM( K )
20 ICOLM( KK ) = IROWM( K )
ITRANS= 1
GO TO 9996
C CHECK FOR ITERATED PARAMETER
21 ICOL = 2
MO = 3
LL = IABS( MOPARM( ITOL ))
GO TO(23, 23, 22, 22, 23, 23, 23, 25), LL
210 LL = IABS( MOPARM( ITOL ))
GO TO ( 203,203,202,202,203,203,203,26),LL
202 ITOL = ITOL + 1
VFIRST(ITOL) = VFIRST(ITOL) + HNODE
ITOL = ITOL - 1
C
GO TO 203
22 ITOL = ITOL + 1
DELTA = (VLAST(ITOL) - VFIRST(ITOL))/VSECND(ITOL)
VFIRST(ITOL) = VFIRST(ITOL) + DELTA
HNODE = DELTA
ITOL = ITOL - 1
23 DELTA = (VLAST(ITOL) - VFIRST( ITOL ))/ VSECND( ITOL )
203 VFIRST( ITOL ) = VFIRST( ITOL ) + DELTA
24 IF(VLAST(ITOL)-VFIRST(ITOL)) 38,37,39
37 GO TO (38,38,380,380,38,38,38,38),LL
380 IF(DELTA)38,381,38
381 MM = ITOL + 1
IF(VLAST(MM) - VFIRST(MM))38,38,39
25 GO TO ( 251, 23 ), NREC
251 DELTA = VSECND( ITOL )
261 VFIRST( ITOL ) = VFIRST( ITOL ) * DELTA
GO TO 24
26 GO TO ( 261, 203 ), NREC
38 MO = 0
39 M = ITOL
GO TO 7
40 GO TO ( 31,31, 31, 31,19,31,19,31),LL
31 ITRANS= 2
9996 IF(NTRACE) 9997,9999,9997
9997 WRITE(NDEVO,9998)
9998 FORMAT( 11H ECA53 EXIT )
9999 RETURN
END
SUBROUTINE ECA54
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 THESE DO NOT MATCHUP TO ALL SUBROUTINES
C
DOUBLE PRECISION EQUCRL,EQUCIM,EPRL,EPIM,CVOLTR,CAMPRL
C
COMMON /MAIN2/VFIRST(50),VSECND(50),VLAST(50),MOBRN(50),
1 MOPARM(50),MOSTEP(50),IWCOUT(4),NLTRMS,OMEGA,IROWM(50),
2 ICOLM(50),FLML(50),FLMH(50),FLM(50),EPHA(65),AMPPHA(65),NREC,
3 EQUCRL(50),EQUCIM(50),CIM(65),ELIM(65),EPRL(50),
4 EPIM(50),ELSAV(65),CVOLTR(65),CAMPRL(65),HNODE,
5 OMGINV,DELTA,ITOL,LL,ITRANS
C
C
C
C FOLLOWING ARE USED INDIVIDUALLY BY LANG.,DC,AC,TR.(918 WORDS)
C
DOUBLE PRECISION CAMPIM,CVOLTI
C
COMMON /MAIN3/FLMSAV(25),IRSAV(25),ICSAV(25),CVOLTI(65),
1 CAMPIM(65),YYY(325)
C
C
C
C FOLLOWING ARE USED IN DC,AC,TR. (5000 WORDS)
C
DOUBLE PRECISION DUM1,DUM2
C
COMMON /MAIN4/DUM1(30,30),DUM2(30,30),ZZZ(1400)
C
C
C
C FOLLOWING ARE USED ONLY IN AC
C
DIMENSION POWRL(65)
C
DOUBLE PRECISION EBIM(150),EBRL(65),BAMPRL(65),BAMPIM(65)
C
EQUIVALENCE (EQUCRL(1),POWRL(1)),(CVOLTI(1),EBIM(1)),
1 (CVOLTR(1),EBRL(1)),(CAMPRL(1),BAMPRL(1)),
2 (CAMPIM(1),BAMPIM(1))
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(14H ECA54 ENTERED)
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 GO TO ( 500,501,502,503,508,509,512,9996),LL
500 IF ( MOPARM(ITOL) ) 505,505,504
501 IF(MOPARM(ITOL))506,506,507
505 MART = 'G'
GO TO 510
504 MART = 'R'
GO TO 510
506 MART = -942391232
GO TO 510
507 MART = -1027218495
GO TO 510
502 MART = 'E'
GO TO 510
503 MART = 'I'
GO TO 510
508 MART = 'L'
GO TO 510
509 MART = 'C'
GO TO 510
512 MART = 'M'
510 GO TO (520,520,515,515,520,520,520,520),LL
515 WRITE(NDEVO, 526 ) MART, VFIRST( ITOL ), VFIRST( ITOL + 1 )
GO TO 9996
520 WRITE(NDEVO, 525 ) MART, VFIRST( ITOL )
525 FORMAT(//1X A4,2H =, E16.8)
526 FORMAT(//1X A4,2H =, E16.8, 2H /, E16.8)
9996 IF(NTRACE)9997,9999,9997
9997 WRITE(NDEVO,9998)
9998 FORMAT(11H ECA54 EXIT)
9999 RETURN
END