CFPRIME REDLP                                                           REDLP       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
C                                                                       REDLP       3
      SUBROUTINE  REDLP                                                 REDLP       4
CD -------------------------------------------------------------------  REDLP       5
CD                                                                      REDLP       6
CD              *****     REDLP   ROUTINE   *****                       REDLP       7
CD                                                                      REDLP       8
CD -------------------------------------------------------------------  REDLP       9
CD                                                                      REDLP      10
CD       PURPOSE:  Removes all blocks that are no longer needed to      REDLP      11
CD                 identify the loops in the UDC system.  Once a        REDLP      12
CD                 loop is identified the loop is removed from the      REDLP      13
CD                 system.                                              REDLP      14
CD                                                                      REDLP      15
CD                                                                      REDLP      16
CD       DEFINITION OF LOCAL VARIABLES:                                 REDLP      17
CD                 JEND1   -  first block of loop.                      REDLP      18
CD                 JEND2   -  second block of loop.                     REDLP      19
CD                 FOUND   -  indicates if a block must be removed.     REDLP      20
CD                 I       - 'do' loop index.                           REDLP      21
CD                 K       - 'do' loop index.                           REDLP      22
CD                 LAST    -  previous pointer.                         REDLP      23
CD                 NEXT    -  current pointer.                          REDLP      24
CD                 JOLD    -  second block of connection.               REDLP      25
CD                 JOLDPT  -  pointer to second block.                  REDLP      26
CD                 LSTOP   -  indicates that all possible blocks that   REDLP      27
CD                           can be removed have been.                  REDLP      28
CD                                                                      REDLP      29
CD -------------------------------------------------------------------  REDLP      30
      INCLUDE 'PARX.INS'                                                REDLP      31
      INCLUDE 'UDCA.INS'                                                REDLP      32
      INCLUDE 'UDCB.INS'                                                REDLP      33
      INCLUDE 'UDCE.INS'                                                REDLP      34
      INCLUDE 'UDCH.INS'                                                REDLP      35
C                                                                       REDLP      36
      LOGICAL       FOUND, LSTOP                                        REDLP      37
C                                                                       REDLP      38
C---------------------------------------------------------------------  REDLP      39
C     Remove the back loop if the loop is defined.                      REDLP      40
C                                                                       REDLP      41
      DO 140 K = 1, LPMAX                                               REDLP      42
C                                                                       REDLP      43
C        Locate the start and end block of the loop.                    REDLP      44
C                                                                       REDLP      45
         NEXT = LPTOP(K)                                                REDLP      46
         JEND1 = LPNUM(NEXT)                                            REDLP      47
         JEND2 = JEND1                                                  REDLP      48
 20      IF(NEXT.NE.0)THEN                                              REDLP      49
            JEND2 = LPNUM(NEXT)                                         REDLP      50
            NEXT = LPNEXT(NEXT)                                         REDLP      51
            GOTO 20                                                     REDLP      52
         ENDIF                                                          REDLP      53
C                                                                       REDLP      54
C        Remove JEND2 as an input block of JEND1.                       REDLP      55
C                                                                       REDLP      56
         NEXT = INTOP(JEND1)                                            REDLP      57
         LAST = NEXT                                                    REDLP      58
60       IF(NEXT.EQ.0) GOTO 80                                          REDLP      59
            IF(INNUM(NEXT).EQ.JEND2)THEN                                REDLP      60
               IF(NEXT.EQ.INTOP(JEND1))THEN                             REDLP      61
                  INTOP(JEND1) = IPOINT(NEXT)                           REDLP      62
               ELSE                                                     REDLP      63
                  IPOINT(LAST) = IPOINT(NEXT)                           REDLP      64
               END IF                                                   REDLP      65
               IPOINT(NEXT) = IFREE                                     REDLP      66
               IFREE = NEXT                                             REDLP      67
               NEXT = 0                                                 REDLP      68
            ELSE                                                        REDLP      69
               LAST = NEXT                                              REDLP      70
               NEXT = IPOINT(NEXT)                                      REDLP      71
            END IF                                                      REDLP      72
            GOTO 60                                                     REDLP      73
80       CONTINUE                                                       REDLP      74
C                                                                       REDLP      75
C        Remove JEND1 as an output block of JEND2.                      REDLP      76
C                                                                       REDLP      77
         NEXT = IOUTOP(JEND2)                                           REDLP      78
         LAST = NEXT                                                    REDLP      79
