Google
 

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