CFPRIME REDUCE                                                          REDUCE      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 REDUCE                                                 REDUCE      3
CD                                                                      REDUCE      4
CD    THIS ROUTINE SETS UP EQUIVALENT CURRENT ARRAY FOR THE LOAD BUS    REDUCE      5
CD    REDUCTION.                                                        REDUCE      6
CD                                                                      REDUCE      7
      INCLUDE 'PARX.INS'                                                REDUCE      8
      INCLUDE 'CNPT.INS'                                                REDUCE      9
      INCLUDE 'CNFLAG.INS'                                              REDUCE     10
      INCLUDE 'CNIPTR.INS'                                              REDUCE     11
      INCLUDE 'CNB0.INS'                                                REDUCE     12
      INCLUDE 'CNB6.INS'                                                REDUCE     13
      INCLUDE 'CNMDAT.INS'                                              REDUCE     14
      INCLUDE 'CNB9.INS'                                                REDUCE     15
C      INCLUDE 'CNMON.INS/LIST'                                         REDUCE     16
      INCLUDE 'CNPARX.INS'                                              REDUCE     17
      INCLUDE 'CNUNIT.INS'                                              REDUCE     18
      INCLUDE 'CNSPC1.INS'                                              REDUCE     19
      INCLUDE 'CNSPVI.INS'                                              REDUCE     20
      INCLUDE 'CNSPC0.INS'                                              REDUCE     21
      INCLUDE 'CNVOLT.INS'                                              REDUCE     22
      INCLUDE 'CNNNEW.INS'                                              REDUCE     23
      INCLUDE 'CNMSTA.INS'                                              REDUCE     24
      INCLUDE 'CNCUR.INS'                                               REDUCE     25
      INCLUDE 'CNMASK.INS'                                              REDUCE     26
      INCLUDE 'CNRED.INS'                                               REDUCE     27
C                                                                       REDUCE     28
*IF -MI2                                                                REDUCE     29
      INTEGER*2 INKCUR                                                  REDUCE     30
*ENDIF                                                                  REDUCE     31
      COMPLEX CMPLX,CKCUR(NB),CKMVA(NB),OVOLT,SPOWER                    REDUCE     32
C                                                                       REDUCE     33
      COMMON /SCRAT4/OVOLT(NB),NROWS(NB/4)                              REDUCE     34
     *  ,NROWSI,INKCUR(NDEV)                                            REDUCE     35
C                                                                       REDUCE     36
      EQUIVALENCE (CURR(1),CKCUR(1),CKMVA(1))                           REDUCE     37
C                                                                       REDUCE     38
C ========================================================              REDUCE     39
C                                                                       REDUCE     40
      LDEB=.FALSE.                                                      REDUCE     41
CD                                                                      REDUCE     42
CD    STEP 1. CALL SETSOL TO DETERMINE WHERE IS THE POINT TO STOP       REDUCE     43
CD                                                                      REDUCE     44
      IV=1                                                              REDUCE     45
      CALL SETSOL(NLAST,NCUR,ICUR,IV)                                   REDUCE     46
C                                                                       REDUCE     47
       NSTOP=NOROI(1)-1                                                 REDUCE     48
C                                                                       REDUCE     49
        DO 100 I=1,LASTCU                                               REDUCE     50
         INKCUR(I)=I                                                    REDUCE     51
 100    CONTINUE                                                        REDUCE     52
         JC=LASTCU                                                      REDUCE     53
C                                                                       REDUCE     54
        IV=1                                                            REDUCE     55
        CALL SETSOL(NLAST,JC,INKCUR,IV)                                 REDUCE     56
         DO 110 II=1,NOROWI                                             REDUCE     57
          IF(NOROI(II).GT.NSTOP)GOTO 120                                REDUCE     58
          NSTOP1=II                                                     REDUCE     59
 110     CONTINUE                                                       REDUCE     60
 120     NSTRT1=NSTOP1+1                                                REDUCE     61
C                                                                       REDUCE     62
         NNROW=NOROWI-NSTOP1                                            REDUCE     63
         DO 130 I=1,NNROW                                               REDUCE     64
         NROWS(I)=NOROI(NSTOP1+I)                                       REDUCE     65
 130     CONTINUE                                                       REDUCE     66
CD                                                                      REDUCE     67
CD    STEP 2. LOAD BUS SIMPLIFICATION                                   REDUCE     68
CD                                                                      REDUCE     69
      IF(LOBUS.EQ.1)THEN                                                REDUCE     70
C                                                                       REDUCE     71
CD            FOR CONSTANT CURRENT LOAD BUSES, BUILD THE CURRENT        REDUCE     72
CD            VECTOR USING THE CKCUR ARRAY                              REDUCE     73
CD                                                                      REDUCE     74
       IF(NKCUR.NE.0)THEN                                               REDUCE     75
        DO 200 I=1,NLAST                                                REDUCE     76
         CKCUR(I)=CMPLX(0.0,0.0)                                        REDUCE     77
  200   CONTINUE                                                        REDUCE     78
