CFPRIME RENET                                                           RENET       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 RENET                                                  RENET       3
CD                                                                      RENET       4
CD    TO RENUMBER THE FROM AND TO BUS NUMBERS FOR ALL LINES AND         RENET       5
CD    TRANSFORMERS, ALL MONITORED LINES AND TRANFORMERS ACCORDING TO    RENET       6
CD    THE PROGRAM BUS NUMERING SYSTEM. CORRECT THE TRANFORMER           RENET       7
CD    IMPEDANCE ACCORDING TO THE IMPEDANCE CORRECTION TABLE.            RENET       8
CD                                                                      RENET       9
      INCLUDE 'PARX.INS'                                                RENET      10
      INCLUDE 'CNFLAG.INS'                                              RENET      11
      INCLUDE 'CNPT.INS'                                                RENET      12
      INCLUDE 'CNIPTR.INS'                                              RENET      13
      INCLUDE 'CNB19.INS'                                               RENET      14
      INCLUDE 'CNPARX.INS'                                              RENET      15
      INCLUDE 'CNMNEW.INS'                                              RENET      16
      INCLUDE 'CNNNEW.INS'                                              RENET      17
      INCLUDE 'CNLFDA.INS'                                              RENET      18
      INCLUDE 'CNMON.INS'                                               RENET      19
      INCLUDE 'CNSELI.INS'                                              RENET      20
      INCLUDE 'CNLKN1.INS'                                              RENET      21
      INCLUDE 'CNLIN1.INS'                                              RENET      22
      INCLUDE 'CNUNIT.INS'                                              RENET      23
      INCLUDE 'CNSTN.INS'                                               RENET      24
      INCLUDE 'CNULTC.INS'                                              RENET      25
      INCLUDE 'CNMDAT.INS'                                              RENET      26
      INCLUDE 'CNMSG.INS'                                               RENET      27
C                                                                       RENET      28
      INTEGER  LISMON(NPL)                                              RENET      29
      EQUIVALENCE (BUDAT(1),LISMON(1))                                  RENET      30
      CHARACTER*4 IRADX(MONL*12),IRORIG(MONL*12),IXORIG(MONL*12)        RENET      31
      EQUIVALENCE                                                       RENET      32
     *(RADX(1),IRADX(1)),(RORIG(1),IRORIG(1)),(XORIG(1),IXORIG(1))      RENET      33
      CHARACTER*4 KNAME(3)                                              RENET      34
      INTEGER*4 JCKID                                                   RENET      35
      CHARACTER*2 ICKT,NCID                                             RENET      36
      CHARACTER*2 CKID,CKK                                              RENET      37
      DIMENSION KKR1(1),KKR2(1),KKR3(1),KKR4(1),KKR5(1),XKR5(1)         RENET      38
      EQUIVALENCE (KKR5(1),ISPEED),(XKR5(1),ERTOL)                      RENET      39
     1,(KKR1(1),LFNO),(KKR2(1),NT),(KKR3(1),NPKPR),(KKR4(1),IALPT)      RENET      40
      LOGICAL CFLAG,LDEB1                                               RENET      41
CD                                                                      RENET      42
CD    FUNCTION OF THIS ROUTINE:                                         RENET      43
CD                                                                      RENET      44
CD    1. RENUMBER THE FROM AND TO BUS NUMBERS FOR ALL LINES, SINCE      RENET      45
CD       TRANSFORMERS HAVE THEIR OWN CONVENTION SPECIAL CARE WILL BE    RENET      46
CD       MADE FOR THE POLARITY.                                         RENET      47
CD    2. FORM THE LINKNET, A SPECIAL THREAD FOR EASY ACCESSING A LINE.  RENET      48
CD    3. STORE THE LINE PARAMETERS OF THE MONITORING LINES IN THE       RENET      49
CD       MONITORING LINE DATA ARRAYS FOR LATER USE.                     RENET      50
CD                                                                      RENET      51
      LDEB=(JDEB(23).NE.0)                                              RENET      52
      LDEB1=(JDEB(250).NE.0)                                            RENET      53
C                                                                       RENET      54
      IEBK=0                                                            RENET      55
C                                                                       RENET      56
      IF (LDEB) THEN                                                    RENET      57
         WRITE (IUD6,3400)                                              RENET      58
         IFIN=MIN(100,NL)                                               RENET      59
         DO 100 I=1,IFIN                                                RENET      60
            KK=I*5                                                      RENET      61
            JJ=LFTB(KK-3)                                               RENET      62
            CALL UPACKI(NLF1,NLF2,JJ)                                   RENET      63
            NLF1=LBUS(NLF1)                                             RENET      64
            NLF2=LBUS(NLF2)                                             RENET      65
            JCKID=LFTB(KK-4)                                            RENET      66
            CALL UNPACK(ICKT,JJJ,JCKID)                                 RENET      67
            WRITE(IUD6,3500) NLF1,NLF2,ICKT,GA(KK-2),BA(KK-1),BCHG(KK)  RENET      68
  100    CONTINUE                                                       RENET      69
      END IF                                                            RENET      70
