CFPRIME URLOOP                                                          URLOOP      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  URLOOP (END1, END2, LSTOP)                            URLOOP      3
CD -------------------------------------------------------------------  URLOOP      4
CD                                                                      URLOOP      5
CD              *****     URLOOP  ROUTINE   *****                       URLOOP      6
CD                                                                      URLOOP      7
CD -------------------------------------------------------------------  URLOOP      8
CD                                                                      URLOOP      9
CD       PURPOSE:  Ordering of the blocks was unable to continue,       URLOOP     10
CD                 this routine attempts to find the loop that          URLOOP     11
CD                 is preventing the ordering process from continuing.  URLOOP     12
CD                                                                      URLOOP     13
CD                                                                      URLOOP     14
CD       DEFINITION OF LOCAL VARIABLES:                                 URLOOP     15
CD                 JBLK    -  current udc block.                        URLOOP     16
CD                 LEAD   -  block number which points to a possible    URLOOP     17
CD                           loop.                                      URLOOP     18
CD                 BNAME  -  list of block names.                       URLOOP     19
CD                 JCOUN  -  counts the number of udc blocks examined.  URLOOP     20
CD          (P)    END1   -  first block name in loop.                  URLOOP     21
CD          (P)    END2   -  last block name in loop.                   URLOOP     22
CD                 FOUND  -  indicates if any loop was found.           URLOOP     23
CD                 FIND   -  indicates if a pointer to start of loop    URLOOP     24
CD                           was found.                                 URLOOP     25
CD                 J      - 'do' loop index.                            URLOOP     26
CD                 K      - 'do' loop index.                            URLOOP     27
CD                 LABEL  -  title used for printing.                   URLOOP     28
CD                 LEN    -  list of block name lengths.                URLOOP     29
CD                 LEN1   -  length of first udc block name.            URLOOP     30
CD                 LEN2   -  length of second udc block name.           URLOOP     31
CD                 LINK   -  points to next entry on linked list.       URLOOP     32
CD                 LINLEN -  length of output line.                     URLOOP     33
CD                 N      - 'do' loop index.                            URLOOP     34
CD                 NEW    -  new entry for loop list.                   URLOOP     35
CD                 NEXT   -  points to next entry on linked list.       URLOOP     36
CD                 LOLD   -  last name in loop.                         URLOOP     37
CD                 LONE   -  first block number in loop.                URLOOP     38
CD                 LPTR   -  points to a possible loop.                 URLOOP     39
CD                 LOOP   -  indicates the right loop was found.        URLOOP     40
CD          (P)    LSTOP  -  unable to order udc system.                URLOOP     41
CD                 SUBNAM -  subroutine name.                           URLOOP     42
CD                 T1     -  first block of loop.                       URLOOP     43
CD                 T2     -  last block of loop.                        URLOOP     44
CD                 ITOP   -  first block in the loop.                   URLOOP     45
CD                 LTWO   -  last block number in loop.                 URLOOP     46
CD                                                                      URLOOP     47
CD -------------------------------------------------------------------  URLOOP     48
      INCLUDE 'CNUNIT.INS'                                              URLOOP     49
      INCLUDE 'CNMSG.INS'                                               URLOOP     50
      INCLUDE 'PARX.INS'                                                URLOOP     51
      INCLUDE 'UDCA.INS'                                                URLOOP     52
      INCLUDE 'UDCB.INS'                                                URLOOP     53
      INCLUDE 'UDCD.INS'                                                URLOOP     54
      INCLUDE 'UDCE.INS'                                                URLOOP     55
      INCLUDE 'UDCH.INS'                                                URLOOP     56
      INCLUDE 'CNFLAG.INS'                                              URLOOP     57
C                                                                       URLOOP     58
      DIMENSION       LEN(10)                                           URLOOP     59