C                                                                       REDUCE     79
         ISHIFT=0                                                       REDUCE     80
C                                                                       REDUCE     81
         DO 210 I=1,NLOD                                                REDUCE     82
         NCOMP=NLCOMP(1,I)                                              REDUCE     83
         IF(KNLBS(I).EQ.0)THEN                                          REDUCE     84
           ISHIFT=ISHIFT+NCOMP                                          REDUCE     85
           GOTO 210                                                     REDUCE     86
         ENDIF                                                          REDUCE     87
C                                                                       REDUCE     88
         K=NLDOLD(I)                                                    REDUCE     89
C                                                                       REDUCE     90
         DO 220 ICOMP=1,NCOMP                                           REDUCE     91
          ISHIFT=ISHIFT+1                                               REDUCE     92
          NTYPE=NLTYPE(ISHIFT)                                          REDUCE     93
C                                                                       REDUCE     94
          IF(NTYPE.NE.1)GOTO 220                                        REDUCE     95
C                                                                       REDUCE     96
C        FOR CONSTANT CURRENT LOAD REPRESENTATION                       REDUCE     97
C                                                                       REDUCE     98
          JNL=JDNLL(ISHIFT)                                             REDUCE     99
          VREAL=REAL(OVOLT(K))                                          REDUCE    100
          VIMAG=AIMAG(OVOLT(K))                                         REDUCE    101
          VMG=CABS(OVOLT(K))                                            REDUCE    102
          CX=(DDAT(JNL+2)*VREAL+DDAT(JNL+3)*VIMAG)/VMG                  REDUCE    103
          CY=(DDAT(JNL+2)*VIMAG-DDAT(JNL+3)*VREAL)/VMG                  REDUCE    104
          MSKK=MSK(K)                                                   REDUCE    105
          CKCUR(MSKK)=-CMPLX(CX,CY)                                     REDUCE    106
 220     CONTINUE                                                       REDUCE    107
 210    CONTINUE                                                        REDUCE    108
C                                                                       REDUCE    109
        CALL AUPIFN(NLAST,CKCUR,NSTOP1)                                 REDUCE    110
CD                                                                      REDUCE    111
CD    STEP 3. STORE THE EQUIVALENT CONSTANT CURRENT LOAD INTO THE DDAT  REDUCE    112
CD            ARRAY                                                     REDUCE    113
CD                                                                      REDUCE    114
         IKCUR=0                                                        REDUCE    115
         DO 230 K=NSTRT1,NOROWI                                         REDUCE    116
          KK=NOROI(K)                                                   REDUCE    117
          I=IBUSO(KK)                                                   REDUCE    118
          CMG=CABS(CKCUR(I))                                            REDUCE    119
          IF( CMG.LE.0.0.AND.CMG.GE.0.0 )GOTO 230                       REDUCE    120
          IKCUR=IKCUR+1                                                 REDUCE    121
          IX=IKCUR*3                                                    REDUCE    122
          ICBUS(IX-2)=I                                                 REDUCE    123
          VMG=CABS(OVOLT(I))                                            REDUCE    124
          SPOWER=OVOLT(I)*CONJG(CKCUR(I))                               REDUCE    125
          CBUS(IX-1)=REAL(SPOWER)/VMG                                   REDUCE    126
          CBUS(IX)=AIMAG(SPOWER)/VMG                                    REDUCE    127
C                                                                       REDUCE    128
C         WRITE(IUD6,1236)I,CBUS(IX-1),CBUS(IX)                         REDUCE    129
C 1236    FORMAT(' CBUS(2:4) = ',I5,2F12.5)                             REDUCE    130
C                                                                       REDUCE    131
  230   CONTINUE                                                        REDUCE    132
C                                                                       REDUCE    133
       ENDIF                                                            REDUCE    134
C                                                                       REDUCE    135
C    ENDIF FOR NKCUR .NE. 0                                             REDUCE    136
C=============================================================          REDUCE    137
C                                                                       REDUCE    138
C   FOR CONSTANT MVA LOAD BUSES                                         REDUCE    139
C    FORM THE CURRENT VECTOR USING THE DDAT ARRAY                       REDUCE    140
C                                                                       REDUCE    141
       IF( NKMVA.NE.0)THEN                                              REDUCE    142
        DO 300 I=1,NLAST                                                REDUCE    143
         CKMVA(I)=CMPLX(0.0,0.0)                                        REDUCE    144
  300   CONTINUE                                                        REDUCE    145
C                                                                       REDUCE    146
C         CONSTANT MVA LOAD REPRESENTATION                              REDUCE    147
C                                                                       REDUCE    148
         ISHIFT=0                                                       REDUCE    149