C                                                                       RENET      71
C   TRANSFORMER POLARITY                                                RENET      72
C                                                                       RENET      73
C   SEE WHETHER CONVENTION VALID WITH INTERNAL BUS ORDER                RENET      74
C   IF NOT, PUT "RATIO" INTO NEGATIVE TO INDICATE                       RENET      75
C                                                                       RENET      76
      DO 200 I=1,ITRF                                                   RENET      77
      L=ITRAN(I)                                                        RENET      78
      L=L*5                                                             RENET      79
      KK=LFTB(L-3)                                                      RENET      80
      CALL UPACKI(J1,K1,KK)                                             RENET      81
      J1=LBUS(J1)                                                       RENET      82
      K1=LBUS(K1)                                                       RENET      83
      J=NNEW(J1)                                                        RENET      84
      K=NNEW(K1)                                                        RENET      85
      IF(J.GT.K)THEN                                                    RENET      86
      ITR=I+I                                                           RENET      87
      RATIO(ITR-1)=-RATIO(ITR-1)                                        RENET      88
      ENDIF                                                             RENET      89
      IF(LDEB)                                                          RENET      90
     *WRITE(IUD6,3600) I,L,J1,K1,J,K,RATIO(I+I-1),RANG(I+I)             RENET      91
  200 CONTINUE                                                          RENET      92
C                                                                       RENET      93
C  RENUMBER THE FROM AND TO BUS NUMBERS OF A BRANCH                     RENET      94
C                                                                       RENET      95
      KK=0                                                              RENET      96
      DO 300 I=1,NL                                                     RENET      97
      LTRANC(I)=0                                                       RENET      98
      KK=KK+5                                                           RENET      99
      IL=LFTB(KK-3)                                                     RENET     100
      CALL UPACKI(J,K,IL)                                               RENET     101
      J=LBUS(J)                                                         RENET     102
      K=LBUS(K)                                                         RENET     103
      J=NNEW(J)                                                         RENET     104
      K=NNEW(K)                                                         RENET     105
      IF(J.LT.K)THEN                                                    RENET     106
      CALL PACKII(J,K,IL)                                               RENET     107
      ELSE                                                              RENET     108
      CALL PACKII(K,J,IL)                                               RENET     109
      ENDIF                                                             RENET     110
      LFTB(KK-3)=IL                                                     RENET     111
  300 CONTINUE                                                          RENET     112
C                                                                       RENET     113
C  RENUMBER THE FROM AND TO BUS NUMBERS OF SEGMENTED LINES              RENET     114
C                                                                       RENET     115
      DO 500 I=1,NSEL                                                   RENET     116
      J=LCONE(1,I)                                                      RENET     117
      K=LCONE(2,I)                                                      RENET     118
      J=LBUS(J)                                                         RENET     119
      K=LBUS(K)                                                         RENET     120
      J=NNEW(J)                                                         RENET     121
      K=NNEW(K)                                                         RENET     122
      IF(J.LT.K)THEN                                                    RENET     123
      LCONE(1,I)=J                                                      RENET     124
      LCONE(2,I)=K                                                      RENET     125
      ELSE                                                              RENET     126
      LCONE(1,I)=K                                                      RENET     127
      LCONE(2,I)=J                                                      RENET     128
      IPOS= LCONE(5,I)                                                  RENET     129
      PGC1=EQPI(3,I)                                                    RENET     130
      PBC1=EQPI(4,I)                                                    RENET     131
      EQPI(3,I)=EQPI(5,I)                                               RENET     132
      EQPI(4,I)=EQPI(6,I)                                               RENET     133
      EQPI(5,I)=PGC1                                                    RENET     134
      EQPI(6,I)=PBC1                                                    RENET     135
      PGC1=EQPI(9,I)                                                    RENET     136
      PBC1=EQPI(10,I)                                                   RENET     137
      EQPI(9,I)=EQPI(11,I)                                              RENET     138
      EQPI(10,I)=EQPI(12,I)                                             RENET     139
      EQPI(11,I)=PGC1                                                   RENET     140
      EQPI(12,I)=PBC1                                                   RENET     141
      PGC1=EQPI(15,I)                                                   RENET     142
      PBC1=EQPI(16,I)                                                   RENET     143
      EQPI(15,I)=EQPI(17,I)                                             RENET     144
      EQPI(16,I)=EQPI(18,I)                                             RENET     145
      EQPI(17,I)=PGC1                                                   RENET     146
      EQPI(18,I)=PBC1                                                   RENET     147
  400 CONTINUE                                                          RENET     148
      PGC1=PSELIN(3,IPOS)                                               RENET     149
      PBC1=PSELIN(4,IPOS)                                               RENET     150
      PSELIN(3,IPOS)=PSELIN(5,IPOS)                                     RENET     151
      PSELIN(4,IPOS)=PSELIN(6,IPOS)                                     RENET     152
      PSELIN(5,IPOS)=PGC1                                               RENET     153
      PSELIN(6,IPOS)=PBC1                                               RENET     154
      IPOS=NEXTSL(1,IPOS)                                               RENET     155
      IF(IPOS.NE.0)GOTO 400                                             RENET     156
      ENDIF                                                             RENET     157
  500 CONTINUE                                                          RENET     158
C                                                                       RENET     159
C   ESTABLISH LTRANC ARRAY                                              RENET     160
C                                                                       RENET     161
      DO 600 I=1,ITRF                                                   RENET     162
      K=ITRAN(I)                                                        RENET     163
      LTRANC(K)=I                                                       RENET     164
  600 CONTINUE                                                          RENET     165
