CFPRIME YBRAN                                                           YBRAN       1
C***********************************************************************RIGHTE      1
C*                                                                     *RIGHTE      2
C*        Extended Transient-Midterm Stability Program (ETMSP)         *RIGHTE      3
C*        ====================================================         *RIGHTE      4
C*                                                                     *RIGHTE      5
C*       Copyright (C) (1993) Electric Power Research Institute        *RIGHTE      6
C*                                                                     *RIGHTE      7
C* EPRI reserves all rights in the software and associated             *RIGHTE      8
C* documentation as delivered. The software and its associated         *RIGHTE      9
C* documention or any portion thereof may not be reproduced in any form*RIGHTE     10
C* whatsoever without the consent of EPRI, except as explicity provided*RIGHTE     11
C* for by license. Licensee shall submit a detailed description to EPRI*RIGHTE     12
C* of any changes or modifications to the software within two (2)      *RIGHTE     13
C* months after such changes or modifications are made. At EPRI's sole *RIGHTE     14
C* discretion, the software, as changed or modified, shall be given a  *RIGHTE     15
C* new designation sufficiently different from its then current        *RIGHTE     16
C* designation as to prevent mistake,confusion, or deception as between*RIGHTE     17
C* the current software as changed or modified.                        *RIGHTE     18
C*                                                                     *RIGHTE     19
C* A license under EPRI's rights in the software can be obtained       *RIGHTE     20
C* directly from EPRI.                                                 *RIGHTE     21
C*                                                                     *RIGHTE     22
C* This program and supporting materials may be independently available*RIGHTE     23
C* from Electric Power Software centre (EPSC) for an appropriate       *RIGHTE     24
C* distribution fee. The EPSC is a service of                          *RIGHTE     25
C*                                                                     *RIGHTE     26
C*                    Power Computing Company                          *RIGHTE     27
C*                    1930 Hi Line                                     *RIGHTE     28
C*                    Dallas, Tx 75207                                 *RIGHTE     29
C*                                                                     *RIGHTE     30
C* NEITHER EPRI, ANY MEMBER OF EPRI, NOR ANY PERSON OR  ORGANIZATION   *RIGHTE     31
C* ACTING ON BEHAVE OF THEM:                                           *RIGHTE     32
C*                                                                     *RIGHTE     33
C* 1. MAKE ANY WARRANTY OR REPRESENTATION WHATSOEVER, EXPRESS OR       *RIGHTE     34
C*    IMPLIED, INCLUDING ANY WARRANTY OF MERCHANTABILITY OR FITNESS OR *RIGHTE     35
C*    ANY PURPOSE WITH RESPECT TO THE SOFTWARE OR ITS ASSOCIATED       *RIGHTE     36
C*    DOCUMENTATION; OR                                                *RIGHTE     37
C*                                                                     *RIGHTE     38
C* 2. ASSUMES ANY LIABILITY WHATSOEVER WITH RESPECT TO ANY USE OF THE  *RIGHTE     39
C*    SOFTWARE OR ITS ASSOCIATED DOCUMENTATION OR ANY PORTION THEREOF  *RIGHTE     40
C*    OR WITH RESPECT TO ANY DAMAGES WHICH MAY RESULT FROM SUCH USE.   *RIGHTE     41
C*                                                                     *RIGHTE     42
C* THIS NOTICE MAY NOT BE REMOVED FROM THE SOFTWARE BY ANY USER        *RIGHTE     43
C* THEREOF.                                                            *RIGHTE     44
C*                                                                     *RIGHTE     45
C***********************************************************************RIGHTE     46
      SUBROUTINE YBRAN                                                  YBRAN       3
CD                                                                      YBRAN       4
CD    TO BUILD THE Y-MATRIX AND LINKNET INFORMATION BASED ON THE        YBRAN       5
CD    NETWORK DATA, AND TO COMPUTE INFINITE BUS CURRENT INJECTION ARRAY.YBRAN       6
CD                                                                      YBRAN       7
      INCLUDE 'PARX.INS'                                                YBRAN       8
      INCLUDE 'CNFLAG.INS'                                              YBRAN       9
      INCLUDE 'CNPT.INS'                                                YBRAN      10
      INCLUDE 'CNIPTR.INS'                                              YBRAN      11
      INCLUDE 'CNSTN.INS'                                               YBRAN      12
      INCLUDE 'CNVOLT.INS'                                              YBRAN      13
      INCLUDE 'CNB4.INS'                                                YBRAN      14
      INCLUDE 'CNPARX.INS'                                              YBRAN      15
      INCLUDE 'CNLFDA.INS'                                              YBRAN      16
      INCLUDE 'CNSELI.INS'                                              YBRAN      17
      INCLUDE 'CNLKN1.INS'                                              YBRAN      18
      INCLUDE 'CNLIN1.INS'                                              YBRAN      19
      INCLUDE 'CNSPDI.INS'                                              YBRAN      20
      INCLUDE 'CNBRAU.INS'                                              YBRAN      21
      INCLUDE 'CNBRAL.INS'                                              YBRAN      22
      INCLUDE 'CNMON.INS'                                               YBRAN      23
      INCLUDE 'CNLSTA.INS'                                              YBRAN      24
      INCLUDE 'CNUNIT.INS'                                              YBRAN      25
      INCLUDE 'CNMASK.INS'                                              YBRAN      26
      INCLUDE 'UDCF.INS'                                                YBRAN      27
      INCLUDE 'CNNNEW.INS'                                              YBRAN      28
      INCLUDE 'CNMSG.INS'                                               YBRAN      29
C                                                                       YBRAN      30
      DIMENSION BUSKJ(NPL*2),BUSJK(NPL*2)                               YBRAN      31
      EQUIVALENCE (BRAU(1),BUSKJ(1)),(BRAL(1),BUSJK(1))                 YBRAN      32
C                                                                       YBRAN      33
C     IF NPL < 32678 INDEX AND LORD CAN BE HALFWORD ARRAY               YBRAN      34
C                                                                       YBRAN      35
      INTEGER  IFELIX(NB),ITBUS(NB)                                     YBRAN      36
      EQUIVALENCE (BUDAT(1),IFELIX(1)),(BUDAT(NB+1),ITBUS(1))           YBRAN      37
      COMPLEX CMPLX                                                     YBRAN      38
      INTEGER*4 ITFK,JCKID                                              YBRAN      39
      CHARACTER*2 ICKT,ICKT1                                            YBRAN      40