100      IF(NEXT.EQ.0) GOTO 120                                         REDLP      80
            IF(IOUTNU(NEXT).EQ.JEND1)THEN                               REDLP      81
               IF(NEXT.EQ.IOUTOP(JEND2))THEN                            REDLP      82
                  IOUTOP(JEND2) = JOPOIN(NEXT)                          REDLP      83
               ELSE                                                     REDLP      84
                  JOPOIN(LAST) = JOPOIN(NEXT)                           REDLP      85
               END IF                                                   REDLP      86
               JOPOIN(NEXT) = IFREE                                     REDLP      87
               IFREE = NEXT                                             REDLP      88
               NEXT = 0                                                 REDLP      89
            ELSE                                                        REDLP      90
               LAST = NEXT                                              REDLP      91
               NEXT = JOPOIN(NEXT)                                      REDLP      92
            END IF                                                      REDLP      93
            GOTO 100                                                    REDLP      94
120      CONTINUE                                                       REDLP      95
140   CONTINUE                                                          REDLP      96
C                                                                       REDLP      97
C                                                                       REDLP      98
C     Remove all blocks which have been ordered, and all of its         REDLP      99
C     output blocks have been ordered.                                  REDLP     100
C                                                                       REDLP     101
      DO 360 I = 1, IUDC                                                REDLP     102
C                                                                       REDLP     103
C        Check if the block is ordered.                                 REDLP     104
C                                                                       REDLP     105
         IF(IUDINV(I) .NE. 0)THEN                                       REDLP     106
C                                                                       REDLP     107
C           Check if all its output blocks are ordered.                 REDLP     108
C                                                                       REDLP     109
            NEXT = IOUTOP(I)                                            REDLP     110
            FOUND = .TRUE.                                              REDLP     111
160         IF(NEXT.EQ.0) GOTO 180                                      REDLP     112
               IF(IUDINV(IOUTNU(NEXT)).EQ.0) FOUND = .FALSE.            REDLP     113
               NEXT = JOPOIN(NEXT)                                      REDLP     114
               GOTO 160                                                 REDLP     115
180         CONTINUE                                                    REDLP     116
C                                                                       REDLP     117
C                                                                       REDLP     118
            IF(FOUND)THEN                                               REDLP     119
C                                                                       REDLP     120
C              Found a block that must be removed from the system.      REDLP     121
C                                                                       REDLP     122
200            IF(IOUTOP(I).EQ.0) GOTO 260                              REDLP     123
                  JOLDPT = IOUTOP(I)                                    REDLP     124
                  JOLD = IOUTNU(JOLDPT)                                 REDLP     125
C                                                                       REDLP     126
C                 Remove i from JOLD's input list.                      REDLP     127
C                                                                       REDLP     128
                  NEXT = INTOP(JOLD)                                    REDLP     129
                  LAST = NEXT                                           REDLP     130
220               IF(NEXT.EQ.0) GOTO 240                                REDLP     131
                     IF(INNUM(NEXT).EQ.I)THEN                           REDLP     132
                        IF(NEXT.EQ.INTOP(JOLD))THEN                     REDLP     133
                           INTOP(JOLD) = IPOINT(NEXT)                   REDLP     134
                        ELSE                                            REDLP     135
                           IPOINT(LAST) = IPOINT(NEXT)                  REDLP     136
                        END IF                                          REDLP     137
                        IPOINT(NEXT) = IFREE                            REDLP     138
                        IFREE = NEXT                                    REDLP     139
                        NEXT = 0                                        REDLP     140
                     ELSE                                               REDLP     141
                        LAST = NEXT                                     REDLP     142
                        NEXT = IPOINT(NEXT)                             REDLP     143
                     END IF                                             REDLP     144
                     GOTO 220                                           REDLP     145
240               CONTINUE                                              REDLP     146
C                                                                       REDLP     147
C                 Remove JOLD from i's output list.                     REDLP     148
C                                                                       REDLP     149
                  IOUTOP(I) = JOPOIN(JOLDPT)                            REDLP     150
                  JOPOIN(JOLDPT) = IFREE                                REDLP     151
                  IFREE = JOLDPT                                        REDLP     152
                  GOTO 200                                              REDLP     153
260            CONTINUE                                                 REDLP     154
C                                                                       REDLP     155
            ELSE                                                        REDLP     156
C                                                                       REDLP     157
C              Remove any connections that are to an ordered block.     REDLP     158
C                                                                       REDLP     159
               NEXT = IOUTOP(I)                                         REDLP     160
               LAST = NEXT                                              REDLP     161
280            IF(NEXT.EQ.0) GOTO 340                                   REDLP     162
                  IF(IUDINV(IOUTNU(NEXT)) .NE. 0)THEN                   REDLP     163
                     JBLOCK = IOUTNU(NEXT)                              REDLP     164
                     IF(NEXT.EQ.IOUTOP(I))THEN                          REDLP     165
                        IOUTOP(I) = JOPOIN(NEXT)                        REDLP     166
                     ELSE                                               REDLP     167
                        JOPOIN(LAST) = JOPOIN(NEXT)                     REDLP     168
                     END IF                                             REDLP     169
                     INEXT = INTOP(JBLOCK)                              REDLP     170
                     ILAST=INEXT                                        REDLP     171