C                                                                       RENET     166
C   FORM THE LINKNET ARRAYS FOR MONITORING ITEM AND SWITCHING           RENET     167
C                                                                       RENET     168
C     INITIALIZ LINKNET ARRAYS                                          RENET     169
C                                                                       RENET     170
      K=NLFBUS                                                          RENET     171
      CALL MOVE(0,LBRI,LBRI,K)                                          RENET     172
      K=NL*2                                                            RENET     173
      CALL MOVE(0,LINEPO,LINEPO,K)                                      RENET     174
      CALL MOVE(0,NELI,NELI,K)                                          RENET     175
      CALL HMOVE(0,KTNO,KTNO,K)                                         RENET     176
C                                                                       RENET     177
      LNET=0                                                            RENET     178
      DO 700 I=1,NL                                                     RENET     179
      LISMON(I)=0                                                       RENET     180
      JL=I*5                                                            RENET     181
      JCKID=LFTB(JL-4)                                                  RENET     182
      KK=LFTB(JL-3)                                                     RENET     183
      CALL UPACKI(NODEJ,NODEK,KK)                                       RENET     184
      LNET=LNET+1                                                       RENET     185
      IENDB=LNET+LNET                                                   RENET     186
      IENDA=IENDB-1                                                     RENET     187
      NELI(IENDA)=LBRI(NODEJ)                                           RENET     188
      LINEPO(IENDA)=I                                                   RENET     189
      IARCCT(LNET)=JCKID                                                RENET     190
      LBRI(NODEJ)=IENDA                                                 RENET     191
      KTNO(IENDA)=NODEK                                                 RENET     192
      NELI(IENDB)=LBRI(NODEK)                                           RENET     193
      LINEPO(IENDB)=-I                                                  RENET     194
      LBRI(NODEK)=IENDB                                                 RENET     195
      KTNO(IENDB)=NODEJ                                                 RENET     196
  700 CONTINUE                                                          RENET     197
C                                                                       RENET     198
C                                                                       RENET     199
C   CORRECT TRANSFORMER IMPEDANCE                                       RENET     200
C                                                                       RENET     201
      IF (NSC.EQ.0) GOTO 900                                            RENET     202
C                                                                       RENET     203
      IPSC=0                                                            RENET     204
      DO 800 ISC=1,NSC                                                  RENET     205
        IPSC=IPSC+9                                                     RENET     206
        NPBNI=ISCFRM(IPSC-8)                                            RENET     207
        NPBNJ=ISCTO(IPSC-7)                                             RENET     208
        NPBNOI=NNEW(NPBNI)                                              RENET     209
        NPBNOJ=NNEW(NPBNJ)                                              RENET     210
        JCKID=ISCCID(IPSC-6)                                            RENET     211
        CALL UNPACK(CKID,NTB0,JCKID)                                    RENET     212
        NTB=NTB0                                                        RENET     213
        IF(NTB.GT.1000)NTB=NTB-1000                                     RENET     214
        IF(NTB.EQ.0.OR.NTB.EQ.1000)GOTO 800                             RENET     215
        IF (LDEB1) WRITE(IUD6,4900) ISC,IPSC,NPBNI,NPBNJ,CKID,NTB0      RENET     216
     *                                      ,NPBNOI,NPBNOJ              RENET     217
        CALL LOLINE(NPBNOI,NPBNOJ,CKID,JNL)                             RENET     218
        IF (JNL.EQ.0)GOTO 800                                           RENET     219
        JNL5=IABS(JNL)                                                  RENET     220
        JTRF=LTRANC(JNL5)                                               RENET     221
        JNL5=JNL5*5                                                     RENET     222
        JTRF2=JTRF*2                                                    RENET     223
        VMAG=ABS(RATIO(JTRF2-1))                                        RENET     224
        VPHS=RANG(JTRF2)                                                RENET     225
        IF(LDEB1) WRITE(IUD6,5100) IPSC,NTB0,VPHS                       RENET     226
        CALL COEFSC(NTB,VPHS,VMAG,COEF,CORTBL,CFLAG)                    RENET     227
        IF(LDEB1) WRITE(IUD6,5000) JNL5,JTRF2,VPHS,COEF,GA(JNL5-2),     RENET     228
     +                          BA(JNL5-1),CFLAG                        RENET     229
        IF (CFLAG) THEN                                                 RENET     230
          KNTB=(NTB-1)*22                                               RENET     231
          IF(KLFO.EQ.0)THEN                                             RENET     232
            WRITE(MSG(3),3900) NPBNI,NPBNJ,CKID,NTB                     RENET     233
          ELSE                                                          RENET     234
            NI=NNEW(NPBNI)                                              RENET     235
            NJ=NNEW(NPBNJ)                                              RENET     236
            NI=NI*3                                                     RENET     237
            NJ=NJ*3                                                     RENET     238
            WRITE(MSG(3),4000) INAME(NI-2),INAME(NI-1),INAME(NI)        RENET     239
     *                     ,INAME(NJ-2),INAME(NJ-1),INAME(NJ),CKID,NTB  RENET     240
          ENDIF                                                         RENET     241
          IF(NTB0.GT.1000)THEN                                          RENET     242
            WRITE(MSG(1),4100)                                          RENET     243
            WRITE(MSG(4),4300) VPHS                                     RENET     244
          ELSE                                                          RENET     245
            WRITE(MSG(1),4700)                                          RENET     246
            WRITE(MSG(4),4400) VMAG                                     RENET     247
          ENDIF                                                         RENET     248
          WRITE(MSG(2),4200)                                            RENET     249
          WRITE(MSG(5),4500)                                            RENET     250
          WRITE(MSG(6),4600) (CORTBL(KNTB+II),II=1,6)                   RENET     251
          WRITE(MSG(7),4600) (CORTBL(KNTB+II),II=7,12)                  RENET     252
          WRITE(MSG(8),4600) (CORTBL(KNTB+II),II=13,18)                 RENET     253
          WRITE(MSG(9),4600) (CORTBL(KNTB+II),II=19,22)                 RENET     254
          CALL PRTMSG(9)                                                RENET     255
        ENDIF                                                           RENET     256
        GA(JNL5-2)=GA(JNL5-2)/COEF                                      RENET     257
        BA(JNL5-1)=BA(JNL5-1)/COEF                                      RENET     258
  800 CONTINUE                                                          RENET     259
  900 CONTINUE                                                          RENET     260
