CFPRIME SOLVSS                                                          SOLVSS      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  SOLVSS (JBLK, JORDER, DONE, POP)                      SOLVSS      3
CD--------------------------------------------------------------------- SOLVSS      4
CD                                                                      SOLVSS      5
CD               *****     SOLVSS  ROUTINE   *****                      SOLVSS      6
CD                                                                      SOLVSS      7
CD--------------------------------------------------------------------- SOLVSS      8
CD                                                                      SOLVSS      9
CD       PURPOSE:  Determines if the subsystem is stable.  Once the     SOLVSS     10
CD                 the subsystem is stable, it is removed from the      SOLVSS     11
CD                 stack, and the next block in solution order is       SOLVSS     12
CD                  evaluated.                                          SOLVSS     13
CD                                                                      SOLVSS     14
CD                                                                      SOLVSS     15
CD        DEFINITION OF LOCAL VARIABLES:                                SOLVSS     16
CD          (P)    JBLK    -  next block in solution order.             SOLVSS     17
CD                 CONT   -  indicates that another loop exists on      SOLVSS     18
CD                            the stack.                                SOLVSS     19
CD                  DIFF   -  difference between previous and current   SOLVSS     20
CD                            values.                                   SOLVSS     21
CD           (P)    DONE   -  indicates if the stack is empty.          SOLVSS     22
CD                  FORMT  -  internal format line.                     SOLVSS     23
CD                  LEN1   -  length of first block name.               SOLVSS     24
CD                  LEN2   -  length of second block name.              SOLVSS     25
CD                  MXCNT  -  maximum number of iterations.             SOLVSS     26
CD                  XNECHG -  new change in current value.              SOLVSS     27
CD                  JOLD    -  previous value for block.                SOLVSS     28
CD          (P)    JORDER  -  next pointer in solution order.           SOLVSS     29
CD           (P)    POP    -  indicates if the stack should be popped.  SOLVSS     30
CD                  REDO   -  indicates that the loop must be           SOLVSS     31
CD                            evaluated again.                          SOLVSS     32
CD                  ISAVE  -  first block of previous loop from stack   SOLVSS     33
CD                  SUBNAM -  subroutine name.                          SOLVSS     34
CD                                                                      SOLVSS     35
CD                                                                      SOLVSS     36
CD                                                                      SOLVSS     37
CD--------------------------------------------------------------------- SOLVSS     38
      INCLUDE 'CNUNIT.INS'                                              SOLVSS     39
      INCLUDE 'PARX.INS'                                                SOLVSS     40
      INCLUDE 'UDCA.INS'                                                SOLVSS     41
      INCLUDE 'UDCC.INS'                                                SOLVSS     42
      INCLUDE 'UDCH.INS'                                                SOLVSS     43
      INCLUDE 'CNFLAG.INS'                                              SOLVSS     44
      INCLUDE 'CNMSG.INS'                                               SOLVSS     45
C                                                                       SOLVSS     46
      LOGICAL       CONT, DONE, POP, REDO                               SOLVSS     47
C                                                                       SOLVSS     48
      CHARACTER*133 FORMT                                               SOLVSS     49
      CHARACTER*20  SUBNAM                                              SOLVSS     50
C                                                                       SOLVSS     51
C                                                                       SOLVSS     52
C---------------------------------------------------------------------  SOLVSS     53
C                                                                       SOLVSS     54
      LDEB=((JDEB(304).NE.0).AND.(JDEB(305).NE.0))                      SOLVSS     55
C                                                                       SOLVSS     56
      IF(SDBG)THEN                                                      SOLVSS     57
         SUBNAM = 'SOLVSS ROUTINE.'                                     SOLVSS     58
      ELSE                                                              SOLVSS     59
         SUBNAM = ' '                                                   SOLVSS     60
      END IF                                                            SOLVSS     61
C                                                                       SOLVSS     62
      MXCNT = 100                                                       SOLVSS     63
C                                                                       SOLVSS     64
C                                                                       SOLVSS     65
C     Continue processsing until no elements are left on the stack.     SOLVSS     66
C                                                                       SOLVSS     67
C                                                                       SOLVSS     68
C     Set solution order continuation flags.                            SOLVSS     69
C                                                                       SOLVSS     70
      REDO = .FALSE.                                                    SOLVSS     71
      CONT = .FALSE.                                                    SOLVSS     72
      POP = .FALSE.                                                     SOLVSS     73
C                                                                       SOLVSS     74
C                                                                       SOLVSS     75
      IF(JBLK.EQ.ISKEND(ISKTOP))THEN                                    SOLVSS     76
C                                                                       SOLVSS     77
C        Have reached the ending block for this subsystem.              SOLVSS     78
C                                                                       SOLVSS     79
         IF(ISKCNT(ISKTOP) .LT. 1)THEN                                  SOLVSS     80
