CFPRIME STRCHN                                                          STRCHN      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
      SUBROUTINE STRCHN(LINE,ICN,NTYPE,LS,*)                            STRCHN      3
CD                                                                      STRCHN      4
CD    THIS SUBROUTINE CONVERTS CHANNEL VARIABLES TO CHANNEL             STRCHN      5
CD    NUMBERS, ONE CHANNEL AT A TIME.                                   STRCHN      6
CD    IT RETURNS THE CHANNEL NUMBER, CHANNEL TYPE AND THE               STRCHN      7
CD    STARTING INDEX FOR THE NEXT SEARCH.                               STRCHN      8
CD                                                                      STRCHN      9
C                                                                       STRCHN     10
      INCLUDE 'PARAM.INS'                                               STRCHN     11
      INCLUDE 'XYARAY.INS'                                              STRCHN     12
      INCLUDE 'SOAPC1.INS'                                              STRCHN     13
      INCLUDE 'GTIT.INS'                                                STRCHN     14
      INCLUDE 'JJNAME.INS'                                              STRCHN     15
      INCLUDE 'DBFLG.INS'                                               STRCHN     16
C                                                                       STRCHN     17
      COMMON /RECPT/ KRSTRT,ISTNAM,IIDARY,ITYARY,IHREC,ICHAN,NPFL       STRCHN     18
     *,LRREC,IRREC                                                      STRCHN     19
C                                                                       STRCHN     20
      CHARACTER*(*) LINE                                                STRCHN     21
C                                                                       STRCHN     22
      INTEGER KNAME(3)                                                  STRCHN     23
C                                                                       STRCHN     24
      CHARACTER*2 CID,CIDX,CIDR                                         STRCHN     25
      CHARACTER*12 BNAM1,BNAM2,BNAME                                    STRCHN     26
      CHARACTER*24 ANAM24                                               STRCHN     27
      CHARACTER*80 CTYPE                                                STRCHN     28
      CHARACTER*82 STRING                                               STRCHN     29
C                                                                       STRCHN     30
      EQUIVALENCE (BNAME,KNAME(1))                                      STRCHN     31
C                                                                       STRCHN     32
      SAVE NPTYPE,NSCOL                                                 STRCHN     33
      DATA NPTYPE/0/,NSCOL/0/                                           STRCHN     34
C---------------------------------------------------------------------  STRCHN     35
C                                        Get channel type and # of ;'s  STRCHN     36
C                                                                       STRCHN     37
      LPS=LS                                                            STRCHN     38
      STRING=LINE(LS:)                                                  STRCHN     39
      IK=IFNBLK(STRING,81)                                              STRCHN     40
      IF(IK.EQ.0)GOTO 9000                                              STRCHN     41
      IF(STRING(IK:IK).EQ.'>')THEN                                      STRCHN     42
        I1=INDEX(STRING,';')                                            STRCHN     43
        IF(I1.EQ.0)GOTO 9000                                            STRCHN     44
        CTYPE=STRING(IK+1:I1-1)                                         STRCHN     45
        CALL UPCAS1(CTYPE,80)                                           STRCHN     46
        CALL MAKCHN(CTYPE,NTYPE,NSCOL)                                  STRCHN     47
        IF(NTYPE.EQ.0)GOTO 9000                                         STRCHN     48
        NPTYPE=NTYPE                                                    STRCHN     49
      ELSEIF(STRING(IK:IK).EQ.';')THEN                                  STRCHN     50
        IF(NPTYPE.EQ.0)GOTO 9000                                        STRCHN     51
        I1=IK                                                           STRCHN     52
        NTYPE=NPTYPE                                                    STRCHN     53
      ELSE                                                              STRCHN     54
        GOTO 9000                                                       STRCHN     55
      ENDIF                                                             STRCHN     56