C                                                                       YBRAN      41
      INTEGER*4   IUID                                                  YBRAN      42
      CHARACTER*2 LUID                                                  YBRAN      43
      INTEGER LTBFRM(20),LTBL(20),LTOL(20),LGCHK(NB/50)                 YBRAN      44
C                                                                       YBRAN      45
      LOGICAL LDEB1                                                     YBRAN      46
C                                                                       YBRAN      47
      LDEB=(JDEB(26).NE.0)                                              YBRAN      48
      LDEB1=(JDEB(295).NE.0)                                            YBRAN      49
C                                                                       YBRAN      50
      WRITE(LOUT,'(/A/)')                                               YBRAN      51
     *' FORMULATING NETWORK ADMITTANCE MATRIX. WAIT ...'                YBRAN      52
C                                                                       YBRAN      53
      IGFD=0                                                            YBRAN      54
C      PTOL=.05                                                         YBRAN      55
CD                                                                      YBRAN      56
CD    RESTORE PART 1 OF NETWORK ARRAYS FROM FILE IU3 WRITTEN IN         YBRAN      57
CD    ROUTINE RENET.                                                    YBRAN      58
CD                                                                      YBRAN      59
      REWIND IU3                                                        YBRAN      60
C                                                                       YBRAN      61
      READ(IU3) NL,ITRF,NLFBUS                                          YBRAN      62
      CALL FLWR(IU3,1,NL*5,GBFT)                                        YBRAN      63
      CALL IFWR(IU3,1,NXTR,ITRAN)                                       YBRAN      64
      IF(ITRF.NE.0)CALL FLWR(IU3,1,ITRF*2,TRANS)                        YBRAN      65
      CALL IHWR(IU3,1,NL,LTRANC)                                        YBRAN      66
C                                                                       YBRAN      67
      IF(NSEL.NE.0)THEN                                                 YBRAN      68
         READ(IU3)NSEL                                                  YBRAN      69
         CALL FLWR(IU3,1,18*NSEL,EQPI)                                  YBRAN      70
         CALL FLWR(IU3,1,24*NSEL,PSELIN)                                YBRAN      71
         CALL IHWR(IU3,1,6*NSEL,LCONE)                                  YBRAN      72
         CALL IHWR(IU3,1,12*NSEL,NEXTSL)                                YBRAN      73
      ENDIF                                                             YBRAN      74
C                                                                       YBRAN      75
      IF(LDEB)WRITE(IUD6,920) (I,ITRAN(I),                              YBRAN      76
     &RATIO(I+I-1),RANG(I+I),I=1,ITRF)                                  YBRAN      77
CD                                                                      YBRAN      78
CD    FORMING THE NETWORK MATRIX IN LINKNET FORM                        YBRAN      79
CD                                                                      YBRAN      80
C     INITIALIZE LINKNET ARRAYS                                         YBRAN      81
C                                                                       YBRAN      82
      CALL MOVE(0,LTBFRM,LTBFRM,20)                                     YBRAN      83
      CALL MOVE(0,LTBL,LTBL,20)                                         YBRAN      84
      CALL MOVE(0,LTOL,LTOL,20)                                         YBRAN      85
      CALL MOVE(0,LGCHK,LGCHK,NB/50)                                    YBRAN      86
      CALL MOVE(0,LBRI,LBRI,NLFBUS)                                     YBRAN      87
      CALL HMOVE(0,NZFELI,NZFELI,NLFBUS)                                YBRAN      88
      K=NL*2                                                            YBRAN      89
      CALL MOVE(0,NELI,NELI,K)                                          YBRAN      90
      CALL HMOVE(0,KTNO,KTNO,K)                                         YBRAN      91
      CALL FMOVE(0,BUSKJ,BUSKJ,K)                                       YBRAN      92
      CALL FMOVE(0,BUSJK,BUSJK,K)                                       YBRAN      93
C                                                                       YBRAN      94
      NBUS=NLFBUS                                                       YBRAN      95
      JOLD=0                                                            YBRAN      96
      KOLD=0                                                            YBRAN      97
      NZLINE=0                                                          YBRAN      98
      DO 150 I=1,NBUS                                                   YBRAN      99
      IMSK(I)=I                                                         YBRAN     100
  150 CONTINUE                                                          YBRAN     101
C                                                                       YBRAN     102
      LNET=0                                                            YBRAN     103
      JL=0                                                              YBRAN     104
      DO 250 I=1,NL                                                     YBRAN     105
      JL=JL+5                                                           YBRAN     106
      JCKID=LFTB(JL-4)                                                  YBRAN     107
      CALL UNPACK(ICKT,JJJ,JCKID)                                       YBRAN     108
      IL=LFTB(JL-3)                                                     YBRAN     109
      CALL UPACKI(NODEJ,NODEK,IL)                                       YBRAN     110
      GBUSX=GA(JL-2)                                                    YBRAN     111
      BBUSX=BA(JL-1)                                                    YBRAN     112
      CHG=0.5*BCHG(JL)                                                  YBRAN     113
      JTRF=LTRANC(I)                                                    YBRAN     114
C                                                                       YBRAN     115
C       IF(NODEJ.LE.NLAST.AND.NODEK.LE.NLAST)THEN                       YBRAN     116
         LNET=LNET+1                                                    YBRAN     117
         IENDB=LNET+LNET                                                YBRAN     118
         IENDA=IENDB-1                                                  YBRAN     119
         NELI(IENDA)=LBRI(NODEJ)                                        YBRAN     120
         LBRI(NODEJ)=IENDA                                              YBRAN     121
         KTNO(IENDA)=NODEK                                              YBRAN     122
         LINEPO(IENDA)=I                                                YBRAN     123
         NELI(IENDB)=LBRI(NODEK)                                        YBRAN     124
         LBRI(NODEK)=IENDB                                              YBRAN     125
         KTNO(IENDB)=NODEJ                                              YBRAN     126
         LINEPO(IENDB)=-I                                               YBRAN     127
         IARCCT(LNET)=JCKID                                             YBRAN     128
