CFPRIME URPRNT                                                          URPRNT      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  URPRNT (LABEL)                                        URPRNT      3
CD -------------------------------------------------------------------  URPRNT      4
CD                                                                      URPRNT      5
CD              *****     URPRNT  ROUTINE   *****                       URPRNT      6
CD                                                                      URPRNT      7
CD -------------------------------------------------------------------  URPRNT      8
CD                                                                      URPRNT      9
CD       PURPOSE:  Print the udc blocks with their input and output     URPRNT     10
CD                 linked lists.  Before solution order has been        URPRNT     11
CD                 determined, they are printed in input order.         URPRNT     12
CD                 After ordering is determined they are printed        URPRNT     13
CD                 in solution order.                                   URPRNT     14
CD                                                                      URPRNT     15
CD                                                                      URPRNT     16
CD       DEFINITION OF LOCAL VARIABLES:                                 URPRNT     17
CD                 BEFORE -  indicates before ordering has been         URPRNT     18
CD                           completed.                                 URPRNT     19
CD                 FIRST  -  flag used for output.                      URPRNT     20
CD                 I      - 'do' loop index.                            URPRNT     21
CD                 J      - 'do' loop index.                            URPRNT     22
CD                 K      - 'do' loop index.                            URPRNT     23
CD          (P)    LABEL  -  title for printed output.                  URPRNT     24
CD                 LEN    -  length of current udc block name.          URPRNT     25
CD                 LEN1   -  length of current udc block name.          URPRNT     26
CD                 LEN2   -  length of current udc block name.          URPRNT     27
CD                 LINLEN -  length of output line.                     URPRNT     28
CD                 N      - 'do' loop index.                            URPRNT     29
CD                 NEXT   -  current pointer in linked list.            URPRNT     30
CD                 NAME   -  list of block names.                       URPRNT     31
CD                 SNAME  -  udc subtype name.                          URPRNT     32
CD                 TNAME  -  udc type name.                             URPRNT     33
CD                                                                      URPRNT     34
CD -------------------------------------------------------------------  URPRNT     35
      INCLUDE 'CNFLAG.INS'                                              URPRNT     36
      INCLUDE 'PARX.INS'                                                URPRNT     37
      INCLUDE 'UDCA.INS'                                                URPRNT     38
      INCLUDE 'UDCB.INS'                                                URPRNT     39
      INCLUDE 'UDCD.INS'                                                URPRNT     40
      INCLUDE 'UDCE.INS'                                                URPRNT     41
      INCLUDE 'UDCH.INS'                                                URPRNT     42
C                                                                       URPRNT     43
      DIMENSION    LEN(10)                                              URPRNT     44
C                                                                       URPRNT     45
      LOGICAL       FIRST                                               URPRNT     46
C                                                                       URPRNT     47
      CHARACTER*(*) LABEL                                               URPRNT     48
      CHARACTER*17  NAME(10)                                            URPRNT     49
      CHARACTER*8   SNAME, TNAME                                        URPRNT     50
C                                                                       URPRNT     51
      LDEB=.FALSE.                                                      URPRNT     52
C---------------------------------------------------------------------  URPRNT     53
C                                                                       URPRNT     54
C     Print titles.                                                     URPRNT     55
C                                                                       URPRNT     56
      WRITE (IUD6,9002) LABEL                                           URPRNT     57
C                                                                       URPRNT     58
C     Print each block in the system.                                   URPRNT     59
C                                                                       URPRNT     60
      DO 100 J = 1, IUDC                                                URPRNT     61
         IF (.NOT. SOLN) THEN                                           URPRNT     62
            I = J                                                       URPRNT     63
         ELSE                                                           URPRNT     64
            I = IUDPRM(J)                                               URPRNT     65
         END IF                                                         URPRNT     66
C                                                                       URPRNT     67
         TNAME = TPNAME(IUDTYP(I))                                      URPRNT     68
