CFPRIME PIEQIV                                                          PIEQIV      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 PIEQIV (BRNCH,BASE1,BASE2,Y,ERROR)                   PIEQIV      3
CD                                                                      PIEQIV      4
CD    THIS SUBROUTINE COMPUTES THE 2-PORT ADMITTANCE MATRIX Y FOR       PIEQIV      5
CD    BRNCH(18). IT IS USED IN THE BPA LOAD FLOW.                       PIEQIV      6
CD                                                                      PIEQIV      7
      INCLUDE 'CNLSTA.INS'                                              PIEQIV      8
        REAL BRNCH(18), RE2IN                                           PIEQIV      9
        COMPLEX Y(2,2),CX                                               PIEQIV     10
        INTEGER * 4 ERROR, IN2RE                                        PIEQIV     11
        EQUIVALENCE (RE2IN,IN2RE)                                       PIEQIV     12
        CHARACTER*80 MSG                                                PIEQIV     13
C                                                                       PIEQIV     14
        ERROR = 0                                                       PIEQIV     15
        RE2IN = BRNCH(1)                                                PIEQIV     16
        LTYPE = IN2RE                                                   PIEQIV     17
        GO TO (90,240,100,240,100,100,240,100) LTYPE                    PIEQIV     18
C                                                                       PIEQIV     19
C       "PI-EQUIVALENT" BRANCH                                          PIEQIV     20
C                                                                       PIEQIV     21
   90   Y(1,1) = CMPLX(BRNCH(4),BRNCH(5))                               PIEQIV     22
        Y(1,2) = CMPLX(BRNCH(6),BRNCH(7))                               PIEQIV     23
        Y(2,1) = CMPLX(BRNCH(8),BRNCH(9))                               PIEQIV     24
        Y(2,2) = CMPLX(BRNCH(10),BRNCH(11))                             PIEQIV     25
        GO TO 260                                                       PIEQIV     26
C                                                                       PIEQIV     27
C       COMPUTE TRANSFER IMPEDANCE                                      PIEQIV     28
C                                                                       PIEQIV     29
  100   R=BRNCH(5)                                                      PIEQIV     30
        X=BRNCH(6)                                                      PIEQIV     31
        Z = R ** 2 + X ** 2                                             PIEQIV     32
        GO TO (240,240,130,240,150,180,240,140) LTYPE                   PIEQIV     33
C                                                                       PIEQIV     34
C       " L " BRANCH                                                    PIEQIV     35
C                                                                       PIEQIV     36
  130   Y(1,2)=-CMPLX (R/Z, -X/Z)                                       PIEQIV     37
        Y(2,1) = Y(1,2)                                                 PIEQIV     38
        Y(1,1)=CMPLX (BRNCH(7),BRNCH(8))-Y(1,2)                         PIEQIV     39
        Y(2,2)=Y(1,1)                                                   PIEQIV     40
        GO TO 260                                                       PIEQIV     41
C                                                                       PIEQIV     42
C       " E " BRANCH                                                    PIEQIV     43
C                                                                       PIEQIV     44
  140   Y(1,2)= -CMPLX (R/Z, -X/Z)                                      PIEQIV     45
        Y(2,1)=Y(1,2)                                                   PIEQIV     46
        Y(1,1)=CMPLX(BRNCH(7),BRNCH(8))-Y(1,2)                          PIEQIV     47
        Y(2,2)=CMPLX(BRNCH(9),BRNCH(10))-Y(2,1)                         PIEQIV     48
        GO TO 260                                                       PIEQIV     49
C                                                                       PIEQIV     50
C       " T " BRANCH                                                    PIEQIV     51
C                                                                       PIEQIV     52
  150   TK=BRNCH(9)/BASE1                                               PIEQIV     53
        TM=BRNCH(10)/BASE2                                              PIEQIV     54
        TKM=1.0/(TK*TM)                                                 PIEQIV     55
        Y(1,1)=CMPLX(0.5*TKM*BRNCH(7),-0.5*TKM*ABS(BRNCH(8)))           PIEQIV     56
        Y(2,2)=Y(1,1)                                                   PIEQIV     57
        Y(1,2)=-CMPLX(R/(Z*TK*TM),-X/(Z*TK*TM))                         PIEQIV     58
        Y(2,1)=Y(1,2)                                                   PIEQIV     59
        Y(1,1)=Y(1,1)+CMPLX (R/(Z*TK*TK),-X/(Z*TK*TK))                  PIEQIV     60
        Y(2,2)=Y(2,2)+CMPLX (R/(Z*TM*TM), -X/(Z*TM*TM))                 PIEQIV     61
        GO TO 260                                                       PIEQIV     62