C--                                                                     YBRAN     129
         NBSTR=NOLD(NODEJ)                                              YBRAN     130
         NBEND=NOLD(NODEK)                                              YBRAN     131
C                                                                       YBRAN     132
C -- SET Z-I-L : CHECK Z<=0.0001                                        YBRAN     133
C                                                                       YBRAN     134
          ZMAG=1./SQRT(GBUSX*GBUSX+BBUSX*BBUSX)                         YBRAN     135
C                                                                       YBRAN     136
C                                                                       YBRAN     137
         IF (ZMAG.LE.ZILTOL)THEN                                        YBRAN     138
C                                                                       YBRAN     139
CD                                                                      YBRAN     140
CD    SET UP THE ZERO IMPEDANCE LINE TABLE                              YBRAN     141
CD                                                                      YBRAN     142
            NZLINE=NZLINE+1                                             YBRAN     143
C                                                                       YBRAN     144
            JENDB=NZLINE+NZLINE                                         YBRAN     145
            JENDA=JENDB-1                                               YBRAN     146
            NZNELI(JENDA)=NZFELI(NODEJ)                                 YBRAN     147
            NZFELI(NODEJ)=JENDA                                         YBRAN     148
            NZFENO(JENDA)=NODEK                                         YBRAN     149
            NZNELI(JENDB)=NZFELI(NODEK)                                 YBRAN     150
            NZFELI(NODEK)=JENDB                                         YBRAN     151
            NZFENO(JENDB)=NODEJ                                         YBRAN     152
C                                                                       YBRAN     153
            NZFROM(NZLINE)=NODEJ                                        YBRAN     154
            NZTO(NZLINE)=NODEK                                          YBRAN     155
            NZCID(NZLINE)=ICKT                                          YBRAN     156
            NZLPO(NZLINE)=LNET                                          YBRAN     157
C                                                                       YBRAN     158
            NZSWIT(NZLINE)=0                                            YBRAN     159
C                                                                       YBRAN     160
            STAIRS(NODEJ)=STAIRS(NODEJ)+CMPLX(0.0,CHG)                  YBRAN     161
            STAIRS(NODEK)=STAIRS(NODEK)+CMPLX(0.0,CHG)                  YBRAN     162
C==                                                                     YBRAN     163
       IF (LDEB1) WRITE(IUD6,791) NZLINE,GBUSX,BBUSX,CHG,NBSTR,         YBRAN     164
     +            NBEND,JTRF                                            YBRAN     165
  791  FORMAT(//,1X,'DB-YBRAN_NEW:NZLINE,GB,BB,CHG,NBSTR,NBEND,',       YBRAN     166
     +      'JTRF ',/,(1X,I5,3G11.4,I6,1X,I5,1X,I5))                    YBRAN     167
C==                                                                     YBRAN     168
CD                                                                      YBRAN     169
CD    SET UP THE ELEMINATED BUS TABLE "IMSK"                            YBRAN     170
CD                                                                      YBRAN     171
            IF((NODEJ.EQ.JOLD.AND.NODEK.EQ.KOLD).OR.(NODEJ.EQ.KOLD      YBRAN     172
     +      .AND.NODEK.EQ.JOLD)) GOTO 160                               YBRAN     173
            JOLD=NODEJ                                                  YBRAN     174
            KOLD=NODEK                                                  YBRAN     175
            MSKJ=IMSK(NODEJ)                                            YBRAN     176
            MSKK=IMSK(NODEK)                                            YBRAN     177
            IF(MSKJ.LT.0.AND.MSKK.LT.0) THEN                            YBRAN     178
               GOTO 160                                                 YBRAN     179
            ELSE IF(MSKK.LT.0) THEN                                     YBRAN     180
               IMSK(NODEJ)=-NODEK                                       YBRAN     181
            ELSE IF(MSKJ.LT.0) THEN                                     YBRAN     182
               IMSK(NODEK)=-NODEJ                                       YBRAN     183
            ELSE                                                        YBRAN     184
               IF(NODEK.LT.NODEJ) THEN                                  YBRAN     185
                  IMSK(NODEJ)=-NODEK                                    YBRAN     186
               ELSE                                                     YBRAN     187
                  IMSK(NODEK)=-NODEJ                                    YBRAN     188
               ENDIF                                                    YBRAN     189
            ENDIF                                                       YBRAN     190
  160       CONTINUE                                                    YBRAN     191
C                                                                       YBRAN     192
           GOTO 250                                                     YBRAN     193
         ENDIF                                                          YBRAN     194
C                                                                       YBRAN     195
C  NOT A ZERO IMPEDANCE LINE                                            YBRAN     196
C                                                                       YBRAN     197
             IF(JTRF.EQ.0)THEN                                          YBRAN     198
C                                                                       YBRAN     199
C      OTHER BRANCHES                                                   YBRAN     200
C                                                                       YBRAN     201
               BRAU(LNET)=CMPLX(-GBUSX,BBUSX)                           YBRAN     202
               BRAL(LNET)=CMPLX(-GBUSX,BBUSX)                           YBRAN     203
               BBUSX=CHG-BBUSX                                          YBRAN     204
               STAIRS(NODEJ)=STAIRS(NODEJ)+CMPLX(GBUSX,BBUSX)           YBRAN     205
               STAIRS(NODEK)=STAIRS(NODEK)+CMPLX(GBUSX,BBUSX)           YBRAN     206
            ELSE                                                        YBRAN     207