C                                                                       URLOOP     60
      LOGICAL       LSTOP, FIND, FOUND, IGNORE, LOOP,LDEB1,LDEB2        URLOOP     61
C                                                                       URLOOP     62
      CHARACTER*50  LABEL                                               URLOOP     63
      CHARACTER*20  SUBNAM                                              URLOOP     64
      CHARACTER*17  BNAME(10), END1, END2, T1, T2                       URLOOP     65
C                                                                       URLOOP     66
C---------------------------------------------------------------------  URLOOP     67
C                                                                       URLOOP     68
      LDEB=(JDEB(302).NE.0)                                             URLOOP     69
      LDEB1=(JDEB(305).NE.0)                                            URLOOP     70
      LDEB2=(JDEB(310).NE.0)                                            URLOOP     71
C                                                                       URLOOP     72
      IF(SDBG)THEN                                                      URLOOP     73
         SUBNAM = 'URLOOP ROUTINE.'                                     URLOOP     74
      ELSE                                                              URLOOP     75
         SUBNAM = ' '                                                   URLOOP     76
      END IF                                                            URLOOP     77
C                                                                       URLOOP     78
C                                                                       URLOOP     79
C     Recreate the input/output linked lists for the full udc system.   URLOOP     80
C     Reduce the system, to remove all blocks not needed to find        URLOOP     81
C     a loop.                                                           URLOOP     82
C                                                                       URLOOP     83
      CALL URLIST                                                       URLOOP     84
      CALL REDLP                                                        URLOOP     85
C                                                                       URLOOP     86
      LSTOP = .FALSE.                                                   URLOOP     87
C                                                                       URLOOP     88
C                                                                       URLOOP     89
C     Look for a "leading" block which might indicate where the         URLOOP     90
C     possible loop begins.                                             URLOOP     91
C                                                                       URLOOP     92
      LEAD = 1                                                          URLOOP     93
      FIND = .FALSE.                                                    URLOOP     94
 20   IF(FIND .OR. LEAD .GT. IUDC) GOTO 40                              URLOOP     95
         IF(INTOP(LEAD).EQ.0.AND.IOUTOP(LEAD) .NE. 0)THEN               URLOOP     96
C                                                                       URLOOP     97
C           Found a "leading" block for a possible loop.                URLOOP     98
C                                                                       URLOOP     99
            LPTR = IOUTOP(LEAD)                                         URLOOP    100
            FIND = .TRUE.                                               URLOOP    101
         ELSE                                                           URLOOP    102
            LEAD = LEAD + 1                                             URLOOP    103
         END IF                                                         URLOOP    104
         GOTO 20                                                        URLOOP    105
 40    CONTINUE                                                         URLOOP    106
C                                                                       URLOOP    107
C                                                                       URLOOP    108
      IF(.NOT. FIND)THEN                                                URLOOP    109
C                                                                       URLOOP    110
C        Unable to find a "leading" block, look for a block that might  URLOOP    111
C        be the first bock in a possible loop.                          URLOOP    112
C                                                                       URLOOP    113
         LEAD = 0                                                       URLOOP    114
         FIND = .FALSE.                                                 URLOOP    115
         INPUT = 1                                                      URLOOP    116
 60      IF(FIND .OR. INPUT .GT. IUDC) GOTO 80                          URLOOP    117
            IF(IUDINV(INPUT).EQ.0)THEN                                  URLOOP    118
               ITOP = INPUT                                             URLOOP    119
               FIND = .TRUE.                                            URLOOP    120
            ELSE                                                        URLOOP    121
               INPUT = INPUT + 1                                        URLOOP    122
            END IF                                                      URLOOP    123
            GOTO 60                                                     URLOOP    124
 80      CONTINUE                                                       URLOOP    125
C                                                                       URLOOP    126
         IF(.NOT. FIND)THEN                                             URLOOP    127
