CFPRIME PARSPA                                                          PARSPA      1
C***********************************************************************RIGHTE      1
C*                                                                     *RIGHTE      2
C*               Output Analysis Program for ETMSP (OAP)               *RIGHTE      4
C*               =======================================               *RIGHTE      5
C*                                                                     *RIGHTE     11
C*        copyright @(1993) Electric Power Research Institute          *RIGHTE     12
C*                                                                     *RIGHTE     13
C* EPRI reserves all rights in the software and associated             *RIGHTE     14
C* documentation as delivered. The software and its associated         *RIGHTE     15
C* documention or any portion thereof may not be reproduced in any form*RIGHTE     16
C* whatsoever without the consent of EPRI, except as explicity provided*RIGHTE     17
C* for by license. Licensee shall submit a detailed description to EPRI*RIGHTE     18
C* of any changes or modifications to the software within two (2)      *RIGHTE     19
C* months after such changes or modifications are made. At EPRI's sole *RIGHTE     20
C* discretion, the software, as changed or modified, shall be given a  *RIGHTE     21
C* new designation sufficiently different from its then current        *RIGHTE     22
C* designation as to prevent mistake,confusion, or deception as between*RIGHTE     23
C* the current software as changed or modified.                        *RIGHTE     24
C*                                                                     *RIGHTE     25
C* A license under EPRI's rights in the software can be obtained       *RIGHTE     26
C* directly from EPRI.                                                 *RIGHTE     27
C*                                                                     *RIGHTE     28
C* This program and supporting materials may be independently available*RIGHTE     29
C* from Electric Power Software centre (EPSC) for an appropriate       *RIGHTE     30
C* distribution fee. The EPSC is a service of                          *RIGHTE     31
C*                                                                     *RIGHTE     32
C*                    Power Computing Company                          *RIGHTE     33
C*                    1930 Hi Line                                     *RIGHTE     34
C*                    Dallas, Tx 75207                                 *RIGHTE     35
C*                                                                     *RIGHTE     36
C* NEITHER EPRI, ANY MEMBER OF EPRI, NOR ANY PERSON OR  ORGANIZATION   *RIGHTE     37
C* ACTING ON BEHAVE OF THEM:                                           *RIGHTE     38
C*                                                                     *RIGHTE     39
C* 1. MAKE ANY WARRANTY OR REPRESENTATION WHATSOEVER, EXPRESS OR       *RIGHTE     40
C*    IMPLIED, INCLUDING ANY WARRANTY OF MERCHANTABILITY OR FITNESS OR *RIGHTE     41
C*    ANY PURPOSE WITH RESPECT TO THE SOFTWARE OR ITS ASSOCIATED       *RIGHTE     42
C*    DOCUMENTATION; OR                                                *RIGHTE     43
C*                                                                     *RIGHTE     44
C* 2. ASSUMES ANY LIABILITY WHATSOEVER WITH RESPECT TO ANY USE OF THE  *RIGHTE     45
C*    SOFTWARE OR ITS ASSOCIATED DOCUMENTATION OR ANY PORTION THEREOF  *RIGHTE     46
C*    OR WITH RESPECT TO ANY DAMAGES WHICH MAY RESULT FROM SUCH USE.   *RIGHTE     47
C*                                                                     *RIGHTE     48
C* THIS NOTICE MAY NOT BE REMOVED FROM THE SOFTWARE BY ANY USER        *RIGHTE     49
C* THEREOF.                                                            *RIGHTE     50
C*                                                                     *RIGHTE     51
C***********************************************************************RIGHTE     52
C                                                                       PARSPA      3
      SUBROUTINE PARSPA(PAR,LE,KC,KR,MC,LOUT,CONST,NC2,IOK,N1)          PARSPA      4