C                                                                       YBRAN     208
C   TRANSFORMER BRANCHES                                                YBRAN     209
C                                                                       YBRAN     210
               JTRF2=JTRF+JTRF                                          YBRAN     211
               ONR=RATIO(JTRF2-1)                                       YBRAN     212
               PHS=-RANG(JTRF2)/57.29578                                YBRAN     213
               XONR=ABS(ONR)                                            YBRAN     214
               FACT=XONR*XONR                                           YBRAN     215
               GKK=GBUSX                                                YBRAN     216
               BKK=CHG-BBUSX                                            YBRAN     217
               GJJ=GBUSX/FACT                                           YBRAN     218
               BJJ=CHG-BBUSX/FACT                                       YBRAN     219
               COSO=COS(PHS)/XONR                                       YBRAN     220
               SINO=SIN(PHS)/XONR                                       YBRAN     221
               GJK=-GBUSX*COSO+BBUSX*SINO                               YBRAN     222
               BJK=GBUSX*SINO+BBUSX*COSO                                YBRAN     223
               GKJ=-(GBUSX*COSO+BBUSX*SINO)                             YBRAN     224
               BKJ=-GBUSX*SINO+BBUSX*COSO                               YBRAN     225
               IF(LDEB)WRITE(IUD6,930)I,NODEJ,NODEK,RATIO(JTRF2-1)      YBRAN     226
     &,RANG(JTRF2),XONR,SINO,COSO,GJK,BJK,GKJ,BKJ,GBUSX,BBUSX,CHG       YBRAN     227
               IF(ONR.GT.0.0)THEN                                       YBRAN     228
                  STAIRS(NODEJ)=STAIRS(NODEJ)+CMPLX(GJJ,BJJ)            YBRAN     229
                  STAIRS(NODEK)=STAIRS(NODEK)+CMPLX(GKK,BKK)            YBRAN     230
                  BRAU(LNET)=CMPLX(GJK,BJK)                             YBRAN     231
                  BRAL(LNET)=CMPLX(GKJ,BKJ)                             YBRAN     232
               ELSE                                                     YBRAN     233
                  STAIRS(NODEJ)=STAIRS(NODEJ)+CMPLX(GKK,BKK)            YBRAN     234
                  STAIRS(NODEK)=STAIRS(NODEK)+CMPLX(GJJ,BJJ)            YBRAN     235
                  BRAU(LNET)=CMPLX(GKJ,BKJ)                             YBRAN     236
                  BRAL(LNET)=CMPLX(GJK,BJK)                             YBRAN     237
               ENDIF                                                    YBRAN     238
            ENDIF                                                       YBRAN     239
C                                                                       YBRAN     240
 250  CONTINUE                                                          YBRAN     241
C                                                                       YBRAN     242
C  CHECK IF ANY LINE EXISTS IN PARALLEL WITH A ZERO IMPEDANCE LINE      YBRAN     243
C  IF IT DOES GIVE A WARNING MESSAGE.                                   YBRAN     244
C                                                                       YBRAN     245
      DO 255 I=1,NZLINE                                                 YBRAN     246
       NODEJ=NZFROM(I)                                                  YBRAN     247
       NODEK=NZTO(I)                                                    YBRAN     248
       NBSTR=NOLD(NODEJ)                                                YBRAN     249
       NBEND=NOLD(NODEK)                                                YBRAN     250
       ICKT=NZCID(I)                                                    YBRAN     251
       IZ=LBRI(NODEJ)                                                   YBRAN     252
 252   CONTINUE                                                         YBRAN     253
       MNODEK=KTNO(IZ)                                                  YBRAN     254
       IF(MNODEK.EQ.NODEK) THEN                                         YBRAN     255
        IZNET=(IZ+1)/2                                                  YBRAN     256
        ITFK=IARCCT(IZNET)                                              YBRAN     257
        CALL UNPACK(ICKT1,JJJ,ITFK)                                     YBRAN     258
        IF(ICKT1.NE.ICKT) THEN                                          YBRAN     259
         WRITE(MSG(1),9200) ICKT                                        YBRAN     260
         WRITE(MSG(2),9210) ICKT1                                       YBRAN     261
         K3=NODEK*3                                                     YBRAN     262
         J3=NODEJ*3                                                     YBRAN     263
         WRITE(MSG(3),9220)NBSTR,INAME(J3-2),INAME(J3-1),INAME(J3),     YBRAN     264
     *NBEND,INAME(K3-2),INAME(K3-1),INAME(K3)                           YBRAN     265
         CALL PRTMSG(3)                                                 YBRAN     266
        ENDIF                                                           YBRAN     267
       ENDIF                                                            YBRAN     268
       IF(NELI(IZ).EQ.0) GOTO 255                                       YBRAN     269
       IZ=NELI(IZ)                                                      YBRAN     270
       GOTO 252                                                         YBRAN     271
 255  CONTINUE                                                          YBRAN     272
C                                                                       YBRAN     273
C  ACCOUNT SHUNTS OF SEGMENTED LINES                                    YBRAN     274
C                                                                       YBRAN     275
      DO 260 I=1,NSEL                                                   YBRAN     276
      J=LCONE(1,I)                                                      YBRAN     277
      K=LCONE(2,I)                                                      YBRAN     278
      IF(LDEB)WRITE(IUD6,1070) I,J,K,(EQPI(KK,I),KK=3,6)                YBRAN     279
      GKK=EQPI(3,I)                                                     YBRAN     280
      BKK=EQPI(4,I)                                                     YBRAN     281
      STAIRS(J)=STAIRS(J)+CMPLX(GKK,BKK)                                YBRAN     282
      GKK=EQPI(5,I)                                                     YBRAN     283
      BKK=EQPI(6,I)                                                     YBRAN     284
      STAIRS(K)=STAIRS(K)+CMPLX(GKK,BKK)                                YBRAN     285
 260  CONTINUE                                                          YBRAN     286
CD                                                                      YBRAN     287
CD    COMPUTE CURRENT INJECTION DUE TO INFINITE BUS                     YBRAN     288
CD                                                                      YBRAN     289
      IF(LDEB)WRITE(IUD6,1080)IFNBUS                                    YBRAN     290
C                                                                       YBRAN     291
      IF(IFNBUS.NE.0)THEN                                               YBRAN     292
       KFBUS=0                                                          YBRAN     293
C                                                                       YBRAN     294
      DO 275 I=NLAST+1,NBUS                                             YBRAN     295