C                                                                       RENET     261
C   PICK UP LINE IMPEDANCE FOR THE MONITORED LINES                      RENET     262
C                                                                       RENET     263
      IF (NPFL.NE.0)THEN                                                RENET     264
      NPFL12=0                                                          RENET     265
      DO 1000 N=1,NPFL                                                  RENET     266
      NPFL12=NPFL12+12                                                  RENET     267
      NLFJ=MLFTB(NPFL12-6)                                              RENET     268
      NLFK=MLFTB(NPFL12-5)                                              RENET     269
      JCKID=MACKT(NPFL12-9)                                             RENET     270
      CALL UNPACK(CKID,JJJ,JCKID)                                       RENET     271
      LSTATU=MLFTB(NPFL12-11)                                           RENET     272
      IF(LSTATU.EQ.0)THEN                                               RENET     273
      JSEL=0                                                            RENET     274
      NPBNOI=NNEW(NLFJ)                                                 RENET     275
      NPBNOJ=NNEW(NLFK)                                                 RENET     276
      CALL LOLINE(NPBNOI,NPBNOJ,CKID,JNL)                               RENET     277
C                                                                       RENET     278
      IF(JNL.NE.0)THEN                                                  RENET     279
C                                                                       RENET     280
C   LINE FOUND                                                          RENET     281
C                                                                       RENET     282
      CALL PACKII(NPBNOI,NPBNOJ,ITFK)                                   RENET     283
      MLFTB(NPFL12-10)=ITFK                                             RENET     284
      JNL5=IABS(JNL)                                                    RENET     285
      LISMON(JNL5)=N                                                    RENET     286
      JTRF=LTRANC(JNL5)                                                 RENET     287
      JNL5=JNL5*5                                                       RENET     288
      IRS=MTYIRS(NPFL12-8)                                              RENET     289
      KRS=0                                                             RENET     290
      GAKK=GA(JNL5-2)                                                   RENET     291
      BAKK=BA(JNL5-1)                                                   RENET     292
      BCHGKK=BCHG(JNL5)                                                 RENET     293
       IF(JTRF.EQ.0)THEN                                                RENET     294
       MTYP=1                                                           RENET     295
       GJJ=GAKK                                                         RENET     296
       BJJ=BAKK-0.5*BCHGKK                                              RENET     297
       GJK=GAKK                                                         RENET     298
       BJK=BAKK                                                         RENET     299
       ELSE                                                             RENET     300
       GJJ=GAKK                                                         RENET     301
       BJJ=BAKK                                                         RENET     302
       JTRF2=JTRF*2                                                     RENET     303
       ONR=RATIO(JTRF2-1)                                               RENET     304
       PHS=RANG(JTRF2)/57.29578                                         RENET     305
       IF(JNL.LT.0)ONR=-ONR                                             RENET     306
       COSO=COS(PHS)                                                    RENET     307
       SINO=SIN(PHS)                                                    RENET     308
          IF(ONR.GT.0.0)THEN                                            RENET     309
          MTYP=2                                                        RENET     310
          ONRSQ=ONR**2                                                  RENET     311
          GJJ=GJJ/ONRSQ                                                 RENET     312
          BJJ=BJJ/ONRSQ                                                 RENET     313
          SINO=-SINO                                                    RENET     314
          ELSE                                                          RENET     315
          MTYP=3                                                        RENET     316
          ONR=ABS(ONR)                                                  RENET     317
          ENDIF                                                         RENET     318
C                                                                       RENET     319
       GJK=(GAKK*COSO-BAKK*SINO)/ONR                                    RENET     320
       BJK=(GAKK*SINO+BAKK*COSO)/ONR                                    RENET     321
C                                                                       RENET     322
       ENDIF                                                            RENET     323
C                                                                       RENET     324
C  IF LINE IS COMPENSATED OR SEGMENTED UPDATE THE SHUNT COMPONENT       RENET     325
C                                                                       RENET     326
      JCKID=LFTB(JNL5-4)                                                RENET     327
      CALL UNPACK(CKK,JSEL,JCKID)                                       RENET     328
      IF(JSEL.NE.0)THEN                                                 RENET     329
         IF(JNL.GT.0)THEN                                               RENET     330
         GJJ=GJJ+EQPI(3,JSEL)                                           RENET     331
         BJJ=BJJ-EQPI(4,JSEL)                                           RENET     332
         ELSE                                                           RENET     333
         GJJ=GJJ+EQPI(5,JSEL)                                           RENET     334
         BJJ=BJJ-EQPI(6,JSEL)                                           RENET     335
         ENDIF                                                          RENET     336
      ENDIF                                                             RENET     337