C                                                                       SOLVSS     81
C           The first time this is evaluated, save the current value    SOLVSS     82
C           of the block as the old value.                              SOLVSS     83
C                                                                       SOLVSS     84
            SKVAL(ISKTOP) = SKCALC(ISKTOP)                              SOLVSS     85
            REDO = .TRUE.                                               SOLVSS     86
            ISKCNT(ISKTOP) = ISKCNT(ISKTOP) + 1                         SOLVSS     87
C                                                                       SOLVSS     88
         ELSE                                                           SOLVSS     89
C                                                                       SOLVSS     90
C           Evaluate a new increment value for the starting block.      SOLVSS     91
C                                                                       SOLVSS     92
            IF(SKCALC(ISKTOP).EQ.SKVAL(ISKTOP))THEN                     SOLVSS     93
C                                                                       SOLVSS     94
C              The subsystem solved to the same solution, even          SOLVSS     95
C              when the increment value had changed.                    SOLVSS     96
C                                                                       SOLVSS     97
               POP = .TRUE.                                             SOLVSS     98
               LEN1 = IUDLEN(ISKSTR(ISKTOP))                            SOLVSS     99
               LEN2 = IUDLEN(ISKEND(ISKTOP))                            SOLVSS    100
               WRITE(MSG(1),9008) SUBNAM                                SOLVSS    101
               WRITE(MSG(2),9009)                                       SOLVSS    102
               WRITE(MSG(3),9010) UDNAME(ISKSTR(ISKTOP))(1:LEN1),       SOLVSS    103
     1                            UDNAME(ISKEND(ISKTOP))(1:LEN2)        SOLVSS    104
               WRITE(MSG(4),9002) SKTOL(ISKTOP)                         SOLVSS    105
               WRITE(MSG(5),9003)                                       SOLVSS    106
               WRITE(MSG(6),9100)                                       SOLVSS    107
               WRITE(MSG(7),9101) SKVAL(ISKTOP)                         SOLVSS    108
               WRITE(MSG(8),9102)                                       SOLVSS    109
               WRITE(MSG(9),9103)                                       SOLVSS    110
               WRITE(MSG(10),9104)                                      SOLVSS    111
               CALL PRTMSG(10)                                          SOLVSS    112
               IERCNT = IERCNT + 1                                      SOLVSS    113
               DIFF = SKTOL(ISKTOP)                                     SOLVSS    114
            ELSE                                                        SOLVSS    115
               POP = .FALSE.                                            SOLVSS    116
               XNECHG=(SKDESR(ISKTOP)-SKVAL(ISKTOP))*SKINCR(ISKTOP)     SOLVSS    117
     1                  / (SKCALC(ISKTOP) - SKVAL(ISKTOP))              SOLVSS    118
               SKINIT(ISKTOP) = SKINIT(ISKTOP) + SKINCR(ISKTOP)         SOLVSS    119
               SKINCR(ISKTOP) = XNECHG - SKINCR(ISKTOP)                 SOLVSS    120
C                                                                       SOLVSS    121
C                                                                       SOLVSS    122
               IF(LDEB)THEN                                             SOLVSS    123
                  LEN1 = IUDLEN(JBLK)                                   SOLVSS    124
                  WRITE (FORMT,9004) ISKTAB, UDNAME(JBLK)(1:LEN1),      SOLVSS    125
     1                               SKVAL(ISKTOP), SKDESR(ISKTOP),     SOLVSS    126
     2                               SKCALC(ISKTOP)                     SOLVSS    127
                  WRITE (IUD6,FORMT)                                    SOLVSS    128
               END IF                                                   SOLVSS    129
               SKVAL(ISKTOP) = SKCALC(ISKTOP)                           SOLVSS    130
               DIFF = ABS (SKCALC(ISKTOP) - SKDESR(ISKTOP))             SOLVSS    131
               IF(DIFF .LT. SKTOL(ISKTOP)) POP = .TRUE.                 SOLVSS    132
            END IF                                                      SOLVSS    133
C                                                                       SOLVSS    134
            IF(POP)THEN                                                 SOLVSS    135
               POP = .FALSE.                                            SOLVSS    136