C---------------------------------------------------------------------  STRCHN     57
C                                          Get bus names, numbers etc.  STRCHN     58
C                                                                       STRCHN     59
      IF(NSCOL.EQ.1)THEN                                                STRCHN     60
        IA=INDEX(STRING(I1+1:80),'>')+I1                                STRCHN     61
        IB=INDEX(STRING(I1+1:80),';')+I1                                STRCHN     62
        IF(IA.LT.IB)THEN                                                STRCHN     63
          IX=IA                                                         STRCHN     64
        ELSE                                                            STRCHN     65
          IX=IB                                                         STRCHN     66
        ENDIF                                                           STRCHN     67
        IF(NTYPE.EQ.42.OR.NTYPE.EQ.43)THEN                              STRCHN     68
          IF(IX.EQ.I1)THEN                                              STRCHN     69
            IF(I1+24.GT.80)THEN                                         STRCHN     70
              ANAM24=STRING(I1+1:80)                                    STRCHN     71
              LS=81                                                     STRCHN     72
            ELSE                                                        STRCHN     73
              ANAM24=STRING(I1+1:I1+24)                                 STRCHN     74
              LS=I1+25+(LS-1)                                           STRCHN     75
            ENDIF                                                       STRCHN     76
          ELSE                                                          STRCHN     77
            IF(IX.GT.I1+25)THEN                                         STRCHN     78
              ANAM24=STRING(I1+1:I1+24)                                 STRCHN     79
              LS=I1+25+(LS-1)                                           STRCHN     80
            ELSE                                                        STRCHN     81
              ANAM24=STRING(I1+1:IX-1)                                  STRCHN     82
              LS=IX+(LS-1)                                              STRCHN     83
            ENDIF                                                       STRCHN     84
          ENDIF                                                         STRCHN     85
        ELSE                                                            STRCHN     86
          IF(IX.EQ.I1)THEN                                              STRCHN     87
            IF(I1+12.GT.80)THEN                                         STRCHN     88
              BNAM1=STRING(I1+1:80)                                     STRCHN     89
              LS=81                                                     STRCHN     90
            ELSE                                                        STRCHN     91
              BNAM1=STRING(I1+1:I1+12)                                  STRCHN     92
              LS=I1+13+(LS-1)                                           STRCHN     93
            ENDIF                                                       STRCHN     94
          ELSE                                                          STRCHN     95
            IF(IX.GT.I1+13)THEN                                         STRCHN     96
              BNAM1=STRING(I1+1:I1+12)                                  STRCHN     97
              LS=I1+13+(LS-1)                                           STRCHN     98
            ELSE                                                        STRCHN     99
              BNAM1=STRING(I1+1:IX-1)                                   STRCHN    100
              LS=IX+(LS-1)                                              STRCHN    101
            ENDIF                                                       STRCHN    102
          ENDIF                                                         STRCHN    103
        ENDIF                                                           STRCHN    104
        GOTO 1000                                                       STRCHN    105
      ELSEIF(NSCOL.EQ.2)THEN                                            STRCHN    106
        I2=INDEX(STRING(I1+1:80),';')+I1                                STRCHN    107
        IF(I2.EQ.I1)GOTO 9000                                           STRCHN    108
        IF(I2.GT.I1+13)THEN                                             STRCHN    109
          BNAM1=STRING(I1+1:I1+12)                                      STRCHN    110
        ELSE                                                            STRCHN    111
          BNAM1=STRING(I1+1:I2-1)                                       STRCHN    112
        ENDIF                                                           STRCHN    113
        I3=I2                                                           STRCHN    114
        GOTO 900                                                        STRCHN    115
      ELSEIF(NSCOL.EQ.3)THEN                                            STRCHN    116
        I2=INDEX(STRING(I1+1:80),';')+I1                                STRCHN    117
        I3=INDEX(STRING(I2+1:80),';')+I2                                STRCHN    118
        IF(I3.EQ.I2)GOTO 9000                                           STRCHN    119
        IF(I2.GT.I1+13)THEN                                             STRCHN    120
          BNAM1=STRING(I1+1:I1+12)                                      STRCHN    121
        ELSE                                                            STRCHN    122
          BNAM1=STRING(I1+1:I2-1)                                       STRCHN    123
        ENDIF                                                           STRCHN    124
        IF(I3.GT.I2+13)THEN                                             STRCHN    125
          BNAM2=STRING(I2+1:I2+12)                                      STRCHN    126
        ELSE                                                            STRCHN    127
          BNAM2=STRING(I2+1:I3-1)                                       STRCHN    128
        ENDIF                                                           STRCHN    129
      ELSE                                                              STRCHN    130
        GOTO 9000                                                       STRCHN    131
      ENDIF                                                             STRCHN    132