C                                                                       URLOOP    128
C           Unable to find any loop in this udc system.                 URLOOP    129
C                                                                       URLOOP    130
            INPUT = 0                                                   URLOOP    131
            LSTOP = .TRUE.                                              URLOOP    132
         END IF                                                         URLOOP    133
      END IF                                                            URLOOP    134
C                                                                       URLOOP    135
C                                                                       URLOOP    136
C                                                                       URLOOP    137
C     Search until a loop is found that begins with the specified       URLOOP    138
C     first block, or an error is found.                                URLOOP    139
C                                                                       URLOOP    140
      LOOP = .FALSE.                                                    URLOOP    141
100   IF(LOOP .OR. LSTOP) GOTO 300                                      URLOOP    142
C                                                                       URLOOP    143
         IF(LDEB2)THEN                                                  URLOOP    144
            LABEL = '***   LOOKING FOR A LOOP   ***'                    URLOOP    145
            CALL URPRNT (LABEL)                                         URLOOP    146
         END IF                                                         URLOOP    147
C                                                                       URLOOP    148
C                                                                       URLOOP    149
         IF(LEAD .NE. 0)THEN                                            URLOOP    150
            ITOP = IOUTNU(LPTR)                                         URLOOP    151
         END IF                                                         URLOOP    152
C                                                                       URLOOP    153
C        Add a new link to the loop linked list.                        URLOOP    154
C                                                                       URLOOP    155
         LPMAX = LPMAX + 1                                              URLOOP    156
         NEW = LPFREE                                                   URLOOP    157
         IF(NEW.EQ.0)THEN                                               URLOOP    158
            WRITE (MSG(1),9000) SUBNAM                                  URLOOP    159
            WRITE(MSG(2),9001)                                          URLOOP    160
            WRITE(MSG(3),9002)                                          URLOOP    161
            WRITE(MSG(4),9003)                                          URLOOP    162
            CALL PRTMSG(4)                                              URLOOP    163
            CALL URPTLP                                                 URLOOP    164
            MSG(1)='TERMINATED DUE TO UDC ARRAY DIMENSIONS'             URLOOP    165
            CALL ASTOP(MSG(1),38)                                       URLOOP    166
         END IF                                                         URLOOP    167
         LPFREE = LPNEXT(LPFREE)                                        URLOOP    168
         LPTOP(LPMAX) = NEW                                             URLOOP    169
         LPLEAD(LPMAX) = LEAD                                           URLOOP    170
         LPNEXT(NEW) = 0                                                URLOOP    171
         LPNAME(NEW) = UDNAME(ITOP)                                     URLOOP    172
         LPNUM(NEW) = ITOP                                              URLOOP    173
         IF(LDEB2 .OR. (LDEB1.AND.LDEB))THEN                            URLOOP    174
            IF(LEAD.EQ.0)THEN                                           URLOOP    175
               LEN1 = IUDLEN(ITOP)                                      URLOOP    176
               WRITE (IUD6,9004) SUBNAM, UDNAME(ITOP)(1:LEN1)           URLOOP    177
            ELSE                                                        URLOOP    178
               LEN1 = IUDLEN(LEAD)                                      URLOOP    179
               LEN2 = IUDLEN(ITOP)                                      URLOOP    180
               WRITE (IUD6,9006) SUBNAM, UDNAME(LEAD)(1:LEN1),          URLOOP    181
     1                            UDNAME(ITOP)(1:LEN2)                  URLOOP    182
            END IF                                                      URLOOP    183
         END IF                                                         URLOOP    184
C                                                                       URLOOP    185
         JCOUN = 1                                                      URLOOP    186
         END1 = UDNAME(ITOP)                                            URLOOP    187
         END2 = END1                                                    URLOOP    188
         JBLK = 0                                                       URLOOP    189