C                                                                       RENET     338
C                                                                       RENET     339
C   STORE EQUIVALENT ADMITANCE                                          RENET     340
C                                                                       RENET     341
      GLM(NPFL12-6)=GJJ                                                 RENET     342
      BLM(NPFL12-5)=BJJ                                                 RENET     343
C                                                                       RENET     344
      BLCF(NPFL12-4)=GJK                                                RENET     345
      BLT(NPFL12-3)=BJK                                                 RENET     346
C                                                                       RENET     347
C PICKUP RELAY DATA                                                     RENET     348
C                                                                       RENET     349
      IF(IRS.EQ.0)THEN                                                  RENET     350
        KRS=3                                                           RENET     351
        IF(MTYP.EQ.1)THEN                                               RENET     352
        CANG=75.0                                                       RENET     353
        RADXN=1.0/SQRT(GAKK**2+BAKK**2)                                 RENET     354
        CMAG=0.65*RADXN                                                 RENET     355
        RADXN=0.9*RADXN                                                 RENET     356
        IRD(1,N)='PROG'                                                 RENET     357
        IRD(2,N)='    '                                                 RENET     358
        IRD(3,N)='    '                                                 RENET     359
        ELSE                                                            RENET     360
        IRD(1,N)='    '                                                 RENET     361
        IRD(2,N)='    '                                                 RENET     362
        IRD(3,N)='    '                                                 RENET     363
        CANG=0.0                                                        RENET     364
        CMAG=0.0                                                        RENET     365
        RADXN=0.0                                                       RENET     366
        ENDIF                                                           RENET     367
C                                                                       RENET     368
      ELSE IF(IRS.EQ.1)THEN                                             RENET     369
       KRS=2                                                            RENET     370
       CANG=XORIG(NPFL12)                                               RENET     371
       CMAG=RORIG(NPFL12-1)                                             RENET     372
       RADXN=RADX(NPFL12-2)                                             RENET     373
       IRD(1,N)='    '                                                  RENET     374
       IRD(2,N)='    '                                                  RENET     375
       IRD(3,N)='    '                                                  RENET     376
      ELSE                                                              RENET     377
        KNAME(1)=IRADX(NPFL12-2)                                        RENET     378
        KNAME(2)=IRORIG(NPFL12-1)                                       RENET     379
        KNAME(3)=IXORIG(NPFL12)                                         RENET     380
        IRD(1,N)=KNAME(1)                                               RENET     381
        IRD(2,N)=KNAME(2)                                               RENET     382
        IRD(3,N)=KNAME(3)                                               RENET     383
C                                                                       RENET     384
      CALL FRELAY(KNAME,KRS,CANG,CMAG,RADXN)                            RENET     385
C                                                                       RENET     386
         IF(KRS.EQ.1)THEN                                               RENET     387
C                                                                       RENET     388
C   WRITE ERROR MESSAGE                                                 RENET     389
C                                                                       RENET     390
         ENDIF                                                          RENET     391
C                                                                       RENET     392
      ENDIF                                                             RENET     393
C                                                                       RENET     394
C   STORE RELAY DATA                                                    RENET     395
C                                                                       RENET     396
      RORIG(NPFL12-1)=CMAG*COS(CANG/57.29578)                           RENET     397
      XORIG(NPFL12)=CMAG*SIN(CANG/57.29578)                             RENET     398
      RADX(NPFL12-2)=RADXN**2                                           RENET     399
      JRSKRS(NPFL12-7)=KRS                                              RENET     400
      CALL PACKII(MTYP,LSTATU,ITFK)                                     RENET     401
      MLFTB(NPFL12-11)=ITFK                                             RENET     402
      CALL PACKII(JSEL,IRS,ITFK)                                        RENET     403
      MTYIRS(NPFL12-8)=ITFK                                             RENET     404
                                                                        RENET     405
C                                                                       RENET     406
      ELSE                                                              RENET     407
C                                                                       RENET     408
C   BUSES EXIST BUT LINE NOT FOUND                                      RENET     409
C                                                                       RENET     410
      MLFTB(NPFL12-11)=2                                                RENET     411
C                                                                       RENET     412
C   WRITE NOT FOUND MESSAGE                                             RENET     413
C                                                                       RENET     414
      IF(KLFO.EQ.0)THEN                                                 RENET     415
      WRITE(MSG(2),3200) NLFJ,NLFK,CKID                                 RENET     416
      ELSE                                                              RENET     417
      NJ=NNEW(NLFJ)                                                     RENET     418
      NJ=NJ*3                                                           RENET     419
      NK=NNEW(NLFK)                                                     RENET     420
      NK=NK*3                                                           RENET     421
      WRITE(MSG(2),3100) INAME(NJ-2),INAME(NJ-1),INAME(NJ)              RENET     422
     *  ,INAME(NK-2),INAME(NK-1),INAME(NK),CKID                         RENET     423
      ENDIF                                                             RENET     424
      WRITE(MSG(1),3000)                                                RENET     425
      WRITE(MSG(3),3300)                                                RENET     426
      CALL PRTMSG(3)                                                    RENET     427
      ENDIF                                                             RENET     428
C                                                                       RENET     429
C   BUSES DOES NOT EXIST                                                RENET     430
C                                                                       RENET     431
      ELSE                                                              RENET     432
