CFPRIME CKSUBS                                                          CKSUBS      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  CKSUBS (END1, END2, FOUND)                            CKSUBS      3
CD -------------------------------------------------------------------  CKSUBS      4
CD                                                                      CKSUBS      5
CD              *****     CKSUBS  ROUTINE   *****                       CKSUBS      6
CD                                                                      CKSUBS      7
CD -------------------------------------------------------------------  CKSUBS      8
CD                                                                      CKSUBS      9
CD       PURPOSE:  Checks to see if the loop from END1 to END2 is reallyCKSUBS     10
CD                 a subsystem.  If it is the loop is ordered so that   CKSUBS     11
CD                 the first block of the subsystem is the first block  CKSUBS     12
CD                 of the loop and the last block of the subsystem is   CKSUBS     13
CD                 the last block of the loop.                          CKSUBS     14
CD                                                                      CKSUBS     15
CD                                                                      CKSUBS     16
CD       DEFINITION OF LOCAL VARIABLES:                                 CKSUBS     17
CD                 BNAME  -  block names used for printing.             CKSUBS     18
CD          (P)    END1   -  first block of subsystem.                  CKSUBS     19
CD          (P)    END2   -  last block of subsystem.                   CKSUBS     20
CD                 FIRST  -  flag indicating first block of subsystem   CKSUBS     21
CD                           was found.                                 CKSUBS     22
CD          (P)    FOUND  -  flag indicating the subsystem was found.   CKSUBS     23
CD                 J      -  counter used for printing.                 CKSUBS     24
CD                 K      - 'do' loop index.                            CKSUBS     25
CD                 LAST   -  flag indicating last block of subsystem    CKSUBS     26
CD                           was found.                                 CKSUBS     27
CD                 LEN    -  length of block names used for printing.   CKSUBS     28
CD                 LINK   -  pointer in the loop list.                  CKSUBS     29
CD                 LINLEN -  length of output line.                     CKSUBS     30
CD                 NEXT   -  pointer to the subsystem list.             CKSUBS     31
CD                 ORDER  -  flag indicating loop order should be       CKSUBS     32
CD                           changed.                                   CKSUBS     33
CD                 JPFIRS -  pointer to the first block of this         CKSUBS     34
CD                           subsystem.                                 CKSUBS     35
CD                 JPLAST  -  pointer to the last block of this         CKSUBS     36
CD                           subsystem.                                 CKSUBS     37
CD                 JSAVE   -  saved pointer to first block of the loop. CKSUBS     38
CD                 SUBNAM -  subroutine name.                           CKSUBS     39
CD                                                                      CKSUBS     40
CD -------------------------------------------------------------------  CKSUBS     41
      INCLUDE 'CNUNIT.INS'                                              CKSUBS     42
      INCLUDE 'PARX.INS'                                                CKSUBS     43
      INCLUDE 'UDCA.INS'                                                CKSUBS     44
      INCLUDE 'UDCB.INS'                                                CKSUBS     45
      INCLUDE 'UDCD.INS'                                                CKSUBS     46
      INCLUDE 'UDCE.INS'                                                CKSUBS     47
      INCLUDE 'UDCH.INS'                                                CKSUBS     48
      INCLUDE 'CNFLAG.INS'                                              CKSUBS     49
C                                                                       CKSUBS     50
      DIMENSION  LEN(10)                                                CKSUBS     51
C                                                                       CKSUBS     52
      LOGICAL       FIRST, FOUND, LAST, ORDER                           CKSUBS     53
C                                                                       CKSUBS     54
      CHARACTER*20  SUBNAM                                              CKSUBS     55
      CHARACTER*17  END1, END2, BNAME(10)                               CKSUBS     56
C                                                                       CKSUBS     57
C---------------------------------------------------------------------  CKSUBS     58
C                                                                       CKSUBS     59
C      LDEB=(JDEB(302).NE.0)                                            CKSUBS     60
C      LDEB1=(JDEB(310).NE.0)                                           CKSUBS     61
      LDEB=(JDEB(302).NE.0).OR.(JDEB(310).NE.0)                         CKSUBS     62
C                                                                       CKSUBS     63
      IF(SDBG)THEN                                                      CKSUBS     64
         SUBNAM = 'CKSUBS ROUTINE.'                                     CKSUBS     65
      ELSE                                                              CKSUBS     66
         SUBNAM = ' '                                                   CKSUBS     67
      END IF                                                            CKSUBS     68
C                                                                       CKSUBS     69
C                                                                       CKSUBS     70
C     Search through the subsystem list to find if this loop is really  CKSUBS     71
C     a subsystem.                                                      CKSUBS     72
C                                                                       CKSUBS     73
      END1 = STARS                                                      CKSUBS     74
      END2 = STARS                                                      CKSUBS     75
      NEXT = IFXSUB                                                     CKSUBS     76
      FOUND = .FALSE.                                                   CKSUBS     77