C                                                                       YBRAN     296
       ER=REAL(VOLT(I))                                                 YBRAN     297
       EI=AIMAG(VOLT(I))                                                YBRAN     298
         IM=LBRI(I)                                                     YBRAN     299
         CRO=0.0                                                        YBRAN     300
         CIO=0.0                                                        YBRAN     301
 276     KEY=(IM+1)/2                                                   YBRAN     302
         ITOL=KTNO(IM)                                                  YBRAN     303
         IF(ITOL.GT.0)THEN                                              YBRAN     304
          IF(ITOL .LE. NLAST)THEN                                       YBRAN     305
            KFBUS=KFBUS+1                                               YBRAN     306
            GLX=-REAL(BRAU(KEY))                                        YBRAN     307
            BLX=AIMAG(BRAU(KEY))                                        YBRAN     308
C                                                                       YBRAN     309
            CRO=GLX*ER+BLX*EI                                           YBRAN     310
            CIO=GLX*EI-BLX*ER                                           YBRAN     311
C                                                                       YBRAN     312
            CINF(KFBUS)=CMPLX(CRO,CIO)                                  YBRAN     313
            KCINF(KFBUS)=ITOL                                           YBRAN     314
C                                                                       YBRAN     315
          ENDIF                                                         YBRAN     316
C                                                                       YBRAN     317
            IX=MOD(IM,2)                                                YBRAN     318
            IF(IX.EQ.0)THEN                                             YBRAN     319
             KTNO(IM)=-1                                                YBRAN     320
             KTNO(IM-1)=-1                                              YBRAN     321
            ELSE                                                        YBRAN     322
             KTNO(IM)=-1                                                YBRAN     323
             KTNO(IM+1)=-1                                              YBRAN     324
            ENDIF                                                       YBRAN     325
C                                                                       YBRAN     326
         ENDIF                                                          YBRAN     327
C                                                                       YBRAN     328
            IM=NELI(IM)                                                 YBRAN     329
            IF(IM.NE.0)GOTO 276                                         YBRAN     330
C                                                                       YBRAN     331
 275     CONTINUE                                                       YBRAN     332
C                                                                       YBRAN     333
          IF(LDEB)WRITE(IUD6,1090)(KCINF(I),CINF(I),I=1,KFBUS)          YBRAN     334
C                                                                       YBRAN     335
      DO 277 I=1,NLAST                                                  YBRAN     336
C                                                                       YBRAN     337
         IM=LBRI(I)                                                     YBRAN     338
 278     KEY=(IM+1)/2                                                   YBRAN     339
         ITOL=KTNO(IM)                                                  YBRAN     340
         IF(ITOL.GT.NLAST)THEN                                          YBRAN     341
C                                                                       YBRAN     342
         ER=REAL(VOLT(ITOL))                                            YBRAN     343
         EI=AIMAG(VOLT(ITOL))                                           YBRAN     344
C                                                                       YBRAN     345
            KFBUS=KFBUS+1                                               YBRAN     346
            GLX=-REAL(BRAU(KEY))                                        YBRAN     347
            BLX=AIMAG(BRAU(KEY))                                        YBRAN     348
C                                                                       YBRAN     349
            CRO=GLX*ER+BLX*EI                                           YBRAN     350
            CIO=GLX*EI-BLX*ER                                           YBRAN     351
C                                                                       YBRAN     352
            CINF(KFBUS)=CMPLX(CRO,CIO)                                  YBRAN     353
            KCINF(KFBUS)=I                                              YBRAN     354
C                                                                       YBRAN     355
            IX=MOD(IM,2)                                                YBRAN     356
            IF(IX.EQ.0)THEN                                             YBRAN     357
             KTNO(IM)=-1                                                YBRAN     358
             KTNO(IM-1)=-1                                              YBRAN     359
            ELSE                                                        YBRAN     360
             KTNO(IM)=-1                                                YBRAN     361
             KTNO(IM+1)=-1                                              YBRAN     362
            ENDIF                                                       YBRAN     363
C                                                                       YBRAN     364
         ENDIF                                                          YBRAN     365
C                                                                       YBRAN     366
            IM=NELI(IM)                                                 YBRAN     367
            IF(IM.NE.0)GOTO 278                                         YBRAN     368
 277   CONTINUE                                                         YBRAN     369
C                                                                       YBRAN     370
C                                                                       YBRAN     371
         ENDIF                                                          YBRAN     372
C     INFINTE BUS ENDS                                                  YBRAN     373
C                                                                       YBRAN     374
         LLNET=LNET                                                     YBRAN     375
C                                                                       YBRAN     376
C  SET UP THE MASKED BUS TABLE "MSK", "MSKNEW" & "MSKOLD"               YBRAN     377
C                                                                       YBRAN     378
C                                                                       YBRAN     379
      NBACTL=NBUS                                                       YBRAN     380
      NELB=0                                                            YBRAN     381
      IF (NZLINE.EQ.0) THEN                                             YBRAN     382
         DO 280 I=1,NBUS                                                YBRAN     383
         MSK(I)=I                                                       YBRAN     384
  280    CONTINUE                                                       YBRAN     385
      ELSE                                                              YBRAN     386