C                                                                       STRCHN    133
  900 IA=INDEX(STRING(I3+1:80),'>')+I3                                  STRCHN    134
      IB=INDEX(STRING(I3+1:80),';')+I3                                  STRCHN    135
      IF(IA.LT.IB)THEN                                                  STRCHN    136
        IX=IA                                                           STRCHN    137
      ELSE                                                              STRCHN    138
        IX=IB                                                           STRCHN    139
      ENDIF                                                             STRCHN    140
      IF(IX.EQ.I3)THEN                                                  STRCHN    141
        IF(I3+2.GT.80)THEN                                              STRCHN    142
          CID=STRING(I3+1:80)                                           STRCHN    143
          LS=81                                                         STRCHN    144
        ELSE                                                            STRCHN    145
          CID=STRING(I3+1:I3+2)                                         STRCHN    146
          LS=I3+3+(LS-1)                                                STRCHN    147
        ENDIF                                                           STRCHN    148
      ELSE                                                              STRCHN    149
        IF(IX.GT.I3+3)THEN                                              STRCHN    150
          CID=STRING(I3+1:I3+2)                                         STRCHN    151
          LS=I3+3+(LS-1)                                                STRCHN    152
        ELSE                                                            STRCHN    153
          CID=STRING(I3+1:IX-1)                                         STRCHN    154
          LS=IX+(LS-1)                                                  STRCHN    155
        ENDIF                                                           STRCHN    156
      ENDIF                                                             STRCHN    157
C                                                                       STRCHN    158
 1000 IF(NTYPE.NE.42.AND.NTYPE.NE.43)THEN                               STRCHN    159
        IF(KLFO.LE.0)THEN                                               STRCHN    160
          READ(BNAM1,*,IOSTAT=IOS)NUMB1                                 STRCHN    161
          IF(IOS.NE.0)GOTO 9000                                         STRCHN    162
          IF(NSCOL.EQ.3)THEN                                            STRCHN    163
            READ(BNAM2,*,IOSTAT=IOS)NUMB2                               STRCHN    164
            IF(IOS.NE.0)GOTO 9000                                       STRCHN    165
          ENDIF                                                         STRCHN    166
        ENDIF                                                           STRCHN    167
      ENDIF                                                             STRCHN    168