C                                                                       URPRNT     69
         IF (IUDSUB(I) .EQ. 0) THEN                                     URPRNT     70
            SNAME = STARS                                               URPRNT     71
         ELSE                                                           URPRNT     72
            IF (IUDTYP(I) .EQ. IFRMAC) THEN                             URPRNT     73
               SNAME = SBFRAC(IUDSUB(I))                                URPRNT     74
            ELSE IF (IUDTYP(I) .EQ. IFRMDC) THEN                        URPRNT     75
               SNAME = SBFRDC(IUDSUB(I))                                URPRNT     76
            ELSE IF (IUDTYP(I) .EQ. ISOURC) THEN                        URPRNT     77
               SNAME = SBSRCE(IUDSUB(I))                                URPRNT     78
            ELSE IF (IUDTYP(I) .EQ. IUNARY) THEN                        URPRNT     79
               SNAME = SBUNA(IUDSUB(I))                                 URPRNT     80
            ELSE IF (IUDTYP(I) .EQ. IACSYS) THEN                        URPRNT     81
               SNAME = SBACSY(IUDSUB(I))                                URPRNT     82
            ELSE IF (IUDTYP(I) .EQ. IBINAR) THEN                        URPRNT     83
               SNAME = SBBIN(IUDSUB(I))                                 URPRNT     84
            ELSE IF (IUDTYP(I) .EQ. IBREAK) THEN                        URPRNT     85
               SNAME = SBBRKR(IUDSUB(I))                                URPRNT     86
            ELSE IF (IUDTYP(I) .EQ. IOTHER) THEN                        URPRNT     87
               SNAME = SBOTHR(IUDSUB(I))                                URPRNT     88
            ELSE IF (IUDTYP(I) .EQ. LIMITR) THEN                        URPRNT     89
               SNAME = SBLIMT(IUDSUB(I))                                URPRNT     90
            ELSE IF (IUDTYP(I) .EQ. ISBLCK) THEN                        URPRNT     91
               SNAME = SBSBLK(IUDSUB(I))                                URPRNT     92
            ELSE IF (IUDTYP(I) .EQ. MULTI) THEN                         URPRNT     93
               SNAME = SBMLTP(IUDSUB(I))                                URPRNT     94
            ELSE IF (IUDTYP(I) .EQ. INTERF) THEN                        URPRNT     95
               SNAME = ' '                                              URPRNT     96
            ELSE IF (IUDTYP(I) .EQ. ISETUP) THEN                        URPRNT     97
               SNAME = SBSETP(IUDSUB(I))                                URPRNT     98
            ELSE IF (IUDTYP(I) .EQ. ISUBSY) THEN                        URPRNT     99
               SNAME = SBSUBS(IUDSUB(I))                                URPRNT    100
            ELSE IF (IUDTYP(I) .EQ. LOGIC) THEN                         URPRNT    101
               SNAME = SBLOGC(IUDSUB(I))                                URPRNT    102
            ELSE IF (IUDTYP(I) .EQ. IFRTRA) THEN                        URPRNT    103
               SNAME = SBFORT(IUDSUB(I))                                URPRNT    104
            ELSE                                                        URPRNT    105
               SNAME = STARS                                            URPRNT    106
            END IF                                                      URPRNT    107
         END IF                                                         URPRNT    108
C                                                                       URPRNT    109
         IF (.NOT. SOLN) THEN                                           URPRNT    110
            WRITE (IUD6,9004) UDNAME(I), TNAME, SNAME, IUDINV(I)        URPRNT    111
         ELSE                                                           URPRNT    112
            WRITE (IUD6,9006) UDNAME(I), TNAME, SNAME                   URPRNT    113
         END IF                                                         URPRNT    114
C                                                                       URPRNT    115
         NEXT = INTOP(I)                                                URPRNT    116
         FIRST = .TRUE.                                                 URPRNT    117
         K = 0                                                          URPRNT    118
         LINLEN = 0                                                     URPRNT    119
20       IF (NEXT .EQ. 0) GO TO 40                                      URPRNT    120
            IF (K .GE. 10 .OR. LINLEN .GT. 100) THEN                    URPRNT    121
               IF (FIRST) THEN                                          URPRNT    122
                  WRITE (IUD6,9008) (NAME(N)(1:LEN(N)), N = 1, K)       URPRNT    123
                  FIRST = .FALSE.                                       URPRNT    124
               ELSE                                                     URPRNT    125
                  WRITE (IUD6,9010) (NAME(N)(1:LEN(N)), N = 1, K)       URPRNT    126
               END IF                                                   URPRNT    127
               K = 0                                                    URPRNT    128
               LINLEN = 0                                               URPRNT    129
            ELSE                                                        URPRNT    130
               K = K + 1                                                URPRNT    131
               NAME(K) = UDNAME(INNUM(NEXT))                            URPRNT    132
               LEN(K) = IUDLEN(INNUM(NEXT))                             URPRNT    133
               LINLEN = LINLEN + LEN(K)                                 URPRNT    134
               NEXT = IPOINT(NEXT)                                      URPRNT    135
            END IF                                                      URPRNT    136
            GO TO 20                                                    URPRNT    137
40       CONTINUE                                                       URPRNT    138
         IF (FIRST) THEN                                                URPRNT    139
            IF (K .EQ. 0) THEN                                          URPRNT    140
               WRITE (IUD6,9012)                                        URPRNT    141
            ELSE                                                        URPRNT    142
               WRITE (IUD6,9008) (NAME(N)(1:LEN(N)), N = 1, K)          URPRNT    143
            END IF                                                      URPRNT    144
         ELSE                                                           URPRNT    145
            WRITE (IUD6,9010) (NAME(N)(1:LEN(N)), N = 1, K)             URPRNT    146
         END IF                                                         URPRNT    147