C                                                                       RENET     433
      IF(KLFO.EQ.0)THEN                                                 RENET     434
      WRITE(MSG(2),3200) NLFJ,NLFK,CKID                                 RENET     435
      ELSE                                                              RENET     436
      NJ=NNEW(NLFJ)                                                     RENET     437
      NJ=NJ*3                                                           RENET     438
      NK=NNEW(NLFK)                                                     RENET     439
      NK=NK*3                                                           RENET     440
      WRITE(MSG(2),3100) INAME(NJ-2),INAME(NJ-1),INAME(NJ)              RENET     441
     *  ,INAME(NK-2),INAME(NK-1),INAME(NK),CKID                         RENET     442
      ENDIF                                                             RENET     443
      WRITE(MSG(1),3000)                                                RENET     444
      WRITE(MSG(3),3300)                                                RENET     445
      CALL PRTMSG(3)                                                    RENET     446
C                                                                       RENET     447
      ENDIF                                                             RENET     448
C                                                                       RENET     449
 1000 CONTINUE                                                          RENET     450
C                                                                       RENET     451
C   ENDIF NPFL.NE.0                                                     RENET     452
C                                                                       RENET     453
      ENDIF                                                             RENET     454
C                                                                       RENET     455
C  DUMP LOAD FLOW ULTC DATA INTO DYNAMIC ULTC DATA ARRAYS               RENET     456
C                                                                       RENET     457
       CALL MOVE(0,JTRULC,JTRULC,ITRF)                                  RENET     458
       IF (NULTC .LE. 0) GOTO 1400                                      RENET     459
       DO 1300 ITC = 1,NULTC                                            RENET     460
C                                                                       RENET     461
       IF(MOULTC(ITC).NE.1)GOTO 1300                                    RENET     462
C                                                                       RENET     463
       JTC = JULTCD(ITC)                                                RENET     464
       NLFP = IDDAT(JTC+1)                                              RENET     465
       NLFS = IDDAT(JTC+2)                                              RENET     466
       JCKID = IDDAT(JTC+3)                                             RENET     467
       CALL UNPACK(NCID,JJJ,JCKID)                                      RENET     468
       IPSC = 0                                                         RENET     469
       LDSTAT=1                                                         RENET     470
       IF (NSC .EQ. 0) GOTO 1200                                        RENET     471
       DB = DDAT(JTC+9)                                                 RENET     472
       STEP1 = DDAT(JTC+15)                                             RENET     473
       AMAX = DDAT(JTC+16)                                              RENET     474
       AMIN = DDAT(JTC+17)                                              RENET     475
       IF ((DB.GT.0.0.OR.DB.LT.0.0).AND.(STEP1.GT.0.0.OR.STEP1.LT.0.0)  RENET     476
     *.AND.(AMAX.GT.0.0.OR.AMAX.LT.0.0)                                 RENET     477
     *.AND.(AMIN.GT.0.0.OR.AMIN.LT.0.0)) GOTO 1200                      RENET     478
C                                                                       RENET     479
C      MATCHING ULTC CONNECTION WITH CONNECTIONS IN LOADFLOW            RENET     480
C                                                                       RENET     481
       DO 1100 ISC=1,NSC                                                RENET     482
        IPSC=IPSC+9                                                     RENET     483
        NPBNI=ISCFRM(IPSC-8)                                            RENET     484
        NPBNJ=ISCTO(IPSC-7)                                             RENET     485
        JCKID=ISCCID(IPSC-6)                                            RENET     486
        CALL UNPACK(ICKT,JJJ,JCKID)                                     RENET     487
        IF (NLFP .EQ. NPBNI .AND. NLFS .EQ. NPBNJ .AND.                 RENET     488
     1      NCID .EQ. ICKT) THEN                                        RENET     489
C                                                                       RENET     490
          RMA = ONRMAX(IPSC-4)                                          RENET     491
          RMI = ONRMIN(IPSC-3)                                          RENET     492
          VMAX = VOLMAX(IPSC-2)                                         RENET     493
          VMIN = VOLMAX(IPSC-1)                                         RENET     494
          STP = STEP(IPSC)                                              RENET     495
C                                                                       RENET     496
          DDAT(JTC+18) = VMAX                                           RENET     497
          DDAT(JTC+19) = VMIN                                           RENET     498
          IF (DB.LE.0.0.AND.DB.GE.0.0) THEN                             RENET     499
            DDAT(JTC+9) = (VMAX-VMIN)/2.0                               RENET     500
          END IF                                                        RENET     501
          IF (STEP1.LE.0.0.AND.STEP1.GE.0.0) THEN                       RENET     502
            DDAT(JTC+15) = STP                                          RENET     503
          END IF                                                        RENET     504
          IF (AMAX.LE.0.0.AND.AMAX.GE.0.0) THEN                         RENET     505
            DDAT(JTC+16) = RMA                                          RENET     506
          END IF                                                        RENET     507
          IF (AMIN.LE.0.0.AND.AMIN.GE.0.0) THEN                         RENET     508
            DDAT(JTC+17) = RMI                                          RENET     509
          END IF                                                        RENET     510
          GOTO 1200                                                     RENET     511
        END IF                                                          RENET     512
 1100  CONTINUE                                                         RENET     513