C                                                                       PIEQIV     63
C       " TP " BRANCH                                                   PIEQIV     64
C                                                                       PIEQIV     65
  180   TK=BRNCH(9)                                                     PIEQIV     66
        RE2IN = BRNCH(7)                                                PIEQIV     67
        LIST = IN2RE                                                    PIEQIV     68
        IF (LIST.EQ.0) TM=BRNCH(10)/BASE2                               PIEQIV     69
        IF (LIST.EQ.1) TM=BRNCH(10)/BASE1                               PIEQIV     70
        IF(TM.EQ.0.0) TM=1.0                                            PIEQIV     71
        ANGLE=0.0174532925*TK                                           PIEQIV     72
        Y(1,2)=CMPLX(0.5*BRNCH(7),-0.5*ABS(BRNCH(8)))                   PIEQIV     73
        Y(1,1)=Y(1,2)+CMPLX(R/Z,-X/Z)                                   PIEQIV     74
        Y(2,2)=Y(1,2)+CMPLX(R/Z,-X/Z)/CMPLX(TM**2,0.0)                  PIEQIV     75
        Y(1,2)=-CMPLX(COS(ANGLE),SIN(ANGLE))*CMPLX(R/(Z*TM),-X/(Z*TM))  PIEQIV     76
        Y(2,1)=-CMPLX(COS(ANGLE),-SIN(ANGLE))*CMPLX(R/(Z*TM),-X/(Z*TM)) PIEQIV     77
        IF (LIST.EQ.1) THEN                                             PIEQIV     78
           CX=Y(2,2)                                                    PIEQIV     79
           Y(2,2)=Y(1,1)                                                PIEQIV     80
           Y(1,1)=CX                                                    PIEQIV     81
        ENDIF                                                           PIEQIV     82
        GO TO 260                                                       PIEQIV     83
C                                                                       PIEQIV     84
C       ERROR-ILLEGAL BRANCH TYPE CALLING "PIEQIV"                      PIEQIV     85
C                                                                       PIEQIV     86
  240   WRITE (LOUT,250) LTYPE                                          PIEQIV     87
  250   FORMAT('0 PIEQIV CALLED WITH AN ILLEGAL BRANCH TYPE ',I2)       PIEQIV     88
        MSG='PIEQIV - FATAL ERROR'                                      PIEQIV     89
        CALL ASTOP(MSG,20)                                              PIEQIV     90
  260   RETURN                                                          PIEQIV     91
        END                                                             PIEQIV     92
        SUBROUTINE GETPUT (X,Y,Z)                                       PIEQIV     93
CD                                                                      PIEQIV     94
CD    SEE COMMENTS IN ENTRY POINTS.                                     PIEQIV     95
CD                                                                      PIEQIV     96
        CHARACTER B*(*),FORMAT*4                                        PIEQIV     97
C                                                                       PIEQIV     98
        ENTRY PUTCHR(N,B,IA)                                            PIEQIV     99
CD                                                                      PIEQIV    100
CD    TO MOVE CHARACTER DATA INTO INTEGER*4 STORAGE. CURRENTLY, IT USES PIEQIV    101
CD    READ/WRITE TO SIMULATE ENCODE. NOTE THAT VARIABLES ARE SWITCHED   PIEQIV    102
CD    FROM ENCODE ORDER.                                                PIEQIV    103
CD                                                                      PIEQIV    104
CD    B   IS THE CHARACTER DATA PASSED (NOT MORE THAT A4 LONG)          PIEQIV    105
CD    IA  IS THE INTEGER DATA RETURNED                                  PIEQIV    106
CD    N   IS THE NUMBER OF CHARACTERS TO BE ENCODED                     PIEQIV    107
CD                                                                      PIEQIV    108
                                                                        PIEQIV    109
C          ENCODE(N,10,IA) B                                            PIEQIV    110
C 10       FORMAT(A<N>)                                                 PIEQIV    111
                                                                        PIEQIV    112
           WRITE (FORMAT,2) N                                           PIEQIV    113
   2       FORMAT('(A',I1,')')                                          PIEQIV    114
           READ (B,FORMAT) IA                                           PIEQIV    115
                                                                        PIEQIV    116
        RETURN                                                          PIEQIV    117
                                                                        PIEQIV    118
        ENTRY GETCHR(N,B,IA)                                            PIEQIV    119
CD                                                                      PIEQIV    120
CD    TO MOVE REAL DATA INTO A CHARACTER VARIABLE. CURRENTLY, IT USES   PIEQIV    121
CD    WRITE TO SIMULATE DECODE. NOTE THAT VARIABLES ARE SWITCHED FROM   PIEQIV    122
CD    DECODE ORDER.                                                     PIEQIV    123
CD                                                                      PIEQIV    124
CD    IA  IS THE INTEGER*4 DATA PASSED                                  PIEQIV    125
CD    B   IS THE CHARACTER DATA RETURNED (NOT MORE THAT A4 LONG)        PIEQIV    126
CD    N   IS THE NUMBER OF CHARACTERS TO BE DECODED                     PIEQIV    127
CD                                                                      PIEQIV    128
C                                                                       PIEQIV    129
C          DECODE(N,10,IA) B                                            PIEQIV    130
C 10       FORMAT(A<N>)                                                 PIEQIV    131
                                                                        PIEQIV    132
           WRITE (FORMAT,2) N                                           PIEQIV    133
           WRITE (B,FORMAT) IA                                          PIEQIV    134
        RETURN                                                          PIEQIV    135
        END                                                             PIEQIV    136