C                                                                       URLOOP    190
C        Continue traversing the udc system, until the pointer is       URLOOP    191
C        null, or a loop is found.                                      URLOOP    192
C                                                                       URLOOP    193
         NEXT = IOUTOP(ITOP)                                            URLOOP    194
         FOUND = .FALSE.                                                URLOOP    195
         IGNORE = .FALSE.                                               URLOOP    196
 120     IF(NEXT.EQ.0 .OR. FOUND) GOTO 200                              URLOOP    197
            JCOUN = JCOUN + 1                                           URLOOP    198
            JBLK = IOUTNU(NEXT)                                         URLOOP    199
C                                                                       URLOOP    200
            IF(JBLK.EQ.ITOP)THEN                                        URLOOP    201
C                                                                       URLOOP    202
C              Right loop found.                                        URLOOP    203
C                                                                       URLOOP    204
               FOUND = .TRUE.                                           URLOOP    205
               LOOP = .TRUE.                                            URLOOP    206
               JCOUN = JCOUN - 1                                        URLOOP    207
C                                                                       URLOOP    208
            ELSE                                                        URLOOP    209
C                                                                       URLOOP    210
C              Check that there is no inner loop.                       URLOOP    211
C                                                                       URLOOP    212
               LINK = LPTOP(LPMAX)                                      URLOOP    213
 140           IF(LINK.EQ.0) GOTO 160                                   URLOOP    214
                  IF(LPNAME(LINK).EQ.UDNAME(JBLK))THEN                  URLOOP    215
                     T1 = LPNAME(LINK)                                  URLOOP    216
                     T2 = T1                                            URLOOP    217
                     FOUND = .TRUE.                                     URLOOP    218
                  ELSE                                                  URLOOP    219
                     T2 = LPNAME(LINK)                                  URLOOP    220
                  END IF                                                URLOOP    221
                  LINK = LPNEXT(LINK)                                   URLOOP    222
                  GOTO 140                                              URLOOP    223
 160           CONTINUE                                                 URLOOP    224
C                                                                       URLOOP    225
               IF(FOUND)THEN                                            URLOOP    226
C                                                                       URLOOP    227
C                 Ignore inner loop.                                    URLOOP    228
C                                                                       URLOOP    229
                  IGNORE = .TRUE.                                       URLOOP    230
                  LONE = 0                                              URLOOP    231
                  LTWO = 0                                              URLOOP    232
                  DO 180 N = 1, IUDC                                    URLOOP    233
                     IF(UDNAME(N).EQ.T1) LONE = N                       URLOOP    234
                     IF(UDNAME(N).EQ.T2) LTWO = N                       URLOOP    235
 180              CONTINUE                                              URLOOP    236
                  CALL BREAK (LONE, LTWO)                               URLOOP    237
                  IF(LDEB2 .OR. (LDEB.AND.LDEB1))THEN                   URLOOP    238
                     WRITE (IUD6,9008) SUBNAM, T1, T2                   URLOOP    239
                  END IF                                                URLOOP    240
C                                                                       URLOOP    241
                  CALL CLRLP                                            URLOOP    242
                  CALL REDLP                                            URLOOP    243
                  END1 = STARS                                          URLOOP    244
                  END2 = STARS                                          URLOOP    245
C                                                                       URLOOP    246
               ELSE                                                     URLOOP    247