C                                                                       YBRAN     387
C==                                                                     YBRAN     388
         IF (LDEB1) THEN                                                YBRAN     389
         WRITE(IUD6,741) NZLINE                                         YBRAN     390
         WRITE(IUD6,742) (I,NZFROM(I),NZTO(I),NZLPO(I),I=1,NZLINE)      YBRAN     391
  741    FORMAT(//,1X,'DB-YBRAN_NEW: NZLINE = ',I5)                     YBRAN     392
  742    FORMAT(1X,'DB-YBRAN_NEW: NZ,NZFROM,NZTO,NZLPO  ',/,            YBRAN     393
     +   (1X,I5,3I6,I8,3I6,I8,3I6,I8,3I6,I8,3I6))                       YBRAN     394
         ENDIF                                                          YBRAN     395
C==                                                                     YBRAN     396
         DO 300 I=1,NBUS                                                YBRAN     397
         KK=I                                                           YBRAN     398
  290    KK0=IMSK(KK)                                                   YBRAN     399
         IF (KK0.EQ.0.OR.KK0.GT.NBUS) THEN                              YBRAN     400
         WRITE(MSG(1),1910) KK                                          YBRAN     401
         CALL PRTMSG(1)                                                 YBRAN     402
         MSG(1)='YBRAN : 0 ENTRY IN MSK IS ZERO'                        YBRAN     403
         CALL ASTOP(MSG(1),30)                                          YBRAN     404
         ELSE IF (KK0.GT.0) THEN                                        YBRAN     405
            IF (KK0.NE.I) THEN                                          YBRAN     406
               NELB=NELB+1                                              YBRAN     407
               MSKOLD(NELB)=I                                           YBRAN     408
               MSKNEW(NELB)=KK0                                         YBRAN     409
            ENDIF                                                       YBRAN     410
            MSK(I)=KK0                                                  YBRAN     411
            GOTO 300                                                    YBRAN     412
         ELSE                                                           YBRAN     413
            KK=-KK0                                                     YBRAN     414
            GOTO 290                                                    YBRAN     415
         ENDIF                                                          YBRAN     416
  300    CONTINUE                                                       YBRAN     417
      ENDIF                                                             YBRAN     418
C==                                                                     YBRAN     419
      IF (NELB.NE.0) THEN                                               YBRAN     420
      DO 320 I=1,NELB                                                   YBRAN     421
      K=I                                                               YBRAN     422
      MIN=MSKNEW(I)                                                     YBRAN     423
      I1=I+1                                                            YBRAN     424
      DO 310 J=I1,NELB                                                  YBRAN     425
      NEW=MSKNEW(J)                                                     YBRAN     426
      IF (NEW.LT.MIN) THEN                                              YBRAN     427
         MIN=NEW                                                        YBRAN     428
         K=J                                                            YBRAN     429
      ENDIF                                                             YBRAN     430
  310 CONTINUE                                                          YBRAN     431
      IF (K.NE.I) THEN                                                  YBRAN     432
         INEW=MSKNEW(I)                                                 YBRAN     433
         MSKNEW(I)=MSKNEW(K)                                            YBRAN     434
         MSKNEW(K)=INEW                                                 YBRAN     435
         IOLD=MSKOLD(I)                                                 YBRAN     436
         MSKOLD(I)=MSKOLD(K)                                            YBRAN     437
         MSKOLD(K)=IOLD                                                 YBRAN     438
      ENDIF                                                             YBRAN     439
  320 CONTINUE                                                          YBRAN     440
      NZEP=0                                                            YBRAN     441
      NZEB=0                                                            YBRAN     442
      NWORK=0                                                           YBRAN     443
      DO 330 I=1,NELB                                                   YBRAN     444
         IF(MSKNEW(I).NE.NWORK) THEN                                    YBRAN     445
            NWORK=MSKNEW(I)                                             YBRAN     446
            NZEB=NZEB+1                                                 YBRAN     447
            NZEVB(NZEB)=NWORK                                           YBRAN     448
            NZEP=NZEP+1                                                 YBRAN     449
            NZEVP(NZEP)=NZEB                                            YBRAN     450
         ENDIF                                                          YBRAN     451
         NZEB=NZEB+1                                                    YBRAN     452
         NZEVB(NZEB)=MSKOLD(I)                                          YBRAN     453
  330 CONTINUE                                                          YBRAN     454
      NZEVP(NZEP+1)=NZEB+1                                              YBRAN     455
C==                                                                     YBRAN     456
      IF (LDEB1) THEN                                                   YBRAN     457
      WRITE(IUD6,731) NELB                                              YBRAN     458
  731 FORMAT(1X,'DB-YBRAN_NEW: NELB ',I6)                               YBRAN     459
      WRITE(IUD6,732)(I,MSKOLD(I),MSKNEW(I),I=1,NELB)                   YBRAN     460
  732 FORMAT(1X,'DB-YBRAN_NEW: I,MSKOLD,MSKNEW ',/,                     YBRAN     461
     +(1X,I5,2I6,I8,2I6,I8,2I6,I8,2I6,I8,2I6,I8,2I6))                   YBRAN     462
      WRITE(IUD6,733) NZEP,(I,NZEVP(I),I=1,NZEP+1)                      YBRAN     463
      WRITE(IUD6,734) NZEB,(I,NZEVB(I),I=1,NZEB+1)                      YBRAN     464
  733 FORMAT(1X,'DB-YBRAN_NEW:NZEP,I,NZEVP.I ',I5,/,(1X,24I5))          YBRAN     465
  734 FORMAT(1X,'DB-YBRAN_NEW:NZEB,I,NZEVB.I ',I5,/,(1X,24I5))          YBRAN     466
      ENDIF                                                             YBRAN     467
C==                                                                     YBRAN     468
      ENDIF                                                             YBRAN     469
C=======================================================================YBRAN     470
C                                                                       YBRAN     471
C   SET UP MONITORED Z-I-L TABLES                                       YBRAN     472
C                                                                       YBRAN     473
      IF (NPFL.NE.0.AND.NZLINE.NE.0) THEN                               YBRAN     474
         KDUMP=NB/50                                                    YBRAN     475
         CALL MOVE(0,LGCHK,LGCHK,KDUMP)                                 YBRAN     476
         ILIN12=0                                                       YBRAN     477
         ILINE=0                                                        YBRAN     478
         KOFF=0                                                         YBRAN     479
  350    IF(ILINE.GE.NPFL) GOTO 450                                     YBRAN     480
         ILINE=ILINE+1                                                  YBRAN     481
         ILIN12=ILIN12+12                                               YBRAN     482
         ITFK=MLFTB(ILIN12-11)                                          YBRAN     483
         CALL UPACKI(JJJ,LSTATU,ITFK)                                   YBRAN     484
         IF(LSTATU.NE.0) GOTO 350                                       YBRAN     485
         KK=MLFTB(ILIN12-10)                                            YBRAN     486
         CALL UPACKI(IFRM,ITO,KK)                                       YBRAN     487
         IUID=MACKT(ILIN12-9)                                           YBRAN     488
         CALL UNPACK(LUID,JJJ,IUID)                                     YBRAN     489
         CALL LONZL(IFRM,ITO,LUID,KL,NPLL)                              YBRAN     490
         IF (KL.EQ.0) GOTO 350                                          YBRAN     491
         CALL PACKII(5,0,ITFK)                                          YBRAN     492
         MLFTB(ILIN12-11)=ITFK                                          YBRAN     493
         MLFTB(ILIN12-6)=NPLL                                           YBRAN     494
C - SEARCH ALONG ZIL LINKNET FOR BUS-PATH                               YBRAN     495
         LROOT=IFRM                                                     YBRAN     496
         LTO=ITO                                                        YBRAN     497
         LFRM=0                                                         YBRAN     498
         ASSIGN 360 TO IBACK1                                           YBRAN     499
         GOTO 460                                                       YBRAN     500
  360    CONTINUE                                                       YBRAN     501
         IF (LH.EQ.1) GOTO 400                                          YBRAN     502
         LFRM=LH                                                        YBRAN     503
         DO 370 IL=1,LFRM                                               YBRAN     504
            LTBFRM(IL)=LTBL(IL)                                         YBRAN     505
  370    CONTINUE                                                       YBRAN     506
         LROOT=ITO                                                      YBRAN     507
         LTO=IFRM                                                       YBRAN     508
         ASSIGN 380 TO IBACK1                                           YBRAN     509
         GOTO 460                                                       YBRAN     510
C                                                                       YBRAN     511
  460  LH=1                                                             YBRAN     512
       LPRS=1                                                           YBRAN     513
       LTBL(1)=LROOT                                                    YBRAN     514
  470  KP=NZFELI(LROOT)                                                 YBRAN     515
  480  IF(NZFENO(KP).GT.0.AND.NZFENO(KP).NE.LTO)THEN                    YBRAN     516
        IKK=NZFENO(KP)                                                  YBRAN     517
        IWS1=IMSK(IKK)                                                  YBRAN     518
        IF(IABS(IWS1).NE.LTO)THEN                                       YBRAN     519
          IWS1=IMSK(LTO)                                                YBRAN     520
          IF(IABS(IWS1).NE.IKK)THEN                                     YBRAN     521
            LH=LH+1                                                     YBRAN     522
            LTBL(LH)=NZFENO(KP)                                         YBRAN     523
            LTOL(LH)=LTO                                                YBRAN     524
          ENDIF                                                         YBRAN     525
        ENDIF                                                           YBRAN     526
       ENDIF                                                            YBRAN     527
       IF(NZNELI(KP).NE.0)THEN                                          YBRAN     528
         KP=NZNELI(KP)                                                  YBRAN     529
         GOTO 480                                                       YBRAN     530
       ENDIF                                                            YBRAN     531
       LPRS=LPRS+1                                                      YBRAN     532
       IF(LPRS.LE.LH)THEN                                               YBRAN     533
         LROOT=LTBL(LPRS)                                               YBRAN     534
         LTO=LTOL(LPRS)                                                 YBRAN     535
         GOTO 470                                                       YBRAN     536
       ENDIF                                                            YBRAN     537
       GOTO IBACK1                                                      YBRAN     538
C                                                                       YBRAN     539
  380    CONTINUE                                                       YBRAN     540
         IF (LFRM.LT.LH) THEN                                           YBRAN     541
            LH=LFRM                                                     YBRAN     542
            DO 390 IL=1,LH                                              YBRAN     543
               LTBL(IL)=LTBFRM(IL)                                      YBRAN     544
  390       CONTINUE                                                    YBRAN     545
         ELSE                                                           YBRAN     546
            MLFTB(ILIN12-6)=-MLFTB(ILIN12-6)                            YBRAN     547
         ENDIF                                                          YBRAN     548
  400    CONTINUE                                                       YBRAN     549
         MLFTB(ILIN12-5)=LH                                             YBRAN     550
         LROOT=LTBL(1)                                                  YBRAN     551
         LMSK=MSK(LROOT)                                                YBRAN     552
         DO 410 IGP=1,NZEP                                              YBRAN     553
            IB=NZEVP(IGP)                                               YBRAN     554
            LB=NZEVB(IB)                                                YBRAN     555
            IF(LB.EQ.LMSK) GOTO 420                                     YBRAN     556
  410    CONTINUE                                                       YBRAN     557
  420    CONTINUE                                                       YBRAN     558
         LCK1=NZEVP(IGP)                                                YBRAN     559
         LCK2=NZEVP(IGP+1)-1                                            YBRAN     560
         DO 440 IL=1,LH                                                 YBRAN     561
            LBUS=LTBL(IL)                                               YBRAN     562
            LCKL=LCK1                                                   YBRAN     563
  430       IF(NZEVB(LCKL).EQ.LBUS)THEN                                 YBRAN     564
C - DUMP INTO MLFTB(ILIN12-4,-3,..) THE BUS POSITION IN 'EQVBP'         YBRAN     565
               MLFTB(ILIN12-5+IL)=LCKL                                  YBRAN     566
               IF(LGCHK(LCKL).EQ.0)THEN                                 YBRAN     567
                  LGCHK(LCKL)=100                                       YBRAN     568
C - STORE THE ORIGINAL 'STAIRS'                                         YBRAN     569
                  GEQB(LCKL)=REAL(STAIRS(LBUS))                         YBRAN     570
                  BEQB(LCKL)=-AIMAG(STAIRS(LBUS))                       YBRAN     571
C                                                                       YBRAN     572
C   SET UP THE BUS-LINE CONNECTION FOR BUSES FOUND ABOVE                YBRAN     573
C                                                                       YBRAN     574
                  NEQBLT(LCKL)=KOFF+1                                   YBRAN     575
                  LHEAD=LBRI(LBUS)                                      YBRAN     576
  435             CONTINUE                                              YBRAN     577
                  IF(LHEAD.NE.0)THEN                                    YBRAN     578
                     KOFF=KOFF+1                                        YBRAN     579
                     LTOB=KTNO(LHEAD)                                   YBRAN     580
                     LPO=(LHEAD+1)/2                                    YBRAN     581
                     NZTOB(KOFF)=LTOB                                   YBRAN     582
                     LSTOFF(KOFF)=KOFF+1                                YBRAN     583
                     IF(LBUS.LT.LTOB)THEN                               YBRAN     584
                        NZYOFF(KOFF)=BRAU(LPO)                          YBRAN     585
                     ELSE                                               YBRAN     586
                        NZYOFF(KOFF)=BRAL(LPO)                          YBRAN     587
                     ENDIF                                              YBRAN     588
                     LHEAD=NELI(LHEAD)                                  YBRAN     589
                     GOTO 435                                           YBRAN     590
                  ENDIF                                                 YBRAN     591
                  LSTOFF(KOFF)=0                                        YBRAN     592
               ENDIF                                                    YBRAN     593
              GOTO 440                                                  YBRAN     594
           ENDIF                                                        YBRAN     595
           LCKL=LCKL+1                                                  YBRAN     596
           IF(LCKL.GT.LCK2)THEN                                         YBRAN     597
              WRITE(MSG(1),9100) LBUS,IGP                               YBRAN     598
              WRITE(MSG(2),9110) LCK1,LCK2                              YBRAN     599
              WRITE(MSG(3),9120) (NZEVB(LCK),LCK=LCK1,LCK1+9)           YBRAN     600
              WRITE(MSG(4),9130) (NZEVB(LCK),LCK=LCK1+10,LCK2)          YBRAN     601
              CALL PRTMSG(4)                                            YBRAN     602
              MSG(1)='YBRAN: MONITORED ZIL ERROR'                       YBRAN     603
              CALL ASTOP(MSG(1),26)                                     YBRAN     604
           ENDIF                                                        YBRAN     605
           GOTO 430                                                     YBRAN     606
  440   CONTINUE                                                        YBRAN     607
        GOTO 350                                                        YBRAN     608
  450 CONTINUE                                                          YBRAN     609
C - END OF (NPFL.NE.0)                                                  YBRAN     610
      ENDIF                                                             YBRAN     611
C==                                                                     YBRAN     612
      IF(LDEB1)THEN                                                     YBRAN     613
         IF(NPFL.NE.0.AND.NZLINE.NE.0)THEN                              YBRAN     614
         ILIN12=0                                                       YBRAN     615
         DO 765 IML=1,NPFL                                              YBRAN     616
         ILIN12=ILIN12+12                                               YBRAN     617
         KK=MLFTB(ILIN12-11)                                            YBRAN     618
         CALL UPACKI(MTYP,LSTATU,KK)                                    YBRAN     619
         ITFK=MLFTB(ILIN12-10)                                          YBRAN     620
         CALL UPACKI(IFRM,ITO,ITFK)                                     YBRAN     621
         IUID=MACKT(ILIN12-9)                                           YBRAN     622
         CALL UNPACK(LUID,JJJ,IUID)                                     YBRAN     623
         WRITE(IUD6,761) IML,LSTATU,IFRM,ITO,LUID,MTYP,                 YBRAN     624
     +                 (MLFTB(ILIN12-12+LL),LL=6,12)                    YBRAN     625
  761    FORMAT(1X,'DB-YBRAN:IML,LSTAT,IFRM,ITO,LUID,MTYP,MLFTB6.12 ',  YBRAN     626
     +          4I5,1X,A2,2X,8I5)                                       YBRAN     627
  765    CONTINUE                                                       YBRAN     628
C                                                                       YBRAN     629
         DO 766 IEB=1,NZEB                                              YBRAN     630
         WRITE(IUD6,762) IEB,LGCHK(IEB),NEQBLT(IEB),GEQB(IEB)           YBRAN     631
     +                 ,BEQB(IEB)                                       YBRAN     632
  762    FORMAT(1X,'DB-YBRAN:IEB,LG,NO,HEAD,G,B ',3I5,1X,2G12.5)        YBRAN     633
  766    CONTINUE                                                       YBRAN     634
C                                                                       YBRAN     635
         WRITE(IUD6,763) KOFF,(ILS,LSTOFF(ILS),NZTOB(ILS),NZYOFF(ILS),  YBRAN     636
     +                 ILS=1,KOFF)                                      YBRAN     637
  763    FORMAT(1X,'DB-YBRAN:KOFF ',I5,/,(1X,'DB-YBRAN:ILS,LSTOFF,',    YBRAN     638
     +         'NZTOB,NZYOFF ',3I5,1X,2G12.5))                          YBRAN     639
         ENDIF                                                          YBRAN     640
      ENDIF                                                             YBRAN     641
C==                                                                     YBRAN     642
C==========================================================             YBRAN     643
C--                                                                     YBRAN     644
      CALL MISCHK(LLNET)                                                YBRAN     645
C                                                                       YBRAN     646
      RETURN                                                            YBRAN     647
C                                                                       YBRAN     648
  920 FORMAT(1X,'ORDERED TRANSFORMER LIST',/,(2I10,2G12.4))             YBRAN     649
  930 FORMAT(1X,'TRANS',3I5,9G10.4,/,'GBUSX=',G12.4                     YBRAN     650
     &,' BUSX=',G12.4,' CHG=',G12.4)                                    YBRAN     651
 1070 FORMAT(1X,'YBRAN I,J,K ETC',3I5,4G12.5)                           YBRAN     652
 1080 FORMAT(' IFNBUS = ',I5)                                           YBRAN     653
 1090 FORMAT( ' I , CINF(I) = ',I5,2F10.5)                              YBRAN     654
 1910 FORMAT(' *** ERROR MASK OF THE ',I5,'TH ENTRY IN MSK IS ZERO')    YBRAN     655
 9100 FORMAT(' *** ERROR IN FINDING BUS ',I5                            YBRAN     656
     *,' IN EQUAL POTENTIAL GROUP ',I5)                                 YBRAN     657
 9110 FORMAT(11X,'LCK1=',I5,'   LCK2=',I5)                              YBRAN     658
 9120 FORMAT(11X,'NZEVB=',10I5)                                         YBRAN     659
 9130 FORMAT(17X,10I5)                                                  YBRAN     660
 9200 FORMAT(                                                           YBRAN     661
     *' *** WARNING THERE IS A ZERO IMPEDANCE LINE WITH CIRCUIT ID ',A2)YBRAN     662
 9210 FORMAT(                                                           YBRAN     663
     *'     IN PARALLEL WITH ANOTHER LINE WITH CIRCUIT ID ',A2,         YBRAN     664
     *' BETWEEN')                                                       YBRAN     665
 9220 FORMAT('     BUS : ',I6,1X,3A4,' AND BUS : ',I6,1X,3A4)           YBRAN     666
      END                                                               YBRAN     667