300                  IF(INEXT.EQ.0) GOTO 320                            REDLP     172
                        IF(INNUM(INEXT).EQ.I)THEN                       REDLP     173
                           IF(INEXT.EQ.INTOP(JBLOCK))THEN               REDLP     174
                              INTOP(JBLOCK) = IPOINT(INEXT)             REDLP     175
                           ELSE                                         REDLP     176
                              IPOINT(ILAST) = IPOINT(INEXT)             REDLP     177
                           END IF                                       REDLP     178
                           IPOINT(INEXT) = IFREE                        REDLP     179
                           IFREE = INEXT                                REDLP     180
                           INEXT = 0                                    REDLP     181
                        ELSE                                            REDLP     182
                           ILAST = INEXT                                REDLP     183
                           INEXT = IPOINT(INEXT)                        REDLP     184
                        END IF                                          REDLP     185
                        GOTO 300                                        REDLP     186
320                  CONTINUE                                           REDLP     187
                     JOLD = NEXT                                        REDLP     188
                     NEXT = JOPOIN(NEXT)                                REDLP     189
                     JOPOIN(JOLD) = IFREE                               REDLP     190
                     IFREE = INEXT                                      REDLP     191
                  ELSE                                                  REDLP     192
                     LAST = NEXT                                        REDLP     193
                     NEXT = JOPOIN(NEXT)                                REDLP     194
                  END IF                                                REDLP     195
                  GOTO 280                                              REDLP     196
340            CONTINUE                                                 REDLP     197
            END IF                                                      REDLP     198
         END IF                                                         REDLP     199
360   CONTINUE                                                          REDLP     200
C                                                                       REDLP     201
C                                                                       REDLP     202
C                                                                       REDLP     203
C                                                                       REDLP     204
C     Remove all blocks from the linked lists that have no              REDLP     205
C     output.  Keep removing blocks until all blocks in the             REDLP     206
C     input and output lists have an output.                            REDLP     207
C                                                                       REDLP     208
      LSTOP = .FALSE.                                                   REDLP     209
380   IF(LSTOP) GOTO 500                                                REDLP     210
         LSTOP = .TRUE.                                                 REDLP     211
         DO 480 I = 1, IUDC                                             REDLP     212
            IF(IOUTOP(I).EQ.0)THEN                                      REDLP     213
C                                                                       REDLP     214
C              No output for this block.  Remove this block             REDLP     215
C              from input and output list.                              REDLP     216
C                                                                       REDLP     217
400            IF(INTOP(I).EQ.0) GOTO 460                               REDLP     218
                  LSTOP = .FALSE.                                       REDLP     219
                  JOLDPT = INTOP(I)                                     REDLP     220
                  JOLD = INNUM(JOLDPT)                                  REDLP     221
C                                                                       REDLP     222
C                 Remove i from JOLD's output list.                     REDLP     223
C                                                                       REDLP     224
                  NEXT = IOUTOP(JOLD)                                   REDLP     225
                  LAST = NEXT                                           REDLP     226
420               IF(NEXT.EQ.0) GOTO 440                                REDLP     227
                     IF(IOUTNU(NEXT).EQ.I)THEN                          REDLP     228
                        IF(NEXT.EQ.IOUTOP(JOLD))THEN                    REDLP     229
                           IOUTOP(JOLD) = JOPOIN(NEXT)                  REDLP     230
                        ELSE                                            REDLP     231
                           JOPOIN(LAST) = JOPOIN(NEXT)                  REDLP     232
                        END IF                                          REDLP     233
                        JOPOIN(NEXT) = IFREE                            REDLP     234
                        IFREE = NEXT                                    REDLP     235
                        NEXT = 0                                        REDLP     236
                     ELSE                                               REDLP     237
                        LAST = NEXT                                     REDLP     238
                        NEXT = JOPOIN(NEXT)                             REDLP     239
                     END IF                                             REDLP     240
                     GOTO 420                                           REDLP     241
440               CONTINUE                                              REDLP     242
C                                                                       REDLP     243
C                                                                       REDLP     244
C                 Remove from input list.                               REDLP     245
C                                                                       REDLP     246
                  INTOP(I) = IPOINT(JOLDPT)                             REDLP     247
                  IPOINT(JOLDPT) = IFREE                                REDLP     248
                  IFREE = JOLDPT                                        REDLP     249
                  GOTO 400                                              REDLP     250
460            CONTINUE                                                 REDLP     251
            END IF                                                      REDLP     252
480      CONTINUE                                                       REDLP     253
         GOTO 380                                                       REDLP     254
500   CONTINUE                                                          REDLP     255
C                                                                       REDLP     256
C                                                                       REDLP     257
C---------------------------------------------------------------------  REDLP     258
C                                                                       REDLP     259
      RETURN                                                            REDLP     260
C                                                                       REDLP     261
C---------------------------------------------------------------------  REDLP     262
C                                                                       REDLP     263
      END                                                               REDLP     264