CD                                                                      PARSPA      5
CD            THIS ROUTINE PARSES COMMAND LINE PARAMETER                PARSPA      6
CD            FOR CHANNEL SPECIFICATION                                 PARSPA      7
CD                                                                      PARSPA      8
CD            CALLING PARAMETERS :                                      PARSPA      9
CD                                                                      PARSPA     10
CD                        PAR    :  COMMAND LINE                        PARSPA     11
CD                        LE     :  LENGTH OF THE CHARARCTER STRING IN  PARSPA     12
CD                                  THE COMMAD LINE                     PARSPA     13
CD                        KC     :  INCOMING CHANNEL NUMBER ARRAY       PARSPA     14
CD                        MC     :  INCOMING RECORD/FIELD POINTER ARRAY PARSPA     15
CD                        LOUT   :  LOGICAL UNIT FOR THE OUTPUT         PARSPA     16
CD                        CONST  :  READ IN CONSTANT                    PARSPA     17
CD                        NC2    :  INCOMING FLAG,DETERMINE THE NO. OF  PARSPA     18
CD                                  CHANNEL IN THE COMMAND LINE         PARSPA     19
CD                        IOK    :  ERROR STATUS FLAG                   PARSPA     20
CD                        N1     :  STARING CHANNEL NUMBER              PARSPA     21
CD                                                                      PARSPA     22
      INCLUDE 'PARAM.INS'                                               PARSPA     23
      INCLUDE 'DBFLG.INS'                                               PARSPA     24
      INCLUDE 'XYARAY.INS'                                              PARSPA     25
                                                                        PARSPA     26
      COMMON /RECPT/ KRSTRT, ISTNAM, IIDARY, ITYARY, IHREC,ICHAN,       PARSPA     27
     *          NPFL,LRREC,IRREC                                        PARSPA     28
                                                                        PARSPA     29
      INCLUDE 'JJNAME.INS'                                              PARSPA     30
C  ..                                                                   PARSPA     31
      LOGICAL WARNED,SAMETY                                             PARSPA     32
      CHARACTER*2 UID                                                   PARSPA     33
      CHARACTER*50 PAR                                                  PARSPA     34
C!      DIMENSION KC(MC),KR(MC,2)                                       PARSPA     35
      DIMENSION KC(MCHNL),KR(MCHNL,2)                                   PARSPA     36
                                                                        PARSPA     37
      IOK=0                                                             PARSPA     38
      LDEB=99                                                           PARSPA     39
      LDEBUG=DEBUG(8)                                                   PARSPA     40
      SAMETY=.FALSE.                                                    PARSPA     41
                                                                        PARSPA     42
C   .....................................................               PARSPA     43
C   : read in command line constant between < >         :               PARSPA     44
C   :                                                   :               PARSPA     45
      LLSB=0                                                            PARSPA     46
      LRSB=0                                                            PARSPA     47
      LLSB=INDEX(PAR,'<')                                               PARSPA     48
      LRSB=INDEX(PAR,'>')                                               PARSPA     49
      IF((LLSB.NE.0) .AND.(LRSB.NE.0)) THEN                             PARSPA     50
          READ(PAR(LLSB+1:LRSB-1),*,IOSTAT=IOS) CONST                   PARSPA     51
      ENDIF                                                             PARSPA     52
      IF(IOS.EQ.0) GOTO 89                                              PARSPA     53
C    ............................................       :               PARSPA     54
C    : error on command line parameter. get out.:       :               PARSPA     55
      WRITE(LOUT,2011)                                                  PARSPA     56
      IOK=-1                                                            PARSPA     57
      GOTO 9999                                                         PARSPA     58
C     :..........................................:      :               PARSPA     59
 89   CONTINUE                                                          PARSPA     60