C---------------------------------------------------------------------  STRCHN    169
C                                                   Get channel number  STRCHN    170
C                                                                       STRCHN    171
 1100 ICHK=1                                                            STRCHN    172
 1200 DO 3000 ICN=11,ICHAN                                              STRCHN    173
        CALL UNPACK(CIDX,ITY1,ITY(1,ICN))                               STRCHN    174
        CALL WNTYPE(ITY1,NTIT,NSTATE)                                   STRCHN    175
        IF(NTYPE.NE.NTIT)GOTO 3000                                      STRCHN    176
        IF(NTYPE.EQ.42.OR.NTYPE.EQ.43)THEN                              STRCHN    177
          KNAME(1)=JNAME(1,ICN)                                         STRCHN    178
          KNAME(2)=JNAME(2,ICN)                                         STRCHN    179
          KNAME(3)=JNAME(3,ICN)                                         STRCHN    180
          IF(ANAM24(1:12).NE.BNAME)GOTO 3000                            STRCHN    181
          KNAME(1)=JNAME(4,ICN)                                         STRCHN    182
          KNAME(2)=JNAME(5,ICN)                                         STRCHN    183
          KNAME(3)=JNAME(6,ICN)                                         STRCHN    184
          IF(ANAM24(13:24).NE.BNAME)GOTO 3000                           STRCHN    185
          GOTO 9999                                                     STRCHN    186
        ELSE                                                            STRCHN    187
          IF(NSCOL.EQ.2.OR.NSCOL.EQ.3)THEN                              STRCHN    188
            IF(CIDX.NE.CID)THEN                                         STRCHN    189
              IF(CID(1:1).EQ.' '.OR.CID(2:2).EQ.' ')THEN                STRCHN    190
                CIDR(1:1)=CID(2:2)                                      STRCHN    191
                CIDR(2:2)=CID(1:1)                                      STRCHN    192
                IF(CIDX.NE.CIDR)GOTO 3000                               STRCHN    193
              ELSE                                                      STRCHN    194
                GOTO 3000                                               STRCHN    195
              ENDIF                                                     STRCHN    196
            ENDIF                                                       STRCHN    197
            IF(NSCOL.EQ.3)THEN                                          STRCHN    198
              IF(KLFO.LE.0)THEN                                         STRCHN    199
                IF(NUMB2.NE.ITY(3,ICN))GOTO 3000                        STRCHN    200
              ELSE                                                      STRCHN    201
                KNAME(1)=JNAME(4,ICN)                                   STRCHN    202
                KNAME(2)=JNAME(5,ICN)                                   STRCHN    203
                KNAME(3)=JNAME(6,ICN)                                   STRCHN    204
                IF(ICHK.EQ.1)THEN                                       STRCHN    205
                  IF(BNAM2.NE.BNAME)GOTO 3000                           STRCHN    206
                ELSE                                                    STRCHN    207
                  IF(BNAM2(1:8).NE.BNAME(1:8))GOTO 3000                 STRCHN    208
                  READ(BNAM2(9:12),*,IOSTAT=IOS)BKV                     STRCHN    209
                  IF(IOS.NE.0)GOTO 3000                                 STRCHN    210
                  READ(BNAME(9:12),*,IOSTAT=IOS)BKV1                    STRCHN    211
                  IF(IOS.NE.0)GOTO 3000                                 STRCHN    212
                  DBKV=ABS(BKV-BKV1)                                    STRCHN    213
                  IF(DBKV.GT.0.0001)GOTO 3000                           STRCHN    214
                ENDIF                                                   STRCHN    215
              ENDIF                                                     STRCHN    216
            ENDIF                                                       STRCHN    217
          ENDIF                                                         STRCHN    218
          IF(KLFO.LE.0)THEN                                             STRCHN    219
            IF(NUMB1.EQ.ITY(2,ICN))GOTO 9999                            STRCHN    220
          ELSE                                                          STRCHN    221
            KNAME(1)=JNAME(1,ICN)                                       STRCHN    222
            KNAME(2)=JNAME(2,ICN)                                       STRCHN    223
            KNAME(3)=JNAME(3,ICN)                                       STRCHN    224
            IF(ICHK.EQ.1)THEN                                           STRCHN    225
              IF(BNAM1.EQ.BNAME)GOTO 9999                               STRCHN    226
            ELSE                                                        STRCHN    227
              IF(BNAM1(1:8).NE.BNAME(1:8))GOTO 3000                     STRCHN    228
              READ(BNAM1(9:12),*,IOSTAT=IOS)BKV                         STRCHN    229
              IF(IOS.NE.0)GOTO 3000                                     STRCHN    230
              READ(BNAME(9:12),*,IOSTAT=IOS)BKV1                        STRCHN    231
              IF(IOS.NE.0)GOTO 3000                                     STRCHN    232
              DBKV=ABS(BKV-BKV1)                                        STRCHN    233
              IF(DBKV.LE.0.0001)GOTO 9999                               STRCHN    234
            ENDIF                                                       STRCHN    235
          ENDIF                                                         STRCHN    236
        ENDIF                                                           STRCHN    237
 3000 CONTINUE                                                          STRCHN    238
