CFPRIME SOLVLP                                                          SOLVLP      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  SOLVLP (JBLK, JORDER, DONE, POP)                      SOLVLP      3
CD--------------------------------------------------------------------- SOLVLP      4
CD                                                                      SOLVLP      5
CD               *****     SOLVLP  ROUTINE   *****                      SOLVLP      6
CD                                                                      SOLVLP      7
CD--------------------------------------------------------------------- SOLVLP      8
CD                                                                      SOLVLP      9
CD        PURPOSE:  Determines if the loop is stable.  Once the loop    SOLVLP     10
CD                  is stable the loop is removed from the stack, and   SOLVLP     11
CD                 the next block in solution order is evaluated.       SOLVLP     12
CD                                                                      SOLVLP     13
CD                                                                      SOLVLP     14
CD        DEFINITION OF LOCAL VARIABLES:                                SOLVLP     15
CD           (P)     POP   -  indicates if the stack should be poped    SOLVLP     16
CD          (P)    JBLK    -  next block in solution order.             SOLVLP     17
CD                 CONT   -  indicates that another loop exists on      SOLVLP     18
CD                            the stack.                                SOLVLP     19
CD                  DIFF   -  difference between previous and current   SOLVLP     20
CD                            values.                                   SOLVLP     21
CD           (P)    DONE   -  indicates if stack is empty.              SOLVLP     22
CD                  FORMT  -  internal format code.                     SOLVLP     23
CD                  LEN1   -  length of first block name.               SOLVLP     24
CD                  LEN2   -  length of second block name.              SOLVLP     25
CD                  MXCNT  -  maximum number of iterations.             SOLVLP     26
CD                  NMEND  -  name of last  block in loop.              SOLVLP     27
CD                  NMSTRT -  name of first block in loop.              SOLVLP     28
CD                  XNOW    -  current value for block.                 SOLVLP     29
CD                  JOLD    -  previous value for block.                SOLVLP     30
CD          (P)    JORDER  -  next pointer in solution order.           SOLVLP     31
CD                  REDO   -  indicates that the loop must be           SOLVLP     32
CD                            evaluated again.                          SOLVLP     33
CD                  JSAVE   -  first block of previous loop form stack  SOLVLP     34
CD                  SUBNAM -  subroutine name.                          SOLVLP     35
CD                                                                      SOLVLP     36
CD                                                                      SOLVLP     37
CD                                                                      SOLVLP     38
CD--------------------------------------------------------------------- SOLVLP     39
      INCLUDE 'CNUNIT.INS'                                              SOLVLP     40
      INCLUDE 'PARX.INS'                                                SOLVLP     41
      INCLUDE 'UDCA.INS'                                                SOLVLP     42
      INCLUDE 'UDCB.INS'                                                SOLVLP     43
      INCLUDE 'UDCC.INS'                                                SOLVLP     44
      INCLUDE 'UDCH.INS'                                                SOLVLP     45
      INCLUDE 'CNFLAG.INS'                                              SOLVLP     46
      INCLUDE 'CNMSG.INS'                                               SOLVLP     47
C                                                                       SOLVLP     48
      LOGICAL       CONT, DONE, POP, REDO                               SOLVLP     49
C                                                                       SOLVLP     50
      CHARACTER*133 FORMT                                               SOLVLP     51
      CHARACTER*20  SUBNAM                                              SOLVLP     52
      CHARACTER*17  NMEND, NMSTRT                                       SOLVLP     53
C                                                                       SOLVLP     54
C---------------------------------------------------------------------  SOLVLP     55
C                                                                       SOLVLP     56
      LDEB=((JDEB(304).NE.0).AND.(JDEB(305).NE.0))                      SOLVLP     57
C                                                                       SOLVLP     58
      IF(SDBG)THEN                                                      SOLVLP     59
         SUBNAM = 'SOLVLP ROUTINE.'                                     SOLVLP     60
      ELSE                                                              SOLVLP     61
         SUBNAM = ' '                                                   SOLVLP     62
      END IF                                                            SOLVLP     63
C                                                                       SOLVLP     64
      MXCNT = 100                                                       SOLVLP     65
C                                                                       SOLVLP     66
C                                                                       SOLVLP     67
C     Continue processing loops until no more remain on the stack.      SOLVLP     68
C                                                                       SOLVLP     69
C                                                                       SOLVLP     70
C     Set solution order continuation block flags.                      SOLVLP     71
C                                                                       SOLVLP     72
      REDO = .FALSE.                                                    SOLVLP     73
      CONT = .FALSE.                                                    SOLVLP     74
      POP = .FALSE.                                                     SOLVLP     75
C                                                                       SOLVLP     76
C                                                                       SOLVLP     77
C     Check if this loop has been solved.                               SOLVLP     78
C                                                                       SOLVLP     79
      IF(JBLK.EQ.ISKEND(ISKTOP))THEN                                    SOLVLP     80