C   :                                                   :               PARSPA     61
C   :...................................................:               PARSPA     62
C    .............................................................      PARSPA     63
C    :                                                           :      PARSPA     64
      LL=0                                                              PARSPA     65
      LR=0                                                              PARSPA     66
      LLCB=INDEX(PAR,'(')                                               PARSPA     67
      LRCB=INDEX(PAR,')')                                               PARSPA     68
      LLZB=INDEX(PAR,'{')                                               PARSPA     69
      LRZB=INDEX(PAR,'}')                                               PARSPA     70
      IF(LLCB.GT.0) LL=LLCB                                             PARSPA     71
      IF(LRCB.GT.0) LR=LRCB                                             PARSPA     72
      IF(LRZB.GT.0) LR=LRZB                                             PARSPA     73
      IF(LLZB.GT.0) THEN                                                PARSPA     74
          LL=LLZB                                                       PARSPA     75
          SAMETY=.TRUE.                                                 PARSPA     76
      ENDIF                                                             PARSPA     77
C                                                                       PARSPA     78
      IF(LL.EQ.0) THEN                                                  PARSPA     79
         WRITE(LOUT,1010)                                               PARSPA     80
 1010    FORMAT(/,1X,'** LEFT BRACKET IS MISSING **')                   PARSPA     81
         WRITE(LOUT,2011)                                               PARSPA     82
         IOK=-1                                                         PARSPA     83
         GOTO 9999                                                      PARSPA     84
      ENDIF                                                             PARSPA     85
      IF(LR.EQ.0) THEN                                                  PARSPA     86
         WRITE(LOUT,1021)                                               PARSPA     87
 1021    FORMAT(/,1X,'** RIGHT BRACKET IS MISSING **')                  PARSPA     88
         WRITE(LOUT,2011)                                               PARSPA     89
         IOK=-1                                                         PARSPA     90
         GOTO 9999                                                      PARSPA     91
      ENDIF                                                             PARSPA     92
      IF(LR.LE.LL) THEN                                                 PARSPA     93
         WRITE(LOUT,2011)                                               PARSPA     94
         IOK=-1                                                         PARSPA     95
         GOTO 9999                                                      PARSPA     96
      ENDIF                                                             PARSPA     97
C   :............................................................:      PARSPA     98
C   ....................................................................PARSPA     99
C   : syntex is (I1:I2)                                                 PARSPA    100
C   *                                                                   PARSPA    101
      ICOL=INDEX(PAR,':')                                               PARSPA    102
      IF(ICOL.NE.0) THEN                                                PARSPA    103
         READ(PAR(LL+1:ICOL-1),*,IOSTAT=IOS)KFROM                       PARSPA    104
         IF(IOS.NE.0) GOTO 99                                           PARSPA    105
         READ(PAR(ICOL+1:LR-1),*,IOSTAT=IOS)KTO                         PARSPA    106
         IF(IOS.NE.0) GOTO 99                                           PARSPA    107
         IF(KFROM.LT.11) KFROM=11                                       PARSPA    108
         IF(KTO.GT.ICHAN) KTO=ICHAN                                     PARSPA    109
         ISL=N1                                                         PARSPA    110
         CALL UNPACK(UID,NTYPE,ITY(1,KFROM))                            PARSPA    111
 98      CONTINUE                                                       PARSPA    112
            IF(SAMETY) THEN                                             PARSPA    113
               CALL UNPACK(UID,NTYPE1,ITY(1,KFROM))                     PARSPA    114
               IF(NTYPE.NE.NTYPE1) THEN                                 PARSPA    115
                   IF(KFROM.GT.KTO) GOTO 97                             PARSPA    116
                   KFROM=KFROM+1                                        PARSPA    117
                   GOTO 98                                              PARSPA    118
               ENDIF                                                    PARSPA    119
            ENDIF                                                       PARSPA    120
            ISL=ISL+1                                                   PARSPA    121
            IF(ISL.GT.MCHNL) GOTO 97                                    PARSPA    122
            KC(ISL)=KFROM                                               PARSPA    123
            IF(KFROM.GT.KTO) GOTO 97                                    PARSPA    124
            KFROM=KFROM+1                                               PARSPA    125
         GOTO 98                                                        PARSPA    126