C                                                                       RENET     514
C      TRANSFORMER NOT FOUND IN THE LOADFLOW                            RENET     515
C                                                                       RENET     516
        IF(KLFO.EQ.0)THEN                                               RENET     517
        WRITE(MSG(1),5200) NLFP,NLFS,NCID                               RENET     518
        ELSE                                                            RENET     519
        NI=NNEW(NLFP)                                                   RENET     520
        NJ=NNEW(NLFS)                                                   RENET     521
        NI3=NI*3                                                        RENET     522
        NJ3=NJ*3                                                        RENET     523
        WRITE(MSG(1),5300) INAME(NI3-2),INAME(NI3-1),INAME(NI3)         RENET     524
     *                     ,INAME(NJ3-2),INAME(NJ3-1),INAME(NJ3),NCID   RENET     525
           ENDIF                                                        RENET     526
        WRITE(MSG(2),5400)                                              RENET     527
        CALL PRTMSG(2)                                                  RENET     528
        LDSTAT=0                                                        RENET     529
 1200  CONTINUE                                                         RENET     530
       NLFP1 = NNEW(NLFP)                                               RENET     531
       NLFS1 = NNEW(NLFS)                                               RENET     532
C                                                                       RENET     533
C      LOCATE THE LINE                                                  RENET     534
C                                                                       RENET     535
       CALL LOLINE (NLFP1,NLFS1,NCID,KNET)                              RENET     536
C                                                                       RENET     537
C      LINE NOT FOUND                                                   RENET     538
C                                                                       RENET     539
       IF (KNET .EQ. 0) THEN                                            RENET     540
         IF (KLFO .EQ. 0) THEN                                          RENET     541
           IEBK=1                                                       RENET     542
           WRITE(MSG(1),5500) NLFP,NLFS,NCID                            RENET     543
         ELSE                                                           RENET     544
           IEBK=1                                                       RENET     545
           NP=NNEW(NLFP)                                                RENET     546
           NP3=NP*3                                                     RENET     547
           NS=NNEW(NLFS)                                                RENET     548
           NS3=NS*3                                                     RENET     549
           WRITE(MSG(1),5600) INAME(NP3-2),INAME(NP3-1),INAME(NP3)      RENET     550
     *                    ,INAME(NS3-2),INAME(NS3-1),INAME(NS3),NCID    RENET     551
         END IF                                                         RENET     552
         CALL PRTMSG(1)                                                 RENET     553
         LDSTAT=0                                                       RENET     554
       END IF                                                           RENET     555
       IF (KNET .NE. 0) THEN                                            RENET     556
         KNET = IABS(KNET)                                              RENET     557
         JNL5 = KNET*5                                                  RENET     558
         DDAT(JTC+20) = GA(JNL5-2)                                      RENET     559
         DDAT(JTC+21) = BA(JNL5-1)                                      RENET     560
         JTRF = LTRANC(KNET)                                            RENET     561
C                                                                       RENET     562
C        LINE IS NOT A TRANSFORMER LINE                                 RENET     563
C                                                                       RENET     564
         IF (JTRF .EQ. 0) THEN                                          RENET     565
           IF (KLFO .EQ. 0) THEN                                        RENET     566
             WRITE(MSG(1),5700) NLFP,NLFS,NCID                          RENET     567
           ELSE                                                         RENET     568
           NP=NNEW(NLFP)                                                RENET     569
           NP3=NP*3                                                     RENET     570
           NS=NNEW(NLFS)                                                RENET     571
           NS3=NS*3                                                     RENET     572
           WRITE(MSG(1),5800) INAME(NP3-2),INAME(NP3-1),INAME(NP3)      RENET     573
     *                    ,INAME(NS3-2),INAME(NS3-1),INAME(NS3),NCID    RENET     574
           END IF                                                       RENET     575
             IEBK=1                                                     RENET     576
           WRITE(MSG(2),5900)                                           RENET     577
           CALL PRTMSG(2)                                               RENET     578
           LDSTAT=0                                                     RENET     579
           MOULTC(ITC)=LDSTAT                                           RENET     580
           GOTO 1300                                                    RENET     581
         END IF                                                         RENET     582
C                                                                       RENET     583
         JTRULC(JTRF) = ITC                                             RENET     584
         JTRF2 = JTRF*2                                                 RENET     585
         ONRNOM = RATIO(JTRF2-1)                                        RENET     586
         ONRNOM = ABS(ONRNOM)                                           RENET     587
         DDAT(JTC+22) = ONRNOM                                          RENET     588
       END IF                                                           RENET     589
       MOULTC(ITC)=LDSTAT                                               RENET     590
 1300  CONTINUE                                                         RENET     591
 1400  CONTINUE                                                         RENET     592
C                                                                       RENET     593
C    STORE THE ORIGINAL NETWORK FROM LOAD FLOW                          RENET     594
C    AND LINE STATUS TO FILE IU3                                        RENET     595
C                                                                       RENET     596
      REWIND IU3                                                        RENET     597
      WRITE(IU3) NL,ITRF,NLFBUS                                         RENET     598
      CALL FLWR(IU3,0,NL*5,GBFT)                                        RENET     599
      CALL IFWR(IU3,0,NXTR,ITRAN)                                       RENET     600
      IF(ITRF.NE.0)CALL FLWR(IU3,0,ITRF*2,TRANS)                        RENET     601
      CALL IHWR(IU3,0,NL,LTRANC)                                        RENET     602
C                                                                       RENET     603
C       STORE   : PI-LINE DATA                                          RENET     604
C                                                                       RENET     605
      IF(NSEL .NE.0)THEN                                                RENET     606
      WRITE(IU3)NSEL                                                    RENET     607
      CALL FLWR(IU3,0,18*NSEL,EQPI)                                     RENET     608
      CALL FLWR(IU3,0,24*NSEL,PSELIN)                                   RENET     609
      CALL IHWR(IU3,0,6*NSEL,LCONE)                                     RENET     610
      CALL IHWR(IU3,0,12*NSEL,NEXTSL)                                   RENET     611
      ENDIF                                                             RENET     612