C                                                                       SOLVLP     81
C        Have reached the beginning of the loop.                        SOLVLP     82
C                                                                       SOLVLP     83
         DIFF = ABS (SKVAL(ISKTOP) - UDVAL(JBLK))                       SOLVLP     84
         XNOW = UDVAL(JBLK)                                             SOLVLP     85
         UDVAL(JBLK) = (UDVAL(JBLK) + SKVAL(ISKTOP)) / 2.0              SOLVLP     86
         IF(LDEB)THEN                                                   SOLVLP     87
            LEN1 = IUDLEN(JBLK)                                         SOLVLP     88
            WRITE (FORMT,9002) ISKTAB,UDNAME(JBLK)(1:LEN1)              SOLVLP     89
     &                      , SKVAL(ISKTOP),XNOW, UDVAL(JBLK)           SOLVLP     90
            WRITE (IUD6,FORMT)                                          SOLVLP     91
         END IF                                                         SOLVLP     92
         SKVAL(ISKTOP) = UDVAL(JBLK)                                    SOLVLP     93
         IF(SKVAL(ISKTOP) .NE. 0.0)THEN                                 SOLVLP     94
            ALPTOL = XLPTOL * ABS (SKVAL(ISKTOP))                       SOLVLP     95
         ELSE                                                           SOLVLP     96
            ALPTOL = XLPTOL                                             SOLVLP     97
         END IF                                                         SOLVLP     98
         IF(DIFF .LT. ALPTOL)THEN                                       SOLVLP     99
            POP = .FALSE.                                               SOLVLP    100
C                                                                       SOLVLP    101
C           Stop the processing if the difference in old value          SOLVLP    102
C           and new value is less than tolerence.                       SOLVLP    103
C                                                                       SOLVLP    104
C           Pop the loop stack.                                         SOLVLP    105
C                                                                       SOLVLP    106
            IF(LDEB)THEN                                                SOLVLP    107
               ISKTAB = ISKTAB - 3                                      SOLVLP    108
               LEN1 = IUDLEN(ISKSTR(ISKTOP))                            SOLVLP    109
               LEN2 = IUDLEN(ISKEND(ISKTOP))                            SOLVLP    110
               WRITE (FORMT,9004) ISKTAB,                               SOLVLP    111
     &                            UDNAME(ISKSTR(ISKTOP))(1:LEN1),       SOLVLP    112
     1                            UDNAME(ISKEND(ISKTOP))(1:LEN2),       SOLVLP    113
     2                            ISKCNT(ISKTOP)                        SOLVLP    114
               WRITE (IUD6,FORMT)                                       SOLVLP    115
            END IF                                                      SOLVLP    116
            ISAVE = ISKSTR(ISKTOP)                                      SOLVLP    117
            JOLD = ISKFRE                                               SOLVLP    118
            ISKFRE = ISKTOP                                             SOLVLP    119
            ISKTOP = ISKNEX(ISKTOP)                                     SOLVLP    120
            ISKNEX(ISKFRE) = JOLD                                       SOLVLP    121
C                                                                       SOLVLP    122
            IF(ISKTOP.EQ.0)THEN                                         SOLVLP    123
               DONE = .TRUE.                                            SOLVLP    124
            ELSEIF(ISAVE.EQ.ISKEND(ISKTOP)) THEN                        SOLVLP    125
               POP = .TRUE.                                             SOLVLP    126
            ELSE                                                        SOLVLP    127
               CONT = .TRUE.                                            SOLVLP    128
            END IF                                                      SOLVLP    129
C                                                                       SOLVLP    130
         ELSEIF(ISKCNT(ISKTOP) .GT. MXCNT)THEN                          SOLVLP    131
C                                                                       SOLVLP    132
C           Stop the processing because it has reached maximum          SOLVLP    133
C           number of iteration counts.                                 SOLVLP    134
C                                                                       SOLVLP    135
            DONE = .TRUE.                                               SOLVLP    136
C                                                                       SOLVLP    137
            NMSTRT = UDNAME(ISKSTR(ISKTOP))                             SOLVLP    138
            LEN1 = IUDLEN(ISKSTR(ISKTOP))                               SOLVLP    139
            NMEND = UDNAME(ISKEND(ISKTOP))                              SOLVLP    140
            LEN2 = IUDLEN(ISKEND(ISKTOP))                               SOLVLP    141
            WRITE (MSG(1),9006) SUBNAM                                  SOLVLP    142
            WRITE(MSG(2),9007)                                          SOLVLP    143
            WRITE(MSG(3),9008) NMSTRT(1:LEN1),NMEND(1:LEN2)             SOLVLP    144
            WRITE(MSG(4),9009) MXCNT                                    SOLVLP    145
            WRITE(MSG(5),9010) NMEND(1:LEN2), SKVAL(ISKTOP)             SOLVLP    146
            CALL PRTMSG(5)                                              SOLVLP    147
            IERCNT = IERCNT + 1                                         SOLVLP    148