20    IF(NEXT.EQ.0 .OR. FOUND) GOTO 120                                 CKSUBS     78
C                                                                       CKSUBS     79
         FIRST = .FALSE.                                                CKSUBS     80
         LAST = .FALSE.                                                 CKSUBS     81
C                                                                       CKSUBS     82
         LINK = LPTOP(LPMAX)                                            CKSUBS     83
         JPFIRS = LINK                                                  CKSUBS     84
         JPLAST = LINK                                                  CKSUBS     85
40       IF((FIRST.AND.LAST) .OR. LINK.EQ.0) GOTO 60                    CKSUBS     86
C                                                                       CKSUBS     87
C           Search through the loop to find, the first and last         CKSUBS     88
C           blocks of the sub-system.                                   CKSUBS     89
C                                                                       CKSUBS     90
            IF(LPNUM(LINK).EQ.IFXNUM(NEXT))THEN                         CKSUBS     91
               FIRST = .TRUE.                                           CKSUBS     92
               JPFIRS = LINK                                            CKSUBS     93
            ELSEIF(LPNUM(LINK).EQ.JFXNUM(NEXT))THEN                     CKSUBS     94
               LAST = .TRUE.                                            CKSUBS     95
               JPLAST = LINK                                            CKSUBS     96
            END IF                                                      CKSUBS     97
            LINK = LPNEXT(LINK)                                         CKSUBS     98
            GOTO 40                                                     CKSUBS     99
60       CONTINUE                                                       CKSUBS    100
C                                                                       CKSUBS    101
         FOUND = .FALSE.                                                CKSUBS    102
         IF(FIRST.AND.LAST)THEN                                         CKSUBS    103
            IF(LPNEXT(JPLAST).EQ.0)THEN                                 CKSUBS    104
C                                                                       CKSUBS    105
C              The loop matches this subsystem and is correctly ordered.CKSUBS    106
C                                                                       CKSUBS    107
               FOUND = .TRUE.                                           CKSUBS    108
               ORDER = .TRUE.                                           CKSUBS    109
C                                                                       CKSUBS    110
            ELSEIF(LPNEXT(JPLAST).EQ.JPFIRS)THEN                        CKSUBS    111
C                                                                       CKSUBS    112
C              The loop matches this subsystem but is not defined in theCKSUBS    113
C              right order.                                             CKSUBS    114
C                                                                       CKSUBS    115
               FOUND = .TRUE.                                           CKSUBS    116
               ORDER = .FALSE.                                          CKSUBS    117
C                                                                       CKSUBS    118
            ELSE                                                        CKSUBS    119
C                                                                       CKSUBS    120
C              The loop does not match this subsystem, try the next     CKSUBS    121
C              subsystem for a match.                                   CKSUBS    122
C                                                                       CKSUBS    123
               FOUND = .FALSE.                                          CKSUBS    124
                                                                        CKSUBS    125
            END IF                                                      CKSUBS    126
C                                                                       CKSUBS    127
            IF(.NOT. ORDER)THEN                                         CKSUBS    128
C                                                                       CKSUBS    129
C              Re-order the blocks in the loop, so that the first block CKSUBS    130
C              of the loop is the first block of the subsystem.         CKSUBS    131
C                                                                       CKSUBS    132
               JSAVE = LPTOP(LPMAX)                                     CKSUBS    133
               LPLEAD(LPMAX) = 0                                        CKSUBS    134
               LPTOP(LPMAX) = JPFIRS                                    CKSUBS    135
               LINK = JPFIRS                                            CKSUBS    136
80             IF(LPNEXT(LINK).EQ.0) GOTO 100                           CKSUBS    137
                  LINK = LPNEXT(LINK)                                   CKSUBS    138
                  GOTO 80                                               CKSUBS    139
100            CONTINUE                                                 CKSUBS    140
               LPNEXT(LINK) = JSAVE                                     CKSUBS    141
               LPNEXT(JPLAST) = 0                                       CKSUBS    142
            END IF                                                      CKSUBS    143
         END IF                                                         CKSUBS    144
C                                                                       CKSUBS    145
C                                                                       CKSUBS    146
         IF(FOUND)THEN                                                  CKSUBS    147
            LPSUBS(LPMAX) = NEXT                                        CKSUBS    148
            END1 = LPNAME(JPFIRS)                                       CKSUBS    149
            END2 = LPNAME(JPLAST)                                       CKSUBS    150
         ELSE                                                           CKSUBS    151
            NEXT = IFXNEX(NEXT)                                         CKSUBS    152
         END IF                                                         CKSUBS    153
         GOTO 20                                                        CKSUBS    154