C                                                                       URLOOP    248
C                 Continue looking for a loop.                          URLOOP    249
C                                                                       URLOOP    250
                  END2 = UDNAME(JBLK)                                   URLOOP    251
                  LOLD = NEW                                            URLOOP    252
                  NEW = LPFREE                                          URLOOP    253
                  IF(NEW.EQ.0)THEN                                      URLOOP    254
            WRITE (MSG(1),9000) SUBNAM                                  URLOOP    255
            WRITE(MSG(2),9001)                                          URLOOP    256
            WRITE(MSG(3),9002)                                          URLOOP    257
            WRITE(MSG(4),9003)                                          URLOOP    258
            CALL PRTMSG(4)                                              URLOOP    259
                  CALL URPTLP                                           URLOOP    260
                  MSG(1)='TERMINATED DUE TO UDC ARRAY DIMENSIONS'       URLOOP    261
                  CALL ASTOP(MSG(1),38)                                 URLOOP    262
                  ENDIF                                                 URLOOP    263
                  LPFREE = LPNEXT(LPFREE)                               URLOOP    264
                  LPNEXT(LOLD) = NEW                                    URLOOP    265
                  LPNEXT(NEW) = 0                                       URLOOP    266
                  LPNAME(NEW) = UDNAME(JBLK)                            URLOOP    267
                  LPNUM(NEW) = JBLK                                     URLOOP    268
                  NEXT = IOUTOP(JBLK)                                   URLOOP    269
                  IF(JCOUN .GT. IUDC) NEXT = 0                          URLOOP    270
               END IF                                                   URLOOP    271
            END IF                                                      URLOOP    272
            GOTO 120                                                    URLOOP    273
200      CONTINUE                                                       URLOOP    274
C                                                                       URLOOP    275
C                                                                       URLOOP    276
C        The length of the loop is longer than the number of blocks     URLOOP    277
C        available.  Something is wrong with the loop.                  URLOOP    278
C                                                                       URLOOP    279
         IF(JCOUN .GT. IUDC)  THEN                                      URLOOP    280
            LSTOP = .TRUE.                                              URLOOP    281
         END IF                                                         URLOOP    282
C                                                                       URLOOP    283
         IF(IGNORE)THEN                                                 URLOOP    284
C                                                                       URLOOP    285
C           Repeat search using same leading block.                     URLOOP    286
C                                                                       URLOOP    287
            FOUND = .FALSE.                                             URLOOP    288
C                                                                       URLOOP    289
         ELSEIF(.NOT. FOUND)THEN                                        URLOOP    290
C                                                                       URLOOP    291
C           Check that this block might point to another possible       URLOOP    292
C           loop.                                                       URLOOP    293
C                                                                       URLOOP    294
            CALL CLRLP                                                  URLOOP    295
            IF(LEAD .NE. 0)THEN                                         URLOOP    296
               IF(LPTR.EQ.IOUTOP(LEAD))THEN                             URLOOP    297
                  LPTR = JOPOIN(LPTR)                                   URLOOP    298
               ELSE                                                     URLOOP    299
                  LPTR = 0                                              URLOOP    300
               END IF                                                   URLOOP    301
C                                                                       URLOOP    302
               IF(LPTR.EQ.0)THEN                                        URLOOP    303
C                                                                       URLOOP    304
C                 If no possible loops can be found with this block,    URLOOP    305
C                 search for another block which points to a possible   URLOOP    306
C                 loop.                                                 URLOOP    307
C                                                                       URLOOP    308
C                 Reduce the system, to remove all blocks not needed    URLOOP    309
C                 to find a loop.                                       URLOOP    310
C                                                                       URLOOP    311
                  CALL REDLP                                            URLOOP    312
C                                                                       URLOOP    313
                  FIND = .FALSE.                                        URLOOP    314
                  LEAD = LEAD + 1                                       URLOOP    315
 220              IF(FIND .OR. LEAD .GT. IUDC) GOTO 240                 URLOOP    316
                     IF(INTOP(LEAD).EQ.0.AND.                           URLOOP    317
     1                   IOUTOP(LEAD) .NE. 0)THEN                       URLOOP    318
                        FIND = .TRUE.                                   URLOOP    319
                        LPTR = IOUTOP(LEAD)                             URLOOP    320
                     ELSE                                               URLOOP    321
                        LEAD = LEAD + 1                                 URLOOP    322
                     END IF                                             URLOOP    323
                     GOTO 220                                           URLOOP    324
 240              CONTINUE                                              URLOOP    325
                  IF(.NOT. FIND)THEN                                    URLOOP    326
                     LEAD = 0                                           URLOOP    327
                     INPUT = 0                                          URLOOP    328
                  END IF                                                URLOOP    329
               END IF                                                   URLOOP    330
            END IF                                                      URLOOP    331