C                                                                       SOLVLP    149
C           Empty the loop stack.                                       SOLVLP    150
C                                                                       SOLVLP    151
20          IF(ISKTOP.EQ.0) GOTO 40                                     SOLVLP    152
               IF(LDEB)THEN                                             SOLVLP    153
                  ISKTAB = ISKTAB - 3                                   SOLVLP    154
                  LEN1 = IUDLEN(ISKSTR(ISKTOP))                         SOLVLP    155
                  LEN2 = IUDLEN(ISKEND(ISKTOP))                         SOLVLP    156
                  WRITE (FORMT,9004) ISKTAB,                            SOLVLP    157
     1                               UDNAME(ISKSTR(ISKTOP))(1:LEN1),    SOLVLP    158
     2                               UDNAME(ISKEND(ISKTOP))(1:LEN2),    SOLVLP    159
     3                               ISKCNT(ISKTOP)                     SOLVLP    160
                  WRITE (IUD6,FORMT)                                    SOLVLP    161
               END IF                                                   SOLVLP    162
               JOLD = ISKFRE                                            SOLVLP    163
               ISKFRE = ISKTOP                                          SOLVLP    164
               ISKTOP = ISKNEX(ISKTOP)                                  SOLVLP    165
               ISKNEX(ISKFRE) = JOLD                                    SOLVLP    166
               GOTO 20                                                  SOLVLP    167
40          CONTINUE                                                    SOLVLP    168
C                                                                       SOLVLP    169
         ELSE                                                           SOLVLP    170
C                                                                       SOLVLP    171
C           Increment the loop count.                                   SOLVLP    172
C                                                                       SOLVLP    173
            ISKCNT(ISKTOP) = ISKCNT(ISKTOP) + 1                         SOLVLP    174
            REDO = .TRUE.                                               SOLVLP    175
         END IF                                                         SOLVLP    176
C                                                                       SOLVLP    177
      END IF                                                            SOLVLP    178
C                                                                       SOLVLP    179
C                                                                       SOLVLP    180
C                                                                       SOLVLP    181
C     Calculate the next block to be processed.                         SOLVLP    182
C                                                                       SOLVLP    183
      IF(REDO)THEN                                                      SOLVLP    184
C                                                                       SOLVLP    185
C        Next block is the beginning of the current loop.               SOLVLP    186
C                                                                       SOLVLP    187
         JBLK = ISKSTR(ISKTOP)                                          SOLVLP    188
C                                                                       SOLVLP    189
      ELSEIF(CONT)THEN                                                  SOLVLP    190
C                                                                       SOLVLP    191
         JORDER = ISKRTN(ISKTOP)                                        SOLVLP    192
         JBLK = IUDPRM(JORDER)                                          SOLVLP    193
C                                                                       SOLVLP    194
      ELSEIF(POP) THEN                                                  SOLVLP    195
C                                                                       SOLVLP    196
C     Another loop may be popped from the stack.                        SOLVLP    197
C                                                                       SOLVLP    198
         JBLK = ISAVE                                                   SOLVLP    199
      ELSE                                                              SOLVLP    200
C                                                                       SOLVLP    201
C        Next block is the next block in solution order.                SOLVLP    202
C                                                                       SOLVLP    203
         JORDER = IUDINV(JBLK)                                          SOLVLP    204
         JORDER = JORDER + 1                                            SOLVLP    205
         JBLK = IUDPRM(JORDER)                                          SOLVLP    206
      END IF                                                            SOLVLP    207
C                                                                       SOLVLP    208
C                                                                       SOLVLP    209
C---------------------------------------------------------------------  SOLVLP    210
C                                                                       SOLVLP    211
      RETURN                                                            SOLVLP    212
C                                                                       SOLVLP    213
C---------------------------------------------------------------------  SOLVLP    214
C                                                                       SOLVLP    215
9002  FORMAT ('(///, ', I3, 'X, ''BLOCK: ', A, 2X, 'PREVIOUS: ',        SOLVLP    216
     1        F12.6, 2X, 'CALCULATED: ', F12.6, 2X, 'NEW VALUE: ',      SOLVLP    217
     2        F12.6, ''')')                                             SOLVLP    218
9004  FORMAT ('(///, ', I3, 'X, ''REMOVE FROM STACK  ---  LOOP FROM "', SOLVLP    219
     1        A, '" TO "', A, '"  AFTER ', I3, ' COUNTS.'')')           SOLVLP    220
9006  FORMAT (' *** MTDC ERROR ',A)                                     SOLVLP    221
9007  FORMAT(10X,'DURING THE INITIALIZATION OF THE UDC BLOCKS,')        SOLVLP    222
9008  FORMAT(10X,'THE LOOP FROM','"',A,'" TO "',A,'", DID NOT REACH')   SOLVLP    223
9009  FORMAT(10X,'A STEADY STATE AFTER ',I3,' ITERATIONS.')             SOLVLP    224
9010  FORMAT(10X,'THE OUTPUT OF','"', A, '" IS PRESENTLY ', F15.5)      SOLVLP    225
C                                                                       SOLVLP    226
C---------------------------------------------------------------------  SOLVLP    227
C                                                                       SOLVLP    228
      END                                                               SOLVLP    229
