CFPRIME UILOOP                                                          UILOOP      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  UILOOP (JBLK, JORDER)                                 UILOOP      3
CD -------------------------------------------------------------------  UILOOP      4
CD                                                                      UILOOP      5
CD              *****     UILOOP  ROUTINE   *****                       UILOOP      6
CD                                                                      UILOOP      7
CD -------------------------------------------------------------------  UILOOP      8
CD                                                                      UILOOP      9
CD       PURPOSE:  Solves the arithmetic loop or subsystem within       UILOOP     10
CD                 the udc system.  Used during the initialization      UILOOP     11
CD                 of the udc system.                                   UILOOP     12
CD                                                                      UILOOP     13
CD                                                                      UILOOP     14
CD       DEFINITION OF LOCAL VARIABLES:                                 UILOOP     15
CD          (P)    JBLK    -  current udc block.                        UILOOP     16
CD                 BNAME  -  array containing list of block names.      UILOOP     17
CD                 DONE   -  indicates that the current loop or         UILOOP     18
CD                           subsystem has been resolved.               UILOOP     19
CD                 FIRST  -  indicates that less than 6 names were      UILOOP     20
CD                           found.                                     UILOOP     21
CD                 FORMT  -  internal format line.                      UILOOP     22
CD                 I      - 'do' loop index.                            UILOOP     23
CD                 K      - 'do' loop index.                            UILOOP     24
CD                 LEN    -  array containing length of block names.    UILOOP     25
CD                 LINLEN -  length of print line.                      UILOOP     26
CD                 NAMES  -  contains list of block names.              UILOOP     27
CD                 NEXT   -  current entry in linked list.              UILOOP     28
CD                 OK     -  indicates that CALC and DESIRE are valid.  UILOOP     29
CD          (P)    JORDER  -  pointer to next block in solution order.  UILOOP     30
CD                 POP    -  indicates that stack was popped.           UILOOP     31
CD                 SNAME  -  udc subtype name.                          UILOOP     32
CD                 TNAME  -  udc type name.                             UILOOP     33
CD                                                                      UILOOP     34
CD -------------------------------------------------------------------  UILOOP     35
      INCLUDE 'CNUNIT.INS'                                              UILOOP     36
      INCLUDE 'PARX.INS'                                                UILOOP     37
      INCLUDE 'UDCA.INS'                                                UILOOP     38
      INCLUDE 'UDCB.INS'                                                UILOOP     39
      INCLUDE 'UDCC.INS'                                                UILOOP     40
      INCLUDE 'UDCD.INS'                                                UILOOP     41
      INCLUDE 'UDCE.INS'                                                UILOOP     42
      INCLUDE 'UDCH.INS'                                                UILOOP     43
      INCLUDE 'CNFLAG.INS'                                              UILOOP     44
C                                                                       UILOOP     45
      LOGICAL       DONE, OK, POP                                       UILOOP     46
      CHARACTER*133 FORMT                                               UILOOP     47
      CHARACTER*8   SNAME, TNAME                                        UILOOP     48
C                                                                       UILOOP     49
C---------------------------------------------------------------------  UILOOP     50
C                                                                       UILOOP     51
C     Initialize the loop stack to empty.                               UILOOP     52
C                                                                       UILOOP     53
      LDEB=((JDEB(304).NE.0).AND.(JDEB(305).NE.0))                      UILOOP     54
C                                                                       UILOOP     55
      ISKTOP = 0                                                        UILOOP     56
      ISKTAB = 1                                                        UILOOP     57
      ISKFRE = 1                                                        UILOOP     58
      DO 20 I = 1, NUDC                                                 UILOOP     59
         ISKSTR(I) = 0                                                  UILOOP     60
         ISKEND(I) = 0                                                  UILOOP     61
         SKCALC(I) = 0.0                                                UILOOP     62
         SKDESR(I) = 0.0                                                UILOOP     63
         ISKLOP(I) = 0                                                  UILOOP     64
         SKVAL(I) = 0.0                                                 UILOOP     65
         ISKRTN(I) = 0                                                  UILOOP     66
         SKINIT(I) = 0.0                                                UILOOP     67
         ISKOUT(I) = 0                                                  UILOOP     68
         SKINCR(I) = 0.0                                                UILOOP     69
         SKTOL(I) = 0.0                                                 UILOOP     70
         ISKCNT(I) = 0                                                  UILOOP     71
         ISKNEX(I) = I + 1                                              UILOOP     72
         SKLOW(I) = 0.0                                                 UILOOP     73
         SKHIGH(I) = 0.0                                                UILOOP     74
20    CONTINUE                                                          UILOOP     75
      ISKNEX(NUDC) = 0                                                  UILOOP     76
C                                                                       UILOOP     77
C                                                                       UILOOP     78
C     Add any loops that begin with this block to the stack.            UILOOP     79
C                                                                       UILOOP     80
      DONE = .TRUE.                                                     UILOOP     81
      DO 40 I = 1, LPMAX                                                UILOOP     82
         NEXT = LPTOP(I)                                                UILOOP     83
         IF(JBLK.EQ.LPNUM(NEXT))THEN                                    UILOOP     84