C---------------------------------------------------------------------  STRCHN    239
      IF(KLFO.GT.0)THEN                                                 STRCHN    240
        IF(ICHK.EQ.1)THEN                                               STRCHN    241
          ICHK=2                                                        STRCHN    242
          GOTO 1200                                                     STRCHN    243
        ENDIF                                                           STRCHN    244
      ENDIF                                                             STRCHN    245
C---------------------------------------------------------------------  STRCHN    246
C                                    Cannot find corresponding channel  STRCHN    247
C                                                                       STRCHN    248
 8000 WRITE(LOUT,'(A)')' *** CANNOT FIND CORRESPONDING CHANNEL ***'     STRCHN    249
      WRITE(LOUT,9100)LINE(LPS:LS)                                      STRCHN    250
      ICN=0                                                             STRCHN    251
      GOTO 9999                                                         STRCHN    252
C---------------------------------------------------------------------  STRCHN    253
C                                       Improper channel specification  STRCHN    254
C                                                                       STRCHN    255
 9000 WRITE(LOUT,'(A)')' *** IMPROPER CHANNEL SPECIFICATION ***'        STRCHN    256
      WRITE(LOUT,9100)LINE(1:78)                                        STRCHN    257
      RETURN 1                                                          STRCHN    258
C---------------------------------------------------------------------  STRCHN    259
C                                           Formats and error messages  STRCHN    260
C                                                                       STRCHN    261
 9100 FORMAT(/,1X,A,/)                                                  STRCHN    262
C---------------------------------------------------------------------  STRCHN    263
 9999 RETURN                                                            STRCHN    264
      END                                                               STRCHN    265
C*********************************************************************  STRCHN    266
C                                                                       STRCHN    267
      SUBROUTINE MAKCHN(CTYPE,NTYPE,NSCOL)                              STRCHN    268
C                                                                       STRCHN    269
      CHARACTER*(*) CTYPE                                               STRCHN    270
      CHARACTER*3 TYPE(15)                                              STRCHN    271
C                                                                       STRCHN    272
      DATA TYPE/'GEN','EXC','STA','GOV','IMO','SVC','LOA','LIN'         STRCHN    273
     *,'BUS','DC ','CON','USE','UD ','INT','   '/                       STRCHN    274
C                                                                       STRCHN    275
      NTYPE=0                                                           STRCHN    276
      DO 10 I=1,14                                                      STRCHN    277
   10 IF(CTYPE(1:3).EQ.TYPE(I)) GOTO 20                                 STRCHN    278
      RETURN                                                            STRCHN    279
C                                                                       STRCHN    280
   20 GOTO (110,120,130,140,150,160,170,180,190,200,201,210,210,170) I  STRCHN    281