C                                                                       URPRNT    148
         NEXT = IOUTOP(I)                                               URPRNT    149
         FIRST = .TRUE.                                                 URPRNT    150
         K = 0                                                          URPRNT    151
         LINLEN = 0                                                     URPRNT    152
60       IF (NEXT .EQ. 0) GO TO 80                                      URPRNT    153
            IF (K .GE. 10 .OR. LINLEN .GT. 100) THEN                    URPRNT    154
               IF (FIRST) THEN                                          URPRNT    155
                  WRITE (IUD6,9014) (NAME(N)(1:LEN(N)), N = 1, K)       URPRNT    156
                  FIRST = .FALSE.                                       URPRNT    157
               ELSE                                                     URPRNT    158
                  WRITE (IUD6,9010) (NAME(N)(1:LEN(N)), N = 1, K)       URPRNT    159
               END IF                                                   URPRNT    160
               K = 0                                                    URPRNT    161
               LINLEN = 0                                               URPRNT    162
            ELSE                                                        URPRNT    163
               K = K + 1                                                URPRNT    164
               NAME(K) = UDNAME(IOUTNU(NEXT))                           URPRNT    165
               LEN(K) = IUDLEN(IOUTNU(NEXT))                            URPRNT    166
               LINLEN = LINLEN + LEN(K)                                 URPRNT    167
               NEXT = JOPOIN(NEXT)                                      URPRNT    168
            END IF                                                      URPRNT    169
            GO TO 60                                                    URPRNT    170
80       CONTINUE                                                       URPRNT    171
         IF (FIRST) THEN                                                URPRNT    172
            IF (K .EQ. 0) THEN                                          URPRNT    173
               WRITE (IUD6,9016)                                        URPRNT    174
            ELSE                                                        URPRNT    175
               WRITE (IUD6,9014) (NAME(N)(1:LEN(N)), N = 1, K)          URPRNT    176
            END IF                                                      URPRNT    177
         ELSE                                                           URPRNT    178
            WRITE (IUD6,9010) (NAME(N)(1:LEN(N)), N = 1, K)             URPRNT    179
         END IF                                                         URPRNT    180
100   CONTINUE                                                          URPRNT    181
C                                                                       URPRNT    182
      NEXT = IFXSUB                                                     URPRNT    183
120   IF (NEXT .EQ. 0) GO TO 140                                        URPRNT    184
         LEN1 = IUDLEN(IFXNUM(NEXT))                                    URPRNT    185
         LEN2 = IUDLEN(JFXNUM(NEXT))                                    URPRNT    186
         WRITE (IUD6,9018) FXNAM1(NEXT)(1:LEN1), FXNAM2(NEXT)(1:LEN2),  URPRNT    187
     1                      FXNAM1(NEXT)(1:LEN1), FXNAM2(NEXT)(1:LEN2)  URPRNT    188
         NEXT = IFXNEX(NEXT)                                            URPRNT    189
         GO TO 120                                                      URPRNT    190
140   CONTINUE                                                          URPRNT    191
C                                                                       URPRNT    192
      IF (SOLN) THEN                                                    URPRNT    193
         CALL URPTLP                                                    URPRNT    194
      END IF                                                            URPRNT    195
C                                                                       URPRNT    196
C---------------------------------------------------------------------  URPRNT    197
C                                                                       URPRNT    198
      RETURN                                                            URPRNT    199
C                                                                       URPRNT    200
C---------------------------------------------------------------------  URPRNT    201
C                                                                       URPRNT    202
9002  FORMAT (///, '1', 20X, A50, /)                                    URPRNT    203
9004  FORMAT (/, ' ', A, 10X, A, 2X, A, 10X, 'SOLUTION ORDER:  ',       URPRNT    204
     1        I3)                                                       URPRNT    205
9006  FORMAT (/, ' ', A, 10X, A, 2X, A, 10X)                            URPRNT    206
9008  FORMAT (' ', 5X, 'INPUT BLOCKS:   ', 10 (A, 3X))                  URPRNT    207
9010  FORMAT (' ', 21X, 10 (A, 3X))                                     URPRNT    208
9012  FORMAT (' ', 5X, 'INPUT BLOCKS:   **NONE**')                      URPRNT    209
9014  FORMAT (' ', 5X, 'OUTPUT BLOCKS:  ', 10 (A, 3X))                  URPRNT    210
9016  FORMAT (' ', 5X, 'OUTPUT BLOCKS:  **NONE**')                      URPRNT    211
9018  FORMAT (///, ' * NOTE:  SUBSYTEM FROM "', A, '" TO "', A,         URPRNT    212
     1        '" IS ', /, 10X, 'REPRESENTED AS A LOOP FROM "', A,       URPRNT    213
     2        '" TO "', A, '".', //)                                    URPRNT    214
C                                                                       URPRNT    215
C---------------------------------------------------------------------  URPRNT    216
C                                                                       URPRNT    217
      END                                                               URPRNT    218