C                                                                       RENET     613
                                                                        RENET     614
C                                                                       RENET     615
C       STORE ORIGINAL LINE MONITORING ITEMS                            RENET     616
C                                                                       RENET     617
      WRITE(IU3)LNET                                                    RENET     618
      CALL IFWR(IU3,0,LNET*2,LINEPO)                                    RENET     619
      CALL IFWR(IU3,0,LNET,IARCCT)                                      RENET     620
C                                                                       RENET     621
      CALL IFWR(IU3,0,NL,LISMON)                                        RENET     622
C                                                                       RENET     623
C                                                                       RENET     624
      IF (IEBK .GT. 0)THEN                                              RENET     625
      MSG(1)='RENET: ULTC DYNAMIC DATA ERROR'                           RENET     626
      CALL ASTOP(MSG(1),30)                                             RENET     627
      ENDIF                                                             RENET     628
C                                                                       RENET     629
      RETURN                                                            RENET     630
C                                                                       RENET     631
 3000 FORMAT(' *** ERROR THE FOLLOWING MONITORED LINE DOES NOT EXIST',  RENET     632
     1' IN THE SYSTEM:')                                                RENET     633
 3100 FORMAT('     FROM BUS ',3A4,' TO BUS ',3A4,'   CIRCUIT ID ',A2)   RENET     634
 3200 FORMAT('     FROM BUS ',I5, ' TO BUS ',I5, '   CIRCUIT ID ',A2)   RENET     635
 3300 FORMAT('     CHECK YOUR OUTPUT SPECIFICATION DATA.')              RENET     636
 3400 FORMAT (1X,'LINE IN RENET PRIOR TO RENUMBERING')                  RENET     637
 3500 FORMAT(2(1X,I6),A2,3G12.4)                                        RENET     638
 3600 FORMAT(1X,'POLARITY',6I5,2G12.4)                                  RENET     639
 3900 FORMAT(5X,'FROM BUS ',I5,'  TO BUS ',I5,'  CID ',A2               RENET     640
     *,'  CORRECTION TABLE ',I2)                                        RENET     641
 4000 FORMAT(5X,'FROM BUS ',3A4,'  TO BUS ',3A4,'  CID ',A2             RENET     642
     *,'  CORRECTION TABLE ',I2)                                        RENET     643
 4100 FORMAT(1X,'*** WARNING THE ANGLE OF THE FOLLOWING PHASE SHIFTER') RENET     644
 4200 FORMAT(1X,'    VIOLATES THE BOUNDS OF CORRECTION TABLE.')         RENET     645
 4300 FORMAT(5X,'ANGLE = ',F10.5                                        RENET     646
     *,' THE END POINT IS USED FOR IMPEDANCE ADJUSTMENT')               RENET     647
 4400 FORMAT(5X,'RATIO = ',F10.5                                        RENET     648
     *,' THE END POINT IS USED FOR IMPEDANCE ADJUSTMENT')               RENET     649
 4500 FORMAT(5X,'CORRECTION TABLE:')                                    RENET     650
 4600 FORMAT(5X,6F8.3)                                                  RENET     651
 4700 FORMAT(1X,'*** WARNING THE RATIO OF THE FOLLOWING TAP CHANGER')   RENET     652
 4900 FORMAT(1X,'DB-RENET:ISC,IPSC,NPBNI,NPBNJ,ICKT,NTB,NPBNOI,NPBNO    RENET     653
     +J ',/,10X,4I6,3X,A2,I6,3X,2I6)                                    RENET     654
 5000 FORMAT(1X,'DB-RENET:JNL5,JTRF2,VPHS,COEF,GA,BA ',/,               RENET     655
     +10X,I6,I6,2X,4G13.5,2X,L2)                                        RENET     656
 5100 FORMAT(1X,'DB-RENET:IPSC,NTB,VPHS ',I5,I5,G12.5)                  RENET     657
 5200 FORMAT(1X,'*** ERROR ULTC ',I5,1X,I5,1X,A2,                       RENET     658
     1          ' IS NOT IN LOAD FLOW')                                 RENET     659
 5300 FORMAT(1X,'*** ERROR ULTC ',3A4,2X,3A4,1X,A2,                     RENET     660
     1          ' IS NOT IN LOAD FLOW')                                 RENET     661
 5400 FORMAT(5X,'TRANSFORMER ADJUSTMENT DATA')                          RENET     662
 5500 FORMAT(1X,'*** ERROR ULTC ',I5,1X,I5,1X,A2,                       RENET     663
     1          ' IS NOT IN LOAD FLOW LINE DATA')                       RENET     664
 5600 FORMAT(1X,'*** ERROR ULTC ',3A4,1X,3A4,1X,A2,                     RENET     665
     1          ' IS NOT IN LOAD FLOW LINE DATA')                       RENET     666
 5700 FORMAT(1X,'*** ERROR ULTC ',I5,1X,I5,1X,A2,                       RENET     667
     1          ' IS NOT AN OFF-NOMINAL')                               RENET     668
 5800 FORMAT(1X,'*** ERROR ULTC ',3A4,1X,3A4,1X,A2,                     RENET     669
     1          ' IS NOT AN OFF-NOMINAL')                               RENET     670
 5900 FORMAT(5X,'TRANSFORMER BRANCH')                                   RENET     671
      END                                                               RENET     672