C                                                                       UILOOP     85
C           Create new entry on stack.                                  UILOOP     86
C                                                                       UILOOP     87
            CALL ADDSTK (JBLK, JORDER, NEXT, I)                         UILOOP     88
            DONE = .FALSE.                                              UILOOP     89
         END IF                                                         UILOOP     90
40    CONTINUE                                                          UILOOP     91
C                                                                       UILOOP     92
C                                                                       UILOOP     93
C     Continue processing loops until no more remain on the stack.      UILOOP     94
C                                                                       UILOOP     95
60    IF(DONE) GOTO 180                                                 UILOOP     96
C                                                                       UILOOP     97
         IF(JBLK .NE. ISKSTR(ISKTOP))THEN                               UILOOP     98
C                                                                       UILOOP     99
C           The block is not the start of the current loop, check       UILOOP    100
C           that it does not start other loops.                         UILOOP    101
C                                                                       UILOOP    102
            DO 80 I = 1, LPMAX                                          UILOOP    103
               NEXT = LPTOP(I)                                          UILOOP    104
               IF(JBLK.EQ.LPNUM(NEXT))THEN                              UILOOP    105
C                                                                       UILOOP    106
C                 Found another loop which must be solved before        UILOOP    107
C                 the current one.                                      UILOOP    108
C                                                                       UILOOP    109
                  CALL ADDSTK (JBLK, JORDER, NEXT, I)                   UILOOP    110
C                                                                       UILOOP    111
               END IF                                                   UILOOP    112
80          CONTINUE                                                    UILOOP    113
C                                                                       UILOOP    114
         END IF                                                         UILOOP    115
C                                                                       UILOOP    116
C                                                                       UILOOP    117
C        Determine if this is the first block of a subsystem.           UILOOP    118
C                                                                       UILOOP    119
C                                                                       UILOOP    120
C        Evaluate the output value for this block.                      UILOOP    121
C                                                                       UILOOP    122
         OK = .TRUE.                                                    UILOOP    123
C                                                                       UILOOP    124
         TNAME = TPNAME(IUDTYP(JBLK))                                   UILOOP    125
C                                                                       UILOOP    126
         IF(IUDTYP(JBLK).EQ.IACSYS)THEN                                 UILOOP    127
C            SNAME = SBACSY(IUDSUB(JBLK))                               UILOOP    128
C            CALL UIACSY (JBLK)                                         UILOOP    129
C                                                                       UILOOP    130
         ELSEIF(IUDTYP(JBLK).EQ.IBINAR)THEN                             UILOOP    131
            SNAME = SBBIN(IUDSUB(JBLK))                                 UILOOP    132
            CALL UIBIN (JBLK)                                           UILOOP    133
C                                                                       UILOOP    134
         ELSEIF(IUDTYP(JBLK).EQ.IBREAK)THEN                             UILOOP    135
            SNAME = SBBRKR(IUDSUB(JBLK))                                UILOOP    136
            CALL UIBRKR (JBLK)                                          UILOOP    137
C                                                                       UILOOP    138
         ELSEIF(IUDTYP(JBLK).EQ.IUDUMY)THEN                             UILOOP    139
C                                                                       UILOOP    140
C           These blocks are initialized by the corresponding           UILOOP    141
C           'FORTRAN' routine.                                          UILOOP    142
C                                                                       UILOOP    143
         ELSEIF(IUDTYP(JBLK).EQ.IFRMAC)THEN                             UILOOP    144
            SNAME = SBFRAC(IUDSUB(JBLK))                                UILOOP    145
            CALL UIFRAC (JBLK)                                          UILOOP    146
C                                                                       UILOOP    147
         ELSEIF(IUDTYP(JBLK).EQ.IFRTRA)THEN                             UILOOP    148
            SNAME = SBFORT(IUDSUB(JBLK))                                UILOOP    149
            CALL UIFORT (JBLK)                                          UILOOP    150
C                                                                       UILOOP    151
         ELSEIF(IUDTYP(JBLK).EQ.IFRMDC)THEN                             UILOOP    152
            SNAME = SBFRDC(IUDSUB(JBLK))                                UILOOP    153
            CALL UIFRDC (JBLK)                                          UILOOP    154
C                                                                       UILOOP    155
         ELSEIF(IUDTYP(JBLK).EQ.INTERF)THEN                             UILOOP    156
            SNAME = ' '                                                 UILOOP    157
            CALL UIINTF (JBLK, OK)                                      UILOOP    158
C                                                                       UILOOP    159
         ELSEIF(IUDTYP(JBLK).EQ.LIMITR)THEN                             UILOOP    160
            SNAME = SBLIMT(IUDSUB(JBLK))                                UILOOP    161
            CALL UILIMT (JBLK)                                          UILOOP    162
C                                                                       UILOOP    163
         ELSEIF(IUDTYP(JBLK).EQ.LOGIC)THEN                              UILOOP    164
            SNAME = SBLOGC(IUDSUB(JBLK))                                UILOOP    165
            CALL UILOGC (JBLK)                                          UILOOP    166