C                                                                       URLOOP    332
            IF(LEAD.EQ.0)THEN                                           URLOOP    333
               INPUT = INPUT + 1                                        URLOOP    334
               FIND = .FALSE.                                           URLOOP    335
 260           IF(FIND .OR. INPUT .GT. IUDC) GOTO 280                   URLOOP    336
                  IF(IUDINV(INPUT).EQ.0)THEN                            URLOOP    337
                     FIND = .TRUE.                                      URLOOP    338
                     ITOP = INPUT                                       URLOOP    339
                  ELSE                                                  URLOOP    340
                     INPUT = INPUT + 1                                  URLOOP    341
                  END IF                                                URLOOP    342
                  GOTO 260                                              URLOOP    343
 280           CONTINUE                                                 URLOOP    344
C                                                                       URLOOP    345
               IF(.NOT. FIND)THEN                                       URLOOP    346
C                                                                       URLOOP    347
C                 No possible loop exists in this udc system, as        URLOOP    348
C                 defined.                                              URLOOP    349
C                                                                       URLOOP    350
                   LSTOP = .TRUE.                                       URLOOP    351
                   CALL CLRLP                                           URLOOP    352
                   END1 = STARS                                         URLOOP    353
                   END2 = STARS                                         URLOOP    354
               END IF                                                   URLOOP    355
            END IF                                                      URLOOP    356
         END IF                                                         URLOOP    357
         GOTO 100                                                       URLOOP    358
300   CONTINUE                                                          URLOOP    359
C                                                                       URLOOP    360
C                                                                       URLOOP    361
      IF(LSTOP)THEN                                                     URLOOP    362
         LABEL = ' *** UNABLE TO ORDER UDC BLOCKS'                      URLOOP    363
         IF(LDEB2)THEN                                                  URLOOP    364
            CALL URPRNT (LABEL)                                         URLOOP    365
C                                                                       URLOOP    366
         ELSEIF(.NOT. LDEB)THEN                                         URLOOP    367
            MSG(1)=LABEL                                                URLOOP    368
            CALL PRTMSG(1)                                              URLOOP    369
            IF(LPMAX .GT. 0)THEN                                        URLOOP    370
               CALL URPTLP                                              URLOOP    371
            END IF                                                      URLOOP    372
         END IF                                                         URLOOP    373
C                                                                       URLOOP    374
C        Determine which blocks are not ordered.                        URLOOP    375
C                                                                       URLOOP    376
         WRITE (MSG(1),9012)                                            URLOOP    377
         CALL PRTMSG(1)                                                 URLOOP    378
         J = 0                                                          URLOOP    379
         LINLEN = 0                                                     URLOOP    380
         DO 320 JBLK = 1, IUDC                                          URLOOP    381
            IF(IUDINV(JBLK).EQ.0)THEN                                   URLOOP    382
               IF(J .GE. 6 .OR. LINLEN .GT. 72)THEN                     URLOOP    383
                  WRITE (MSG(1),9014) (BNAME(K)(1:LEN(K)), K = 1, J)    URLOOP    384
                  CALL PRTMSG(1)                                        URLOOP    385
                  J = 0                                                 URLOOP    386
                  LINLEN = 0                                            URLOOP    387
               END IF                                                   URLOOP    388
               J = J + 1                                                URLOOP    389
               BNAME(J) = UDNAME(JBLK)                                  URLOOP    390
               LEN(J) = IUDLEN(JBLK)                                    URLOOP    391
               LINLEN = LINLEN + LEN(J)                                 URLOOP    392
            END IF                                                      URLOOP    393