C                                                                       STRCHN    282
C    GEN                                                                STRCHN    283
C                                                                       STRCHN    284
  110 CONTINUE                                                          STRCHN    285
      NSCOL=2                                                           STRCHN    286
      IF(INDEX(CTYPE,'YVAR').NE.0) NTYPE=55                             STRCHN    287
      IF(INDEX(CTYPE,'STA').NE.0) NTYPE=54                              STRCHN    288
      IF(INDEX(CTYPE,'MTO').NE.0) NTYPE=6                               STRCHN    289
      IF(INDEX(CTYPE,'SPE').NE.0) NTYPE=5                               STRCHN    290
      IF(INDEX(CTYPE,'ANG').NE.0) NTYPE=4                               STRCHN    291
      IF(INDEX(CTYPE,'MX').NE.0) NTYPE=3                                STRCHN    292
      IF(INDEX(CTYPE,'MW').NE.0) NTYPE=2                                STRCHN    293
      IF(INDEX(CTYPE,'ZR').NE.0) NTYPE=11                               STRCHN    294
      IF(INDEX(CTYPE,'ZI').NE.0) NTYPE=12                               STRCHN    295
      IF(NTYPE.NE.0) RETURN                                             STRCHN    296
      IF(INDEX(CTYPE,'REA').NE.0) NTYPE=9                               STRCHN    297
      IF(INDEX(CTYPE,'IMA').NE.0) NTYPE=10                              STRCHN    298
      IF(NTYPE.NE.0) RETURN                                             STRCHN    299
      IF(INDEX(CTYPE,'CUR').NE.0) NTYPE=8                               STRCHN    300
      IF(NTYPE.NE.0) RETURN                                             STRCHN    301
      IF(INDEX(CTYPE,'FIE').NE.0) NTYPE=7                               STRCHN    302
      IF(NTYPE.NE.0) RETURN                                             STRCHN    303
      IF(INDEX(CTYPE,'VT').NE.0) NTYPE=1                                STRCHN    304
      RETURN                                                            STRCHN    305
C                                                                       STRCHN    306
C    EXC                                                                STRCHN    307
C                                                                       STRCHN    308
  120 CONTINUE                                                          STRCHN    309
      NSCOL=2                                                           STRCHN    310
      IF(INDEX(CTYPE,'VREG').NE.0) NTYPE=13                             STRCHN    311
      IF(INDEX(CTYPE,'VUAL').NE.0) NTYPE=15                             STRCHN    312
      RETURN                                                            STRCHN    313
C                                                                       STRCHN    314
C    STA                                                                STRCHN    315
C                                                                       STRCHN    316
  130 CONTINUE                                                          STRCHN    317
      NSCOL=2                                                           STRCHN    318
      NTYPE=14                                                          STRCHN    319
      RETURN                                                            STRCHN    320
C                                                                       STRCHN    321
C    GOV                                                                STRCHN    322
C                                                                       STRCHN    323
  140 CONTINUE                                                          STRCHN    324
      NSCOL=2                                                           STRCHN    325
      IF(INDEX(CTYPE,'GSO').NE.0) NTYPE=16                              STRCHN    326
      IF(INDEX(CTYPE,'FACV').NE.0) NTYPE=17                             STRCHN    327
      IF(INDEX(CTYPE,'FAIV').NE.0) NTYPE=18                             STRCHN    328
      IF(INDEX(CTYPE,'AIV').NE.0) NTYPE=19                              STRCHN    329
      IF(INDEX(CTYPE,'PVP').NE.0) NTYPE=20                              STRCHN    330
      IF(INDEX(CTYPE,'XVS1').NE.0) NTYPE=21                             STRCHN    331
      RETURN                                                            STRCHN    332
C                                                                       STRCHN    333
C    IMO                                                                STRCHN    334
C                                                                       STRCHN    335
  150 CONTINUE                                                          STRCHN    336
      NSCOL=2                                                           STRCHN    337
      IF(INDEX(CTYPE,'VT').NE.0) NTYPE=22                               STRCHN    338
      IF(INDEX(CTYPE,'MW').NE.0) NTYPE=23                               STRCHN    339
      IF(INDEX(CTYPE,'MX').NE.0) NTYPE=24                               STRCHN    340
      IF(INDEX(CTYPE,'SPE').NE.0) NTYPE=25                              STRCHN    341
      IF(INDEX(CTYPE,'CUR').NE.0) NTYPE=26                              STRCHN    342
      IF(INDEX(CTYPE,'MTO').NE.0) NTYPE=27                              STRCHN    343
      RETURN                                                            STRCHN    344
