Google
 

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