C                                                                       SOLVSS    137
C              Stop the processing if the difference in old value       SOLVSS    138
C              and new value is less than tolerence.                    SOLVSS    139
C                                                                       SOLVSS    140
C              Pop the loop stack.                                      SOLVSS    141
C                                                                       SOLVSS    142
               IF(LDEB)THEN                                             SOLVSS    143
                  ISKTAB = ISKTAB - 3                                   SOLVSS    144
                  LEN1 = IUDLEN(ISKSTR(ISKTOP))                         SOLVSS    145
                  LEN2 = IUDLEN(ISKEND(ISKTOP))                         SOLVSS    146
                  WRITE (FORMT,9006) ISKTAB,                            SOLVSS    147
     1                               UDNAME(ISKSTR(ISKTOP))(1:LEN1),    SOLVSS    148
     2                               UDNAME(ISKEND(ISKTOP))(1:LEN2),    SOLVSS    149
     3                               ISKCNT(ISKTOP)                     SOLVSS    150
                  WRITE (IUD6,FORMT)                                    SOLVSS    151
               END IF                                                   SOLVSS    152
               ISAVE = ISKSTR(ISKTOP)                                   SOLVSS    153
               JOLD = ISKFRE                                            SOLVSS    154
               ISKFRE = ISKTOP                                          SOLVSS    155
               ISKTOP = ISKNEX(ISKTOP)                                  SOLVSS    156
               ISKNEX(ISKFRE) = JOLD                                    SOLVSS    157
C                                                                       SOLVSS    158
               IF(ISKTOP.EQ.0)THEN                                      SOLVSS    159
                  DONE = .TRUE.                                         SOLVSS    160
               ELSEIF(ISAVE.EQ.ISKEND(ISKTOP)) THEN                     SOLVSS    161
                  POP = .TRUE.                                          SOLVSS    162
               ELSE                                                     SOLVSS    163
                  CONT = .TRUE.                                         SOLVSS    164
               END IF                                                   SOLVSS    165
C                                                                       SOLVSS    166
            ELSEIF(ISKCNT(ISKTOP) .GT. MXCNT)THEN                       SOLVSS    167
C                                                                       SOLVSS    168
C              Stop the processing because it has reached maximum       SOLVSS    169
C              number of iteration counts.                              SOLVSS    170
C                                                                       SOLVSS    171
               DONE = .TRUE.                                            SOLVSS    172
               LEN1 = IUDLEN(ISKSTR(ISKTOP))                            SOLVSS    173
               LEN2 = IUDLEN(ISKEND(ISKTOP))                            SOLVSS    174
               WRITE (MSG(1),9008) SUBNAM                               SOLVSS    175
               WRITE(MSG(2),9009)                                       SOLVSS    176
               WRITE(MSG(3),9010) UDNAME(ISKSTR(ISKTOP))(1:LEN1),       SOLVSS    177
     2                            UDNAME(ISKEND(ISKTOP))(1:LEN2)        SOLVSS    178
               WRITE(MSG(4),9011) MXCNT                                 SOLVSS    179
               WRITE(MSG(5),9012) UDNAME(ISKEND(ISKTOP))(1:LEN2),       SOLVSS    180
     4                            SKVAL(ISKTOP)                         SOLVSS    181
               CALL PRTMSG(5)                                           SOLVSS    182
               IERCNT = IERCNT + 1                                      SOLVSS    183
C                                                                       SOLVSS    184
C              Empty the loop stack.                                    SOLVSS    185
C                                                                       SOLVSS    186
20             IF(ISKTOP.EQ.0) GOTO 40                                  SOLVSS    187
                  IF(LDEB)THEN                                          SOLVSS    188
                     ISKTAB = ISKTAB - 3                                SOLVSS    189
                     LEN1 = IUDLEN(ISKSTR(ISKTOP))                      SOLVSS    190
                     LEN2 = IUDLEN(ISKEND(ISKTOP))                      SOLVSS    191
                     WRITE (FORMT,9006) ISKTAB,                         SOLVSS    192
     1               UDNAME(ISKSTR(ISKTOP))(1:LEN1),                    SOLVSS    193
     2               UDNAME(ISKEND(ISKTOP))(1:LEN2),                    SOLVSS    194
     3                                  ISKCNT(ISKTOP)                  SOLVSS    195
                     WRITE (IUD6,FORMT)                                 SOLVSS    196
                  END IF                                                SOLVSS    197
                  JOLD = ISKFRE                                         SOLVSS    198
                  ISKFRE = ISKTOP                                       SOLVSS    199
                  ISKTOP = ISKNEX(ISKTOP)                               SOLVSS    200
                  ISKNEX(ISKFRE) = JOLD                                 SOLVSS    201
                  GOTO 20                                               SOLVSS    202
40             CONTINUE                                                 SOLVSS    203
C                                                                       SOLVSS    204
            ELSE                                                        SOLVSS    205
C                                                                       SOLVSS    206
C              Increment the loop count.                                SOLVSS    207
C                                                                       SOLVSS    208
               ISKCNT(ISKTOP) = ISKCNT(ISKTOP) + 1                      SOLVSS    209
               REDO = .TRUE.                                            SOLVSS    210
            END IF                                                      SOLVSS    211