C                                                                       STRCHN    345
C    SVC                                                                STRCHN    346
C                                                                       STRCHN    347
  160 CONTINUE                                                          STRCHN    348
      NSCOL=2                                                           STRCHN    349
      IF(INDEX(CTYPE,'SEN').NE.0)THEN                                   STRCHN    350
         NTYPE=29                                                       STRCHN    351
         RETURN                                                         STRCHN    352
      ENDIF                                                             STRCHN    353
      IF(INDEX(CTYPE,'VT').NE.0) NTYPE=28                               STRCHN    354
      IF(INDEX(CTYPE,'VAR').NE.0) NTYPE=30                              STRCHN    355
      RETURN                                                            STRCHN    356
C                                                                       STRCHN    357
C    LOA                                                                STRCHN    358
C                                                                       STRCHN    359
  170 CONTINUE                                                          STRCHN    360
      NSCOL=1                                                           STRCHN    361
      IF(INDEX(CTYPE,'VT').NE.0) NTYPE=31                               STRCHN    362
      IF(INDEX(CTYPE,'CUR').NE.0) NTYPE=32                              STRCHN    363
      IF(INDEX(CTYPE,'MW').NE.0) NTYPE=33                               STRCHN    364
      IF(INDEX(CTYPE,'MX').NE.0) NTYPE=34                               STRCHN    365
      IF(INDEX(CTYPE,'FRE').NE.0) NTYPE=35                              STRCHN    366
      RETURN                                                            STRCHN    367
C                                                                       STRCHN    368
C    LIN                                                                STRCHN    369
C                                                                       STRCHN    370
  180 CONTINUE                                                          STRCHN    371
      NSCOL=3                                                           STRCHN    372
      IF(INDEX(CTYPE,'MW').NE.0)THEN                                    STRCHN    373
         NTYPE=42                                                       STRCHN    374
         IF(INDEX(CTYPE,'FLOW').NE.0) NTYPE=36                          STRCHN    375
      ENDIF                                                             STRCHN    376
      IF(INDEX(CTYPE,'MX').NE.0)THEN                                    STRCHN    377
         NTYPE=43                                                       STRCHN    378
         IF(INDEX(CTYPE,'FLOW').NE.0) NTYPE=37                          STRCHN    379
      ENDIF                                                             STRCHN    380
      IF(INDEX(CTYPE,'MAG').NE.0) NTYPE=38                              STRCHN    381
      IF(INDEX(CTYPE,'ANG').NE.0) NTYPE=39                              STRCHN    382
      IF(INDEX(CTYPE,'ZR').NE.0) NTYPE=40                               STRCHN    383
      IF(INDEX(CTYPE,'ZI').NE.0) NTYPE=41                               STRCHN    384
      IF(NTYPE.EQ.42.OR.NTYPE.EQ.43)NSCOL=1                             STRCHN    385
      RETURN                                                            STRCHN    386
C                                                                       STRCHN    387
C    BUS                                                                STRCHN    388
C                                                                       STRCHN    389
  190 CONTINUE                                                          STRCHN    390
      NSCOL=1                                                           STRCHN    391
      IF(INDEX(CTYPE,'VT').NE.0) NTYPE=44                               STRCHN    392
      IF(INDEX(CTYPE,'ANG').NE.0) NTYPE=45                              STRCHN    393
      RETURN                                                            STRCHN    394