C                                                                       UILOOP    167
         ELSEIF(IUDTYP(JBLK).EQ.MULTI)THEN                              UILOOP    168
            SNAME = SBMLTP(IUDSUB(JBLK))                                UILOOP    169
            CALL UIMLTP (JBLK)                                          UILOOP    170
C                                                                       UILOOP    171
         ELSEIF(IUDTYP(JBLK).EQ.IOTHER)THEN                             UILOOP    172
            SNAME = SBOTHR(IUDSUB(JBLK))                                UILOOP    173
            CALL UIOTHR (JBLK)                                          UILOOP    174
C                                                                       UILOOP    175
         ELSEIF(IUDTYP(JBLK).EQ.ISBLCK)THEN                             UILOOP    176
            SNAME = SBSBLK(IUDSUB(JBLK))                                UILOOP    177
            CALL UISBLK (JBLK)                                          UILOOP    178
C                                                                       UILOOP    179
         ELSEIF(IUDTYP(JBLK).EQ.ISETUP)THEN                             UILOOP    180
            SNAME = SBSETP(IUDSUB(JBLK))                                UILOOP    181
            CALL UISETP (JBLK)                                          UILOOP    182
C                                                                       UILOOP    183
         ELSEIF(IUDTYP(JBLK).EQ.ISOURC)THEN                             UILOOP    184
            SNAME = SBSRCE(IUDSUB(JBLK))                                UILOOP    185
            CALL UISRCE (JBLK)                                          UILOOP    186
C                                                                       UILOOP    187
         ELSEIF(IUDTYP(JBLK).EQ.ISUBSY)THEN                             UILOOP    188
            SNAME = SBSUBS(IUDSUB(JBLK))                                UILOOP    189
            CALL UISUBS (JBLK, OK)                                      UILOOP    190
C                                                                       UILOOP    191
         ELSEIF(IUDTYP(JBLK).EQ.IUNARY)THEN                             UILOOP    192
            SNAME = SBUNA(IUDSUB(JBLK))                                 UILOOP    193
            CALL UIUNA (JBLK)                                           UILOOP    194
C                                                                       UILOOP    195
         END IF                                                         UILOOP    196
C                                                                       UILOOP    197
C                                                                       UILOOP    198
         IF(LDEB)THEN                                                   UILOOP    199
            WRITE (FORMT,9002) ISKTAB, UDNAME(JBLK), TNAME, SNAME,      UILOOP    200
     1                          UDVAL(JBLK)                             UILOOP    201
            WRITE (IUD6,FORMT)                                          UILOOP    202
C                                                                       UILOOP    203
            I = 0                                                       UILOOP    204
            LINLEN = 0                                                  UILOOP    205
            NEXT = INTOP(JBLK)                                          UILOOP    206
            WRITE (FORMT,9004) ISKTAB                                   UILOOP    207
         END IF                                                         UILOOP    208
C                                                                       UILOOP    209
C                                                                       UILOOP    210
         POP = .TRUE.                                                   UILOOP    211
140      IF(.NOT.POP.OR.DONE) GO TO 160                                 UILOOP    212
            IF(LPSUBS(ISKLOP(ISKTOP)) .GT. 0)THEN                       UILOOP    213
               IF(OK)THEN                                               UILOOP    214
                  CALL SOLVSS (JBLK, JORDER, DONE, POP)                 UILOOP    215
               END IF                                                   UILOOP    216
            ELSE                                                        UILOOP    217
               CALL SOLVLP (JBLK, JORDER, DONE, POP)                    UILOOP    218
            END IF                                                      UILOOP    219
            GO TO 140                                                   UILOOP    220
160      CONTINUE                                                       UILOOP    221
         GOTO 60                                                        UILOOP    222
180   CONTINUE                                                          UILOOP    223
C                                                                       UILOOP    224
C---------------------------------------------------------------------  UILOOP    225
C                                                                       UILOOP    226
      RETURN                                                            UILOOP    227
C                                                                       UILOOP    228
C---------------------------------------------------------------------  UILOOP    229
C                                                                       UILOOP    230
9002  FORMAT ('(/, ', I3, 'X, ''BLOCK: ', A, 2X, 'TYPE: ', A, 2X,       UILOOP    231
     1        'SUBTYPE: ', A, 2X, 'VALUE: ', F12.3, ''')')              UILOOP    232
9004  FORMAT ('(', I3, 'X, ''INPUTS:  ** NONE **'')')                   UILOOP    233
9006  FORMAT ( 10 (A, 3X))                                              UILOOP    234
9008  FORMAT ('(', I3, 'X, ''INPUTS:  ', A, ''')')                      UILOOP    235
9010  FORMAT ('(', I3, 'X, ''         ', A, ''')')                      UILOOP    236
C                                                                       UILOOP    237
C---------------------------------------------------------------------  UILOOP    238
C                                                                       UILOOP    239
      END                                                               UILOOP    240