C       ............................................................    PARSPA    127
C       : error on command line parameter. get out..               :    PARSPA    128
 99      CONTINUE                                                       PARSPA    129
         WRITE(LOUT,2011)                                               PARSPA    130
         IOK=-1                                                         PARSPA    131
         GOTO 9999                                                      PARSPA    132
C       :...........................................................:   PARSPA    133
 97      CONTINUE                                                       PARSPA    134
C!!         KC(1)=ISL-2                                                 PARSPA    135
C!                                                                      PARSPA    136
C         IF(ISL.GE.NBUF) ISL=NBUF-2                                    PARSPA    137
         IF(ISL+KCH(1).GT.MCHNL)ISL=MCHNL-KCH(1)                        PARSPA    138
C                                                                       PARSPA    139
         KC(1)=ISL-1                                                    PARSPA    140
         KR(1,1)=KC(1)                                                  PARSPA    141
         KR(1,2)=KC(1)                                                  PARSPA    142
C     :.................................................................PARSPA    143
      ELSE                                                              PARSPA    144
C     ..................................................................PARSPA    145
C     : syntax is (I1,I2,I3,..Ix)                                       PARSPA    146
C     :                                                                 PARSPA    147
         NON=0                                                          PARSPA    148
         DO 1020 I=LL+1,LR-1                                            PARSPA    149
            IF(PAR(I:I).EQ.',')NON=NON+1                                PARSPA    150
 1020    CONTINUE                                                       PARSPA    151
         NON=NON+1                                                      PARSPA    152
                                                                        PARSPA    153
         IF(LDEBUG) THEN                                                PARSPA    154
            WRITE(LDEB,1000) LE,PAR,LL,LR,NON                           PARSPA    155
 1000       FORMAT(/,1X,' ** DEBUG (PARSPA) ** LE,PAR : ',I4,1X,A,/     PARSPA    156
     1      'LL= ',I3,' LR= ',I3,' NON= ',I3)                           PARSPA    157
         ENDIF                                                          PARSPA    158
                                                                        PARSPA    159
         IF(NC2.EQ.2) THEN                                              PARSPA    160
            IF(NON.LT.2) THEN                                           PARSPA    161
               WRITE(LOUT,1200) NON                                     PARSPA    162
 1200          FORMAT(/,1X,'** MINIMUM OF 2 CHANNEL NUMBERS ARE ',      PARSPA    163
     1         'REQUIRED. READ IN ONLY ',I3,/)                          PARSPA    164
               IOK=-1                                                   PARSPA    165
               GOTO 9999                                                PARSPA    166
            ENDIF                                                       PARSPA    167
         ENDIF                                                          PARSPA    168
                                                                        PARSPA    169
C!                                                                      PARSPA    170
C         IF(NON.GE.NBUF) NON=NBUF-2                                    PARSPA    171
         IF(NON+KCH(1).GT.MCHNL-1)NON=MCHNL-1-KCH(1)                    PARSPA    172
C                                                                       PARSPA    173
         KC(1)=NON                                                      PARSPA    174
         KR(1,1)=NON                                                    PARSPA    175
         KR(1,2)=NON                                                    PARSPA    176
         READ(PAR(LL+1:LR-1),*,IOSTAT=IOS) (KC(IX+1),IX=N1,NON+N1-1)    PARSPA    177
         IF(IOS.EQ.0) GOTO 1205                                         PARSPA    178
C       :.............................................................: PARSPA    179
                                                                        PARSPA    180
C       ............................................................    PARSPA    181
C       : error on command line parameter. get out..               :    PARSPA    182
         WRITE(LOUT,2011)                                               PARSPA    183
         IOK=-1                                                         PARSPA    184
         GOTO 9999                                                      PARSPA    185
C       :...........................................................:   PARSPA    186
 1205    CONTINUE                                                       PARSPA    187
                                                                        PARSPA    188
      ENDIF                                                             PARSPA    189