C                                                                       SOLVSS    212
         END IF                                                         SOLVSS    213
C                                                                       SOLVSS    214
      END IF                                                            SOLVSS    215
C                                                                       SOLVSS    216
C     Calculate the next block to be processed.                         SOLVSS    217
C                                                                       SOLVSS    218
      IF(REDO)THEN                                                      SOLVSS    219
C                                                                       SOLVSS    220
C        Next block is the beginning of the current loop.               SOLVSS    221
C                                                                       SOLVSS    222
         JBLK = ISKSTR(ISKTOP)                                          SOLVSS    223
C                                                                       SOLVSS    224
      ELSEIF(CONT)THEN                                                  SOLVSS    225
C                                                                       SOLVSS    226
         JORDER = ISKRTN(ISKTOP)                                        SOLVSS    227
         JBLK = IUDPRM(JORDER)                                          SOLVSS    228
C                                                                       SOLVSS    229
      ELSEIF(POP) THEN                                                  SOLVSS    230
C                                                                       SOLVSS    231
C     Another loop may be popped from the stack.                        SOLVSS    232
C                                                                       SOLVSS    233
         JBLK = ISAVE                                                   SOLVSS    234
C                                                                       SOLVSS    235
      ELSE                                                              SOLVSS    236
C                                                                       SOLVSS    237
C        Next block is the next block in solution order.                SOLVSS    238
C                                                                       SOLVSS    239
         JORDER = IUDINV(JBLK)                                          SOLVSS    240
         JORDER = JORDER + 1                                            SOLVSS    241
         JBLK = IUDPRM(JORDER)                                          SOLVSS    242
      END IF                                                            SOLVSS    243
C                                                                       SOLVSS    244
C                                                                       SOLVSS    245
C---------------------------------------------------------------------  SOLVSS    246
C                                                                       SOLVSS    247
      RETURN                                                            SOLVSS    248
C                                                                       SOLVSS    249
C---------------------------------------------------------------------  SOLVSS    250
C                                                                       SOLVSS    251
9002  FORMAT(10X,'SOLVE TO THE TOLERANCE OF ', F15.5,'.  HOWEVER THE')  SOLVSS    252
9003  FORMAT(10X                                                        SOLVSS    253
     *,'SOLUTION PROCESS STOPPED BECAUSE THE PREVIOUS VALUE IS')        SOLVSS    254
9100  FORMAT(10X                                                        SOLVSS    255
     *,'THE SAME AS THE NEW VALUE.  THE SUBSYSTEM IS ASSUMED TO BE')    SOLVSS    256
9101  FORMAT(10X,'SOLVED WITH THE VALUE OF ', F15.5,'. CHECK YOUR UDC') SOLVSS    257
9102  FORMAT(10X                                                        SOLVSS    258
     *,'FOR LIMITS WHICH MIGHT BE INCORRECT IN THE SUBSYSTEM.  ALSO')   SOLVSS    259
9103  FORMAT(10X,                                                       SOLVSS    260
     *'CHECK THE INTERFACE BLOCK LOGIC TO ENSURE THAT THE CORRECT')     SOLVSS    261
9104  FORMAT(10X,'BLOCK IS IN CONTROL.')                                SOLVSS    262
9004  FORMAT ('(///, ', I3, 'X, ''BLOCK: ', A, 2X, 'PREVIOUS: ',        SOLVSS    263
     1        F12.6, 2X, 'DESIRED VALUE: ', F12.6, 2X,                  SOLVSS    264
     2       'NEW VALUE: ', F12.6, ''')')                               SOLVSS    265
9006  FORMAT ('(///, ', I3, 'X, ''REMOVE FROM STACK  ---  SUB-',        SOLVSS    266
     1        'SYSTEM FROM "', A, '" TO "', A, '"  AFTER ', I3,         SOLVSS    267
     2        ' COUNTS.'')')                                            SOLVSS    268
9008  FORMAT (' *** MTDC ERROR', 5X, A)                                 SOLVSS    269
9009  FORMAT(10X,'DURING THE INITIALIZATION OF THE UDC BLOCKS,')        SOLVSS    270
9010  FORMAT(10X,'THE SUBSYSTEM FROM "',A,'" TO "',A,'", DID NOT')      SOLVSS    271
9011  FORMAT(10X,'REACH A STEADY STATE AFTER ',I3,' ITERATIONS.')       SOLVSS    272
9012  FORMAT(10X,'THE OUTPUT OF "',A,'" IS PRESENTLY ', F15.5)          SOLVSS    273
C                                                                       SOLVSS    274
C---------------------------------------------------------------------  SOLVSS    275
C                                                                       SOLVSS    276
      END                                                               SOLVSS    277