120   CONTINUE                                                          CKSUBS    155
C                                                                       CKSUBS    156
C                                                                       CKSUBS    157
      IF(LDEB)THEN                                                      CKSUBS    158
         WRITE (IUD6,9002) LPMAX                                        CKSUBS    159
         IF(LPSUBS(LPMAX) .NE. 0)THEN                                   CKSUBS    160
            LEN1 = IUDLEN(IFXNUM(LPSUBS(LPMAX)))                        CKSUBS    161
            WRITE (IUD6,9004) FXNAM1(LPSUBS(LPMAX))(1:LEN1)             CKSUBS    162
         ELSEIF(LPLEAD(LPMAX).EQ.0)THEN                                 CKSUBS    163
            WRITE (IUD6,9006)                                           CKSUBS    164
         ELSE                                                           CKSUBS    165
            LEN1 = IUDLEN(LPLEAD(LPMAX))                                CKSUBS    166
            WRITE (IUD6,9008) UDNAME(LPLEAD(LPMAX))(1:LEN1)             CKSUBS    167
         END IF                                                         CKSUBS    168
         NEXT = LPTOP(LPMAX)                                            CKSUBS    169
         J = 0                                                          CKSUBS    170
         LINLEN = 0                                                     CKSUBS    171
         FIRST = .TRUE.                                                 CKSUBS    172
140      IF(NEXT.EQ.0) GOTO 160                                         CKSUBS    173
            IF(J .GE. 10 .OR. LINLEN .GT. 100)THEN                      CKSUBS    174
               IF(FIRST)THEN                                            CKSUBS    175
                  WRITE (IUD6,9010) (BNAME(K)(1:LEN(K)), K = 1, J)      CKSUBS    176
                  FIRST = .FALSE.                                       CKSUBS    177
               ELSE                                                     CKSUBS    178
                  WRITE (IUD6,9012) (BNAME(K)(1:LEN(K)), K = 1, J)      CKSUBS    179
               END IF                                                   CKSUBS    180
               J = 0                                                    CKSUBS    181
               LINLEN = 0                                               CKSUBS    182
            ELSE                                                        CKSUBS    183
               J = J + 1                                                CKSUBS    184
               BNAME(J) = LPNAME(NEXT)                                  CKSUBS    185
               LEN(J) = IUDLEN(LPNUM(NEXT))                             CKSUBS    186
               LINLEN = LINLEN + LEN(J)                                 CKSUBS    187
               NEXT = LPNEXT(NEXT)                                      CKSUBS    188
            END IF                                                      CKSUBS    189
            GOTO 140                                                    CKSUBS    190
160      CONTINUE                                                       CKSUBS    191
         IF(FIRST)THEN                                                  CKSUBS    192
            WRITE (IUD6,9010) (BNAME(K)(1:LEN(K)), K = 1, J)            CKSUBS    193
         ELSE                                                           CKSUBS    194
            WRITE (IUD6,9012) (BNAME(K)(1:LEN(K)), K = 1, J)            CKSUBS    195
         END IF                                                         CKSUBS    196
         WRITE (IUD6,9014)                                              CKSUBS    197
      END IF                                                            CKSUBS    198
C                                                                       CKSUBS    199
C                                                                       CKSUBS    200
C---------------------------------------------------------------------  CKSUBS    201
C                                                                       CKSUBS    202
      RETURN                                                            CKSUBS    203
C                                                                       CKSUBS    204
C---------------------------------------------------------------------  CKSUBS    205
C                                                                       CKSUBS    206
9002  FORMAT (//, 21X, '***  FOUND  LOOP  ***', /, 6X, 'NUMBER:  ',     CKSUBS    207
     1        I2)                                                       CKSUBS    208
9004  FORMAT (' ', 10X, '(ORDER IS DEFINED BY SUBSYS BLOCK "',          CKSUBS    209
     1        A, '".)')                                                 CKSUBS    210
9006  FORMAT (' ', 10X, '(FIRST BLOCK IN LOOP IS DETERMINED BY ',       CKSUBS    211
     1        'INPUT ORDER OF THE BLOCKS.)')                            CKSUBS    212
9008  FORMAT (' ', 10X, '(FIRST BLOCK IN LOOP IS DEPENDENT ON THE ',    CKSUBS    213
     1        'POSITION OF "', /, 10X, ' "', A, '" IN INPUT FILE.)')    CKSUBS    214
9010  FORMAT (' ', 5X, 'LOOP:  ', 10 (A, 3X))                           CKSUBS    215
9012  FORMAT (' ', 12X, 10 (A, 3X))                                     CKSUBS    216
9014  FORMAT (///)                                                      CKSUBS    217
C                                                                       CKSUBS    218
C---------------------------------------------------------------------  CKSUBS    219
C                                                                       CKSUBS    220
      END                                                               CKSUBS    221