C                                                                       STRCHN    395
C    CON                                                                STRCHN    396
C                                                                       STRCHN    397
  200 CONTINUE                                                          STRCHN    398
      NSCOL=1                                                           STRCHN    399
      J=INDEX(CTYPE,'AC')                                               STRCHN    400
      IF(J.NE.0) NTYPE=46                                               STRCHN    401
      J=INDEX(CTYPE,'DC')                                               STRCHN    402
      IF(J.NE.0) NTYPE=47                                               STRCHN    403
      J=INDEX(CTYPE,'CU')                                               STRCHN    404
      IF(J.NE.0) NTYPE=48                                               STRCHN    405
      J=INDEX(CTYPE,'AL')                                               STRCHN    406
      IF(J.NE.0) NTYPE=49                                               STRCHN    407
      J=INDEX(CTYPE,'GA')                                               STRCHN    408
      IF(J.NE.0) NTYPE=50                                               STRCHN    409
      J=INDEX(CTYPE,'MW')                                               STRCHN    410
      IF(J.NE.0) NTYPE=51                                               STRCHN    411
      J=INDEX(CTYPE,'MX')                                               STRCHN    412
      IF(J.NE.0) NTYPE=52                                               STRCHN    413
      RETURN                                                            STRCHN    414
C                                                                       STRCHN    415
C    DC                                                                 STRCHN    416
C                                                                       STRCHN    417
  201 CONTINUE                                                          STRCHN    418
      NSCOL=1                                                           STRCHN    419
      J=INDEX(CTYPE,'VT')                                               STRCHN    420
      IF(J.NE.0) NTYPE=53                                               STRCHN    421
      J=INDEX(CTYPE,'BL')                                               STRCHN    422
      IF(J.NE.0) NTYPE=56                                               STRCHN    423
      RETURN                                                            STRCHN    424
C                                                                       STRCHN    425
C    USE,UDE                                                            STRCHN    426
C                                                                       STRCHN    427
  210 CONTINUE                                                          STRCHN    428
      NSCOL=1                                                           STRCHN    429
      J=INDEX(CTYPE,'EXC')                                              STRCHN    430
      IF(J.NE.0) NTYPE=57                                               STRCHN    431
      J=INDEX(CTYPE,'PSS')                                              STRCHN    432
      IF(J.NE.0) NTYPE=58                                               STRCHN    433
      J=INDEX(CTYPE,'UEL')                                              STRCHN    434
      IF(J.NE.0) NTYPE=59                                               STRCHN    435
      J=INDEX(CTYPE,'GOV')                                              STRCHN    436
      IF(J.NE.0) NTYPE=60                                               STRCHN    437
      J=INDEX(CTYPE,'SVC')                                              STRCHN    438
      IF(J.NE.0) NTYPE=61                                               STRCHN    439
      J=INDEX(CTYPE,'TCSC')                                             STRCHN    440
      IF(J.NE.0) NTYPE=62                                               STRCHN    441
      J=INDEX(CTYPE,'TCTC')                                             STRCHN    442
      IF(J.NE.0) NTYPE=63                                               STRCHN    443
      J=INDEX(CTYPE,'TCPR')                                             STRCHN    444
      IF(J.NE.0) NTYPE=64                                               STRCHN    445
      J=INDEX(CTYPE,'TCBR')                                             STRCHN    446
      IF(J.NE.0) NTYPE=65                                               STRCHN    447
C                                                                       STRCHN    448
      RETURN                                                            STRCHN    449
      END                                                               STRCHN    450
C*********************************************************************  STRCHN    451
C                                                                       STRCHN    452
      SUBROUTINE UPCAS1(CTYPE,I)                                        STRCHN    453
      CHARACTER*(*) CTYPE                                               STRCHN    454
      IA=ICHAR('A')                                                     STRCHN    455
      JA=ICHAR('a')                                                     STRCHN    456
      JZ=ICHAR('z')                                                     STRCHN    457
      DO 10 J=1,I                                                       STRCHN    458
      IC=ICHAR(CTYPE(J:J))                                              STRCHN    459
      IF(IC.GE.JA.AND.IC.LE.JZ) CTYPE(J:J)=CHAR(IC-JA+IA)               STRCHN    460
   10 CONTINUE                                                          STRCHN    461
C                                                                       STRCHN    462
      RETURN                                                            STRCHN    463
      END                                                               STRCHN    464