C   *...................................................................PARSPA    190
C                                                                       PARSPA    191
C   ....................................................................PARSPA    192
C   :                                                                   PARSPA    193
      CALL UNPACK(UID,NYTPE,ITY(1,KC(N1+1)))                            PARSPA    194
      WARNED=.FALSE.                                                    PARSPA    195
      DO 1030 I=N1+1,N1+KC(1)                                           PARSPA    196
         CALL UNPACK(UID,NTYPE1,ITY(1,KC(I)))                           PARSPA    197
         IF(NTYPE.NE.NTYPE1) THEN                                       PARSPA    198
            IF(.NOT.WARNED) THEN                                        PARSPA    199
               WARNED=.TRUE.                                            PARSPA    200
               IOK=1                                                    PARSPA    201
               WRITE(LOUT,1031)                                         PARSPA    202
 1031          FORMAT(/,1X,'++WARNING: Different Channel Type++')       PARSPA    203
            ENDIF                                                       PARSPA    204
         ENDIF                                                          PARSPA    205
         CALL RECFLD(KC(I),KR(I,1),KR(I,2))                             PARSPA    206
 1030 CONTINUE                                                          PARSPA    207
C   :...................................................................PARSPA    208
                                                                        PARSPA    209
C   .....................................................               PARSPA    210
C   : Debug show contains of record/field pointer array :               PARSPA    211
C   :                                                   :               PARSPA    212
      IF(LDEBUG) THEN                                                   PARSPA    213
        WRITE(LDEB,1011)                                                PARSPA    214
        DO 90 I=N1+1,N1+KC(1)                                           PARSPA    215
           WRITE(LDEB,1012) KR(I,1),KR(I,2),KC(I)                       PARSPA    216
   90   CONTINUE                                                        PARSPA    217
 1012   FORMAT(1X,3I20)                                                 PARSPA    218
 1011   FORMAT(1X,'+++(PARSPA)+++ (1ST LINE IS NUMBER OF CHANNELS',/,   PARSPA    219
     1         1X,'      PHYSICAL RECORD #       FIELD NUMBER ',/,      PARSPA    220
     1         1X,'      ------------------      -------------')        PARSPA    221
      ENDIF                                                             PARSPA    222
C    :...................................................:              PARSPA    223
                                                                        PARSPA    224
                                                                        PARSPA    225
 9999 CONTINUE                                                          PARSPA    226
      RETURN                                                            PARSPA    227
C                                                                       PARSPA    228
 2011 FORMAT(/,                                                         PARSPA    229
     110X,'*******************************************************',/,  PARSPA    230
     110X,'*                                                     *',/,  PARSPA    231
     110X,'*         ** Command Line Parameter Error **          *',/,  PARSPA    232
     110X,'*                                                     *',/,  PARSPA    233
     110X,'*   Format 1.  (I1:I2)  <##>                          *',/,  PARSPA    234
     110X,'*                                                     *',/,  PARSPA    235
     110X,'*              I1 = beginning channel number          *',/,  PARSPA    236
     110X,'*              I2 = ending channel number             *',/,  PARSPA    237
     110X,'*              ## = Constant                          *',/,  PARSPA    238
     110X,'*                                                     *',/,  PARSPA    239
     110X,'*                                                     *',/,  PARSPA    240
     110X,'*   Format 2.  (J1,J2,J3,J4,...Jx) <##>               *',/,  PARSPA    241
     110X,'*                                                     *',/,  PARSPA    242
     110X,'*              J1 to Jx are actual channel numbers.   *',/,  PARSPA    243
     110X,'*              ## = Constant                          *',/,  PARSPA    244
     110X,'*                                                     *',/,  PARSPA    245
     110X,'*******************************************************',/)  PARSPA    246
      END                                                               PARSPA    247
                                                                        PARSPA    248