C                                                                       REDUCE    150
         DO 310 I=1,NLOD                                                REDUCE    151
         NCOMP=NLCOMP(1,I)                                              REDUCE    152
         IF(KNLBS(I).EQ.0)THEN                                          REDUCE    153
           ISHIFT=ISHIFT+NCOMP                                          REDUCE    154
           GOTO 310                                                     REDUCE    155
         ENDIF                                                          REDUCE    156
C                                                                       REDUCE    157
         K=NLDOLD(I)                                                    REDUCE    158
C                                                                       REDUCE    159
         DO 320 ICOMP=1,NCOMP                                           REDUCE    160
          ISHIFT=ISHIFT+1                                               REDUCE    161
          NTYPE=NLTYPE(ISHIFT)                                          REDUCE    162
C                                                                       REDUCE    163
          IF(NTYPE.NE.2)GOTO 320                                        REDUCE    164
C                                                                       REDUCE    165
          JNL=JDNLL(ISHIFT)                                             REDUCE    166
          VREAL=REAL(OVOLT(K))                                          REDUCE    167
          VIMAG=AIMAG(OVOLT(K))                                         REDUCE    168
          VMG=CABS(OVOLT(K))                                            REDUCE    169
          VMG=VMG*VMG                                                   REDUCE    170
C                                                                       REDUCE    171
          CRMVA=(DDAT(JNL+2)*VREAL+DDAT(JNL+3)*VIMAG)/VMG               REDUCE    172
          CIMVA=(DDAT(JNL+2)*VIMAG-DDAT(JNL+3)*VREAL)/VMG               REDUCE    173
          MSKK=MSK(K)                                                   REDUCE    174
          CKMVA(MSKK)=-CMPLX(CRMVA,CIMVA)                               REDUCE    175
 320     CONTINUE                                                       REDUCE    176
 310    CONTINUE                                                        REDUCE    177
C                                                                       REDUCE    178
        CALL AUPIFN(NLAST,CKMVA,NSTOP1)                                 REDUCE    179
CD                                                                      REDUCE    180
CD    STEP 4. STORE THE EQUIVALENT CONSTANT MVA LOAD INTO THE DDAT      REDUCE    181
CD            ARRAY                                                     REDUCE    182
CD                                                                      REDUCE    183
         IKMVA=0                                                        REDUCE    184
         DO 330 K=NSTRT1,NOROWI                                         REDUCE    185
          KK=NOROI(K)                                                   REDUCE    186
          I=IBUSO(KK)                                                   REDUCE    187
          CMG=CABS(CKMVA(I))                                            REDUCE    188
          IF( CMG.LE.0.0.AND.CMG.GE.0.0 )GOTO 330                       REDUCE    189
          IKMVA=IKMVA+1                                                 REDUCE    190
          IX=IKMVA*3                                                    REDUCE    191
          IPBUS(IX-2)=I                                                 REDUCE    192
          SPOWER=OVOLT(I)*CONJG(CKMVA(I))                               REDUCE    193
          PBUS(IX-1)=REAL(SPOWER)                                       REDUCE    194
          PBUS(IX)=AIMAG(SPOWER)                                        REDUCE    195
C                                                                       REDUCE    196
C         WRITE(IUD6,1235)IPBUS(IX-2),PBUS(IX-1),PBUS(IX)               REDUCE    197
C 1235    FORMAT(' PBUS(2:4) = ',I5,2F12.5)                             REDUCE    198
C                                                                       REDUCE    199
  330   CONTINUE                                                        REDUCE    200
C                                                                       REDUCE    201
       ENDIF                                                            REDUCE    202
C    ENDIF FOR NKMVA .NE.0                                              REDUCE    203
C  =============                                                        REDUCE    204
C                                                                       REDUCE    205
      ENDIF                                                             REDUCE    206
C  ENDIF FOR THE LOAD BUS SIMPLIFICATION                                REDUCE    207
CD                                                                      REDUCE    208
CD    STEP 5. REFINE THE NOROWI, NOROI FOR BACKWARD SUBSTITUTION        REDUCE    209
CD                                                                      REDUCE    210
        DO 400 I=1,NOROWI                                               REDUCE    211
          NOROI(I)=0                                                    REDUCE    212
          NOROV(I)=0                                                    REDUCE    213
 400    CONTINUE                                                        REDUCE    214
         DO 410 I=1,NNROW                                               REDUCE    215
          NOROI(I)=NROWS(I)                                             REDUCE    216
          NOROV(I)=NROWS(I)                                             REDUCE    217
C          WRITE(IUD6,1455)I,NOROI(I)                                   REDUCE    218
 410     CONTINUE                                                       REDUCE    219
         NOROWI=NNROW                                                   REDUCE    220
         NOROWV=NNROW                                                   REDUCE    221
C                                                                       REDUCE    222
C 1455    FORMAT(' NEW NOROWI,NOROI(*) ',2I10)                          REDUCE    223
      RETURN                                                            REDUCE    224
      END                                                               REDUCE    225