320      CONTINUE                                                       URLOOP    394
         IF(J .NE. 0)THEN                                               URLOOP    395
                  WRITE (MSG(1),9014) (BNAME(K)(1:LEN(K)), K = 1, J)    URLOOP    396
                  CALL PRTMSG(1)                                        URLOOP    397
         END IF                                                         URLOOP    398
C                                                                       URLOOP    399
         WRITE (MSG(1),9000) SUBNAM                                     URLOOP    400
         WRITE(MSG(2),9016)                                             URLOOP    401
         WRITE(MSG(3),9017)                                             URLOOP    402
         WRITE(MSG(4),9018)                                             URLOOP    403
         WRITE(MSG(5),9019)                                             URLOOP    404
         CALL PRTMSG(5)                                                 URLOOP    405
         IERCNT = IERCNT + 1                                            URLOOP    406
C                                                                       URLOOP    407
      END IF                                                            URLOOP    408
                                                                        URLOOP    409
C                                                                       URLOOP    410
C---------------------------------------------------------------------  URLOOP    411
C                                                                       URLOOP    412
      RETURN                                                            URLOOP    413
C                                                                       URLOOP    414
C---------------------------------------------------------------------  URLOOP    415
C                                                                       URLOOP    416
9000  FORMAT(' *** MTDC ERROR', 5X, A)                                  URLOOP    417
9001  FORMAT(11X,'THE MAXIMUM STORAGE FOR THE LOOP LINKED LIST'         URLOOP    418
     *,' HAS BEEN EXCEEDED.')                                           URLOOP    419
9002  FORMAT(11X                                                        URLOOP    420
     *,'TO CHANGE THE SIZE OF THIS LIST, CHANGE THE VALUE OF')          URLOOP    421
9003  FORMAT(11X,'PARAMETER, NUDC5, FOUND IN INCLUDE PARX.')            URLOOP    422
9004  FORMAT (/, ' *** MTDC COMMENT ***', 5X, A, /, 18X,                URLOOP    423
     1        'BLOCK "', A, '" MIGHT BE THE FIRST BLOCK IN A LOOP.')    URLOOP    424
9006  FORMAT (/, ' *** COMMENT ***', 5X, A, /, 18X,                     URLOOP    425
     1        'BLOCK "', A, '" POINTS TO A POSSIBLE LOOP BEGINNING',    URLOOP    426
     2        /, 18X, 'WITH BLOCK "', A, '".')                          URLOOP    427
9008  FORMAT(' *** MTDC COMMENT ***', 5X, A, /, 18X,                    URLOOP    428
     1        'DURING THE ORDERING OF THE UDC BLOCKS, ANOTHER ',        URLOOP    429
     2        'LOOP FROM', /, 18X, '"', A, '" TO "', A, '" WAS ',       URLOOP    430
     3        'FOUND.  THIS', /, 18X, 'LOOP WILL BE IGNORED ',          URLOOP    431
     4        'TEMPORARILY.')                                           URLOOP    432
9012  FORMAT (' *** UNORDERED BLOCKS ARE:')                             URLOOP    433
9014  FORMAT (1X, 10 (A, 3X))                                           URLOOP    434
9016  FORMAT(11X,'DURING THE ORDERING OF THE UDC BLOCKS, THE PROGRAM ', URLOOP    435
     2        'WAS')                                                    URLOOP    436
9017  FORMAT(11X,'UNABLE TO DETERMINE THE FIRST BLOCK ',                URLOOP    437
     3        'OF A LOOP.  THE')                                        URLOOP    438
9018  FORMAT(11X,'ORDERING PROCESS IS ',                                URLOOP    439
     4        'STOPPED.  CHECK THAT YOUR UDC SYSTEM')                   URLOOP    440
9019  FORMAT(11X,'IS VALID.')                                           URLOOP    441
C                                                                       URLOOP    442
C---------------------------------------------------------------------  URLOOP    443
C                                                                       URLOOP    444
      END                                                               URLOOP    445
