CFPRIME URGETX                                                          URGETX      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  URGETX (REAL, STRING, KIND, FOUND)                    URGETX      3
CD -------------------------------------------------------------------  URGETX      4
CD                                                                      URGETX      5
CD              *****     URGETX  ROUTINE   *****                       URGETX      6
CD                                                                      URGETX      7
CD -------------------------------------------------------------------  URGETX      8
CD                                                                      URGETX      9
CD       PURPOSE:  This subroutine retrieves either a real value or     URGETX     10
CD                 character string from a buffer.  The delimiter used  URGETX     11
CD                 is a comma.  The type of the data is indicated in    URGETX     12
CD                 KIND.  If valid data is found, then FOUND is true.   URGETX     13
CD                 If end of line character is found, then ENDBLK is    URGETX     14
CD                 true.                                                URGETX     15
CD                                                                      URGETX     16
CD                                                                      URGETX     17
CD       DEFINITION OF LOCAL VARIABLES:                                 URGETX     18
CD                 COMMNT -  indicates if following information is      URGETX     19
CD                           a comment.                                 URGETX     20
CD                 EXP    -  indicates real is in exponential form.     URGETX     21
CD          (P)    FOUND  -  indicates valid data was found.            URGETX     22
CD                 I      - 'do' loop index.                            URGETX     23
CD                 IO     -  io status after changing character to      URGETX     24
CD                           real.                                      URGETX     25
CD                 IOS    -  io status after read from input file.      URGETX     26
CD                 J      - 'do' loop index.                            URGETX     27
CD          (P)    KIND   -  indicates if valid character or real.      URGETX     28
CD                 LENSTR -  length of character input string.          URGETX     29
CD                 NEW    -  contains the right-justified string.       URGETX     30
CD          (P)    REAL   -  real value, if valid.                      URGETX     31
CD          (P)    STRING -  character input string.                    URGETX     32
CD                 SUBNAM -  subroutine name.                           URGETX     33
CD                                                                      URGETX     34
CD -------------------------------------------------------------------  URGETX     35
C                                                                       URGETX     36
      INCLUDE 'CNUNIT.INS'                                              URGETX     37
      INCLUDE 'CNMSG.INS'                                               URGETX     38
      INCLUDE 'PARX.INS'                                                URGETX     39
      INCLUDE 'UDCA.INS'                                                URGETX     40
      INCLUDE 'UDCH.INS'                                                URGETX     41
C                                                                       URGETX     42
      LOGICAL       DECMAL, ERROR, QUOTE                                URGETX     43
      LOGICAL       CHAR, COMMNT, DEC, DOUBLE, EXP, FOUND               URGETX     44
C                                                                       URGETX     45
      CHARACTER*72  NEW, STRING                                         URGETX     46
      CHARACTER*20  SUBNAM                                              URGETX     47
      CHARACTER*4   KIND                                                URGETX     48
C                                                                       URGETX     49
C---------------------------------------------------------------------  URGETX     50
C                                                                       URGETX     51
      IF (SDBG) THEN                                                    URGETX     52
         SUBNAM = 'URGETX ROUTINE.'                                     URGETX     53
      ELSE                                                              URGETX     54
         SUBNAM = ' '                                                   URGETX     55
      END IF                                                            URGETX     56
C                                                                       URGETX     57
C                                                                       URGETX     58
      EOF = .FALSE.                                                     URGETX     59
      FOUND = .FALSE.                                                   URGETX     60
      ENDBLK = .FALSE.                                                  URGETX     61
      COMMNT = .FALSE.                                                  URGETX     62
      EXP = .FALSE.                                                     URGETX     63
      DEC = .FALSE.                                                     URGETX     64
      DOUBLE = .FALSE.                                                  URGETX     65
      CHAR = .FALSE.                                                    URGETX     66
      LENSTR = 0                                                        URGETX     67
      DO 20 I = 1, 72                                                   URGETX     68
         STRING(I:I) = ' '                                              URGETX     69
20    CONTINUE                                                          URGETX     70
C                                                                       URGETX     71
C     Check if the remainder of the card is blank.                      URGETX     72
C                                                                       URGETX     73
      IF (IPOSN .GT. 0) THEN                                            URGETX     74
         FOUND = .FALSE.                                                URGETX     75
         DO 40 I = IPOSN, 80                                            URGETX     76
            IF (BUFFER(I:I) .NE. ' ') FOUND = .TRUE.                    URGETX     77
40       CONTINUE                                                       URGETX     78
         IF (.NOT. FOUND) THEN                                          URGETX     79
            READ (INFILE,9002,IOSTAT=IOS) BUFFER                        URGETX     80
            IF (IOS.LT.0) THEN                                          URGETX     81
               EOF = .TRUE.                                             URGETX     82
               ENDBLK = .TRUE.                                          URGETX     83
            END IF                                                      URGETX     84
            IPOSN = 0                                                   URGETX     85
         END IF                                                         URGETX     86
      END IF                                                            URGETX     87
C                                                                       URGETX     88
      FOUND = .FALSE.                                                   URGETX     89
C                                                                       URGETX     90
C     Remove the character string.                                      URGETX     91
C                                                                       URGETX     92
60    IF (FOUND .OR. ENDBLK .OR. EOF) GO TO 80                          URGETX     93
C                                                                       URGETX     94
         IPOSN = IPOSN + 1                                              URGETX     95
C                                                                       URGETX     96
         IF (IPOSN .GT. 80) THEN                                        URGETX     97
C                                                                       URGETX     98
C           No string remains on this card, read next card.             URGETX     99
C                                                                       URGETX    100
            READ (INFILE,9002,IOSTAT=IOS) BUFFER                        URGETX    101
            IF (IOS.LT.0) THEN                                          URGETX    102
               EOF = .TRUE.                                             URGETX    103
               ENDBLK = .TRUE.                                          URGETX    104
            END IF                                                      URGETX    105
            IPOSN = 0                                                   URGETX    106
C                                                                       URGETX    107
         ELSE IF (BUFFER(IPOSN:IPOSN) .EQ. '*') THEN                    URGETX    108
C                                                                       URGETX    109
C           Change comment status.                                      URGETX    110
C                                                                       URGETX    111
            COMMNT = .NOT. COMMNT                                       URGETX    112
C                                                                       URGETX    113
         ELSE IF (COMMNT) THEN                                          URGETX    114
C                                                                       URGETX    115
C           Ignore buffer character.                                    URGETX    116
C                                                                       URGETX    117
         ELSE IF (BUFFER(IPOSN:IPOSN) .EQ. ':') THEN                    URGETX    118
C                                                                       URGETX    119
C           End of data for this type.                                  URGETX    120
C                                                                       URGETX    121
            ENDBLK = .TRUE.                                             URGETX    122
            IF (LENSTR .GT. 0) FOUND = .TRUE.                           URGETX    123
C                                                                       URGETX    124
         ELSE IF (BUFFER(IPOSN:IPOSN) .EQ. ',') THEN                    URGETX    125
C                                                                       URGETX    126
C           End of string encountered.                                  URGETX    127
C                                                                       URGETX    128
            FOUND = .TRUE.                                              URGETX    129
C                                                                       URGETX    130
         ELSE IF (BUFFER(IPOSN:IPOSN) .EQ. ' ') THEN                    URGETX    131
C                                                                       URGETX    132
C           Ignore all preceding blanks.                                URGETX    133
C                                                                       URGETX    134
            IF (LENSTR .GE. 72) THEN                                    URGETX    135
               WRITE (MSG(1),9004) SUBNAM                               URGETX    136
               WRITE(MSG(2),9400)                                       URGETX    137
               WRITE(MSG(3),9410)                                       URGETX    138
               WRITE(MSG(4),9420)                                       URGETX    139
               WRITE(MSG(5),9430) STRING(1:40)                          URGETX    140
               WRITE(MSG(6),9440)                                       URGETX    141
               WRITE(MSG(7),9450)                                       URGETX    142
               WRITE(MSG(8),9460)                                       URGETX    143
               CALL PRTMSG(8)                                           URGETX    144
               FOUND = .TRUE.                                           URGETX    145
            ELSE IF (LENSTR .GT. 0) THEN                                URGETX    146
               LENSTR = LENSTR + 1                                      URGETX    147
               STRING(LENSTR:LENSTR) = BUFFER(IPOSN:IPOSN)              URGETX    148
            END IF                                                      URGETX    149
C                                                                       URGETX    150
         ELSE IF (BUFFER(IPOSN:IPOSN) .EQ. '%') THEN                    URGETX    151
C                                                                       URGETX    152
C           Ignore string.                                              URGETX    153
C                                                                       URGETX    154
            STRING = '%'                                                URGETX    155
            LENSTR = 1                                                  URGETX    156
         ELSE                                                           URGETX    157
C                                                                       URGETX    158
            IF (.NOT. CHAR) THEN                                        URGETX    159
               IF (BUFFER(IPOSN:IPOSN) .EQ. 'D') THEN                   URGETX    160
                  IF(LENSTR.EQ.0)THEN                                   URGETX    161
                     CHAR=.TRUE.                                        URGETX    162
                     DOUBLE=.FALSE.                                     URGETX    163
                  ELSEIF(DOUBLE)THEN                                    URGETX    164
                     CHAR = .TRUE.                                      URGETX    165
                     DOUBLE = .FALSE.                                   URGETX    166
                  ELSE                                                  URGETX    167
                     DOUBLE = .TRUE.                                    URGETX    168
                  END IF                                                URGETX    169
               ELSE IF (BUFFER(IPOSN:IPOSN) .EQ. 'E') THEN              URGETX    170
                  IF(LENSTR.EQ.0)THEN                                   URGETX    171
                     CHAR=.TRUE.                                        URGETX    172
                     EXP=.FALSE.                                        URGETX    173
                  ELSEIF (EXP) THEN                                     URGETX    174
                     CHAR = .TRUE.                                      URGETX    175
                     EXP = .FALSE.                                      URGETX    176
                  ELSE                                                  URGETX    177
                     EXP = .TRUE.                                       URGETX    178
                  END IF                                                URGETX    179
               ELSE IF (BUFFER(IPOSN:IPOSN) .EQ. '.') THEN              URGETX    180
                  IF (DEC) THEN                                         URGETX    181
                     CHAR = .TRUE.                                      URGETX    182
                     DEC = .FALSE.                                      URGETX    183
                  ELSE IF (.NOT. CHAR) THEN                             URGETX    184
                     DEC = .TRUE.                                       URGETX    185
                  END IF                                                URGETX    186
               ELSE IF ((BUFFER(IPOSN:IPOSN) .LT. '0' .OR.              URGETX    187
     1             BUFFER(IPOSN:IPOSN) .GT. '9') .AND.                  URGETX    188
     2             BUFFER(IPOSN:IPOSN) .NE. '+' .AND.                   URGETX    189
     3             BUFFER(IPOSN:IPOSN) .NE. '-') THEN                   URGETX    190
                  CHAR = .TRUE.                                         URGETX    191
               END IF                                                   URGETX    192
            END IF                                                      URGETX    193
C                                                                       URGETX    194
C           Add current character to the string.                        URGETX    195
C                                                                       URGETX    196
            IF (LENSTR .GE. 72) THEN                                    URGETX    197
               WRITE (MSG(1),9004) SUBNAM                               URGETX    198
               WRITE(MSG(2),9400)                                       URGETX    199
               WRITE(MSG(3),9410)                                       URGETX    200
               WRITE(MSG(4),9420)                                       URGETX    201
               WRITE(MSG(5),9430) STRING(1:40)                          URGETX    202
               WRITE(MSG(6),9440)                                       URGETX    203
               WRITE(MSG(7),9450)                                       URGETX    204
               WRITE(MSG(8),9460)                                       URGETX    205
               CALL PRTMSG(8)                                           URGETX    206
               FOUND = .TRUE.                                           URGETX    207
            ELSE                                                        URGETX    208
               IF (BUFFER(IPOSN:IPOSN) .EQ. '#') THEN                   URGETX    209
                  BUFFER(IPOSN:IPOSN) = ' '                             URGETX    210
               END IF                                                   URGETX    211
               LENSTR = LENSTR + 1                                      URGETX    212
               STRING(LENSTR:LENSTR) = BUFFER(IPOSN:IPOSN)              URGETX    213
            END IF                                                      URGETX    214
C                                                                       URGETX    215
         END IF                                                         URGETX    216
C                                                                       URGETX    217
         GO TO 60                                                       URGETX    218
80    CONTINUE                                                          URGETX    219
C                                                                       URGETX    220
      IF (LENSTR .LE. 0) THEN                                           URGETX    221
         KIND = ' '                                                     URGETX    222
         FOUND = .FALSE.                                                URGETX    223
C                                                                       URGETX    224
      ELSE IF (STRING .EQ. '%') THEN                                    URGETX    225
         KIND = 'RECH'                                                  URGETX    226
C                                                                       URGETX    227
      ELSE IF (LENSTR .GT. 12) THEN                                     URGETX    228
C                                                                       URGETX    229
         KIND = 'CHAR'                                                  URGETX    230
         FOUND = .TRUE.                                                 URGETX    231
      ELSEIF(CHAR)THEN                                                  URGETX    232
         KIND='CHAR'                                                    URGETX    233
         FOUND=.TRUE.                                                   URGETX    234
      ELSE                                                              URGETX    235
C                                                                       URGETX    236
C        Right justify string.                                          URGETX    237
C                                                                       URGETX    238
         J = 12                                                         URGETX    239
         NEW = ' '                                                      URGETX    240
         DO 100 I = 12, 1, -1                                           URGETX    241
            IF (STRING(I:I) .NE. ' ') THEN                              URGETX    242
               NEW(J:J) = STRING(I:I)                                   URGETX    243
               J = J - 1                                                URGETX    244
            END IF                                                      URGETX    245
100      CONTINUE                                                       URGETX    246
C                                                                       URGETX    247
         IF (EXP) THEN                                                  URGETX    248
            READ (NEW,9006,IOSTAT=IO) REAL                              URGETX    249
         ELSE                                                           URGETX    250
            READ (NEW,9008,IOSTAT=IO) REAL                              URGETX    251
         END IF                                                         URGETX    252
         IF (IO .GT. 0) THEN                                            URGETX    253
            KIND = 'CHAR'                                               URGETX    254
         ELSE                                                           URGETX    255
            KIND = 'REAL'                                               URGETX    256
         END IF                                                         URGETX    257
C                                                                       URGETX    258
      END IF                                                            URGETX    259
C                                                                       URGETX    260
C                                                                       URGETX    261
      IF (ENDBLK .AND. .NOT. EOF) THEN                                  URGETX    262
         READ (INFILE,9002,IOSTAT=IOS) BUFFER                           URGETX    263
         IF (IOS.LT.0) THEN                                             URGETX    264
            EOF = .TRUE.                                                URGETX    265
            ENDBLK = .TRUE.                                             URGETX    266
         END IF                                                         URGETX    267
         IPOSN = 0                                                      URGETX    268
      END IF                                                            URGETX    269
C                                                                       URGETX    270
      RETURN                                                            URGETX    271
C                                                                       URGETX    272
9002  FORMAT (A80)                                                      URGETX    273
9006  FORMAT (E12.5)                                                    URGETX    274
9008  FORMAT (F12.0)                                                    URGETX    275
C                                                                       URGETX    276
C---------------------------------------------------------------------  URGETX    277
C                                                                       URGETX    278
      ENTRY URGETR (REAL, STRING, FOUND)                                URGETX    279
CD -------------------------------------------------------------------  URGETX    280
CD                                                                      URGETX    281
CD              *****     URGETR  ROUTINE   *****                       URGETX    282
CD                                                                      URGETX    283
CD -------------------------------------------------------------------  URGETX    284
CD                                                                      URGETX    285
CD       PURPOSE:  This subroutine retrieves an real value from         URGETX    286
CD                 a buffer.  The delimiter used is a comma.  If there  URGETX    287
CD                 is a real found, then FOUND is true.  If end of file URGETX    288
CD                 is found, then ENDBLK is true.                       URGETX    289
CD                                                                      URGETX    290
CD -------------------------------------------------------------------  URGETX    291
C                                                                       URGETX    292
      EOF = .FALSE.                                                     URGETX    293
      FOUND = .FALSE.                                                   URGETX    294
      ENDBLK = .FALSE.                                                  URGETX    295
      COMMNT = .FALSE.                                                  URGETX    296
      EXP = .FALSE.                                                     URGETX    297
      CHAR = .FALSE.                                                    URGETX    298
      DOUBLE = .FALSE.                                                  URGETX    299
      DEC = .FALSE.                                                     URGETX    300
      LENSTR = 0                                                        URGETX    301
      STRING = ' '                                                      URGETX    302
C                                                                       URGETX    303
C     Check if the remainder of the card is blank.                      URGETX    304
C                                                                       URGETX    305
      IF (IPOSN .GT. 0) THEN                                            URGETX    306
         FOUND = .FALSE.                                                URGETX    307
         DO 220 I = IPOSN, 80                                           URGETX    308
            IF (BUFFER(I:I) .NE. ' ') FOUND = .TRUE.                    URGETX    309
220      CONTINUE                                                       URGETX    310
         IF (.NOT. FOUND) THEN                                          URGETX    311
            READ (INFILE,9202,IOSTAT=IOS) BUFFER                        URGETX    312
            IF (IOS.LT.0) THEN                                          URGETX    313
               EOF = .TRUE.                                             URGETX    314
               ENDBLK = .TRUE.                                          URGETX    315
            END IF                                                      URGETX    316
            IPOSN = 0                                                   URGETX    317
         END IF                                                         URGETX    318
      END IF                                                            URGETX    319
C                                                                       URGETX    320
      FOUND = .FALSE.                                                   URGETX    321
C                                                                       URGETX    322
C     Remove the character string.                                      URGETX    323
C                                                                       URGETX    324
240   IF (FOUND .OR. ENDBLK .OR. EOF) GO TO 260                         URGETX    325
C                                                                       URGETX    326
         IPOSN = IPOSN + 1                                              URGETX    327
C                                                                       URGETX    328
         IF (IPOSN .GT. 80) THEN                                        URGETX    329
C                                                                       URGETX    330
C           No string remains on this card, read next card.             URGETX    331
C                                                                       URGETX    332
            READ (INFILE,9102,IOSTAT=IOS) BUFFER                        URGETX    333
            IF (IOS.LT.0) THEN                                          URGETX    334
               EOF = .TRUE.                                             URGETX    335
               ENDBLK = .TRUE.                                          URGETX    336
            END IF                                                      URGETX    337
            IPOSN = 0                                                   URGETX    338
C                                                                       URGETX    339
         ELSE IF (BUFFER(IPOSN:IPOSN) .EQ. '*') THEN                    URGETX    340
C                                                                       URGETX    341
            COMMNT = .NOT. COMMNT                                       URGETX    342
C                                                                       URGETX    343
         ELSE IF (COMMNT) THEN                                          URGETX    344
C                                                                       URGETX    345
         ELSE IF (BUFFER(IPOSN:IPOSN) .EQ. ':') THEN                    URGETX    346
C                                                                       URGETX    347
C           End of data for this type.                                  URGETX    348
C                                                                       URGETX    349
            ENDBLK = .TRUE.                                             URGETX    350
            IF (LENSTR .GT. 0) FOUND = .TRUE.                           URGETX    351
C                                                                       URGETX    352
         ELSE IF (BUFFER(IPOSN:IPOSN) .EQ. ',') THEN                    URGETX    353
C                                                                       URGETX    354
C           End of string encountered.                                  URGETX    355
C                                                                       URGETX    356
            FOUND = .TRUE.                                              URGETX    357
C                                                                       URGETX    358
         ELSE IF (BUFFER(IPOSN:IPOSN) .EQ. ' ') THEN                    URGETX    359
C                                                                       URGETX    360
C           Ignore all blanks.                                          URGETX    361
C                                                                       URGETX    362
         ELSE IF (BUFFER(IPOSN:IPOSN) .EQ. '%') THEN                    URGETX    363
C                                                                       URGETX    364
C           Ignore string.                                              URGETX    365
C                                                                       URGETX    366
            STRING = '%'                                                URGETX    367
            LENSTR = 1                                                  URGETX    368
C                                                                       URGETX    369
         ELSE                                                           URGETX    370
            IF (.NOT. CHAR) THEN                                        URGETX    371
               IF (BUFFER(IPOSN:IPOSN) .EQ. 'D') THEN                   URGETX    372
                  IF (DOUBLE) THEN                                      URGETX    373
                     CHAR = .TRUE.                                      URGETX    374
                     DOUBLE = .FALSE.                                   URGETX    375
                  ELSE                                                  URGETX    376
                     DOUBLE = .TRUE.                                    URGETX    377
                  END IF                                                URGETX    378
               ELSE IF (BUFFER(IPOSN:IPOSN) .EQ. 'E') THEN              URGETX    379
                  IF (EXP) THEN                                         URGETX    380
                     CHAR = .TRUE.                                      URGETX    381
                     EXP = .FALSE.                                      URGETX    382
                  ELSE                                                  URGETX    383
                     EXP = .TRUE.                                       URGETX    384
                  END IF                                                URGETX    385
               ELSE IF (BUFFER(IPOSN:IPOSN) .EQ. '.') THEN              URGETX    386
                  IF (DEC) THEN                                         URGETX    387
                     CHAR = .TRUE.                                      URGETX    388
                     DEC = .FALSE.                                      URGETX    389
                  ELSE                                                  URGETX    390
                     DEC = .TRUE.                                       URGETX    391
                  END IF                                                URGETX    392
               ELSE IF ((BUFFER(IPOSN:IPOSN) .LT. '0' .OR.              URGETX    393
     1            BUFFER(IPOSN:IPOSN) .GT. '9') .AND.                   URGETX    394
     2            BUFFER(IPOSN:IPOSN) .NE. '+' .AND.                    URGETX    395
     3            BUFFER(IPOSN:IPOSN) .NE. '-') THEN                    URGETX    396
                  CHAR = .TRUE.                                         URGETX    397
               END IF                                                   URGETX    398
            END IF                                                      URGETX    399
C                                                                       URGETX    400
C           Add current character to the string.                        URGETX    401
C                                                                       URGETX    402
            LENSTR = LENSTR + 1                                         URGETX    403
            STRING(LENSTR:LENSTR) = BUFFER(IPOSN:IPOSN)                 URGETX    404
C                                                                       URGETX    405
         END IF                                                         URGETX    406
C                                                                       URGETX    407
         GO TO 240                                                      URGETX    408
260   CONTINUE                                                          URGETX    409
C                                                                       URGETX    410
      IF (CHAR) THEN                                                    URGETX    411
         FOUND = .FALSE.                                                URGETX    412
      ELSE IF (STRING .NE. '%' .AND. LENSTR .GT. 0 .AND.                URGETX    413
     1         LENSTR .LE. 12) THEN                                     URGETX    414
C                                                                       URGETX    415
C        Right justify string.                                          URGETX    416
C                                                                       URGETX    417
         J = 12                                                         URGETX    418
         NEW = ' '                                                      URGETX    419
         DO 280 I = 12, 1, -1                                           URGETX    420
            IF (STRING(I:I) .NE. ' ') THEN                              URGETX    421
               NEW(J:J) = STRING(I:I)                                   URGETX    422
               J = J - 1                                                URGETX    423
            END IF                                                      URGETX    424
280      CONTINUE                                                       URGETX    425
C                                                                       URGETX    426
         IF (EXP) THEN                                                  URGETX    427
            READ (NEW,9104,IOSTAT=IO) REAL                              URGETX    428
         ELSE                                                           URGETX    429
            READ (NEW,9106,IOSTAT=IO) REAL                              URGETX    430
         END IF                                                         URGETX    431
         IF (IO .GT. 0) FOUND = .FALSE.                                 URGETX    432
C                                                                       URGETX    433
      ELSE                                                              URGETX    434
         FOUND = .FALSE.                                                URGETX    435
      END IF                                                            URGETX    436
C                                                                       URGETX    437
C                                                                       URGETX    438
      IF (ENDBLK .AND. .NOT. EOF) THEN                                  URGETX    439
         READ (INFILE,9102,IOSTAT=IOS) BUFFER                           URGETX    440
         IF (IOS.LT.0) THEN                                             URGETX    441
            EOF = .TRUE.                                                URGETX    442
            ENDBLK = .TRUE.                                             URGETX    443
         END IF                                                         URGETX    444
         IPOSN = 0                                                      URGETX    445
      END IF                                                            URGETX    446
C                                                                       URGETX    447
      RETURN                                                            URGETX    448
C                                                                       URGETX    449
9102  FORMAT (A80)                                                      URGETX    450
9104  FORMAT (E12.5)                                                    URGETX    451
9106  FORMAT (F12.0)                                                    URGETX    452
C                                                                       URGETX    453
C---------------------------------------------------------------------  URGETX    454
C                                                                       URGETX    455
      ENTRY URGETI (INTG, STRING, FOUND)                                URGETX    456
CD -------------------------------------------------------------------  URGETX    457
CD                                                                      URGETX    458
CD              *****     URGETI  ROUTINE   *****                       URGETX    459
CD                                                                      URGETX    460
CD -------------------------------------------------------------------  URGETX    461
CD                                                                      URGETX    462
CD       PURPOSE:  This subroutine retrieves an integer value from      URGETX    463
CD                 a buffer.  The delimiter used is a comma.  If there  URGETX    464
CD                 is an integer found, then FOUND is true.  If end of  URGETX    465
CD                 line character if found, then ENDBLK is true.        URGETX    466
CD                                                                      URGETX    467
CD -------------------------------------------------------------------  URGETX    468
C                                                                       URGETX    469
      IF (SDBG) THEN                                                    URGETX    470
         SUBNAM = 'URGETI ROUTINE.'                                     URGETX    471
      ELSE                                                              URGETX    472
         SUBNAM = ' '                                                   URGETX    473
      END IF                                                            URGETX    474
C                                                                       URGETX    475
      COMMNT = .FALSE.                                                  URGETX    476
      DECMAL = .FALSE.                                                  URGETX    477
      ENDBLK = .FALSE.                                                  URGETX    478
      ERROR = .FALSE.                                                   URGETX    479
      EOF = .FALSE.                                                     URGETX    480
      FOUND = .FALSE.                                                   URGETX    481
      LENSTR = 0                                                        URGETX    482
      STRING = ' '                                                      URGETX    483
C                                                                       URGETX    484
C     Check if the remainder of the card is blank.                      URGETX    485
C                                                                       URGETX    486
      IF (IPOSN .GT. 0) THEN                                            URGETX    487
         FOUND = .FALSE.                                                URGETX    488
         DO 320 I = IPOSN, 80                                           URGETX    489
            IF (BUFFER(I:I) .NE. ' ') FOUND = .TRUE.                    URGETX    490
320      CONTINUE                                                       URGETX    491
         IF (.NOT. FOUND) THEN                                          URGETX    492
            READ (INFILE,9202,IOSTAT=IOS) BUFFER                        URGETX    493
            IF (IOS.LT.0) THEN                                          URGETX    494
               EOF = .TRUE.                                             URGETX    495
               ENDBLK = .TRUE.                                          URGETX    496
            END IF                                                      URGETX    497
            IPOSN = 0                                                   URGETX    498
         END IF                                                         URGETX    499
      END IF                                                            URGETX    500
C                                                                       URGETX    501
      FOUND = .FALSE.                                                   URGETX    502
C                                                                       URGETX    503
C     Remove the character string.                                      URGETX    504
C                                                                       URGETX    505
340   IF (FOUND .OR. ENDBLK .OR. EOF) GO TO 360                         URGETX    506
C                                                                       URGETX    507
         IPOSN = IPOSN + 1                                              URGETX    508
C                                                                       URGETX    509
         IF (IPOSN .GT. 80) THEN                                        URGETX    510
C                                                                       URGETX    511
            READ (INFILE,9002,IOSTAT=IOS) BUFFER                        URGETX    512
            IF (IOS.LT.0) THEN                                          URGETX    513
               EOF = .TRUE.                                             URGETX    514
               ENDBLK = .TRUE.                                          URGETX    515
            END IF                                                      URGETX    516
            IPOSN = 0                                                   URGETX    517
C                                                                       URGETX    518
         ELSE IF (BUFFER(IPOSN:IPOSN) .EQ. '*') THEN                    URGETX    519
            COMMNT = .NOT. COMMNT                                       URGETX    520
C                                                                       URGETX    521
         ELSE IF (COMMNT) THEN                                          URGETX    522
C                                                                       URGETX    523
         ELSE IF (BUFFER(IPOSN:IPOSN) .EQ. ':') THEN                    URGETX    524
            ENDBLK = .TRUE.                                             URGETX    525
            IF (LENSTR .GT. 0)  FOUND = .TRUE.                          URGETX    526
C                                                                       URGETX    527
         ELSE IF (BUFFER(IPOSN:IPOSN) .EQ. ',') THEN                    URGETX    528
C                                                                       URGETX    529
C           End of string encountered.                                  URGETX    530
C                                                                       URGETX    531
            FOUND = .TRUE.                                              URGETX    532
C                                                                       URGETX    533
         ELSE IF (.NOT. ERROR) THEN                                     URGETX    534
            IF (BUFFER(IPOSN:IPOSN) .EQ. ' ') THEN                      URGETX    535
C                                                                       URGETX    536
C              Ignore all blanks.                                       URGETX    537
C                                                                       URGETX    538
            ELSE IF (BUFFER(IPOSN:IPOSN) .EQ. '.') THEN                 URGETX    539
C                                                                       URGETX    540
C              Note that a decimal is found in the string.              URGETX    541
C                                                                       URGETX    542
               DECMAL = .TRUE.                                          URGETX    543
C                                                                       URGETX    544
C                                                                       URGETX    545
C              Add current character to the string.                     URGETX    546
C                                                                       URGETX    547
               LENSTR = LENSTR + 1                                      URGETX    548
               STRING(LENSTR:LENSTR) = BUFFER(IPOSN:IPOSN)              URGETX    549
C                                                                       URGETX    550
C                                                                       URGETX    551
            ELSE IF (BUFFER(IPOSN:IPOSN) .EQ. '%') THEN                 URGETX    552
C                                                                       URGETX    553
C              Ignore string.                                           URGETX    554
C                                                                       URGETX    555
               STRING = '%'                                             URGETX    556
               LENSTR = 1                                               URGETX    557
C                                                                       URGETX    558
            ELSE IF ((BUFFER (IPOSN:IPOSN) .GE. '0' .AND.               URGETX    559
     1               BUFFER(IPOSN:IPOSN) .LE. '9') .OR.                 URGETX    560
     2               BUFFER(IPOSN:IPOSN) .EQ. '+' .OR.                  URGETX    561
     3               BUFFER(IPOSN:IPOSN) .EQ. '-') THEN                 URGETX    562
C                                                                       URGETX    563
C              Add current character to the string.                     URGETX    564
C                                                                       URGETX    565
               LENSTR = LENSTR + 1                                      URGETX    566
               STRING(LENSTR:LENSTR) = BUFFER(IPOSN:IPOSN)              URGETX    567
C                                                                       URGETX    568
            ELSE                                                        URGETX    569
C                                                                       URGETX    570
               ERROR = .TRUE.                                           URGETX    571
            END IF                                                      URGETX    572
C                                                                       URGETX    573
         END IF                                                         URGETX    574
C                                                                       URGETX    575
         GO TO 340                                                      URGETX    576
360   CONTINUE                                                          URGETX    577
C                                                                       URGETX    578
      IF (ERROR) THEN                                                   URGETX    579
         FOUND = .FALSE.                                                URGETX    580
      END IF                                                            URGETX    581
C                                                                       URGETX    582
      IF (FOUND .AND. STRING .NE. '%') THEN                             URGETX    583
C                                                                       URGETX    584
C        Right justify string.                                          URGETX    585
C                                                                       URGETX    586
         J = 12                                                         URGETX    587
         NEW = ' '                                                      URGETX    588
         DO 380 I = 12, 1, -1                                           URGETX    589
            IF (STRING(I:I) .NE. ' ') THEN                              URGETX    590
               NEW(J:J) = STRING(I:I)                                   URGETX    591
               J = J - 1                                                URGETX    592
            END IF                                                      URGETX    593
380       CONTINUE                                                      URGETX    594
C                                                                       URGETX    595
         IF (DECMAL) THEN                                               URGETX    596
            READ (NEW,9204,IOSTAT=IO) REAL1                             URGETX    597
            IF (IO .GT. 0) THEN                                         URGETX    598
               FOUND = .FALSE.                                          URGETX    599
            ELSE                                                        URGETX    600
               INTG = INT(REAL1)                                        URGETX    601
               IF (INTG .NE. REAL1) THEN                                URGETX    602
                  FOUND = .FALSE.                                       URGETX    603
               WRITE (MSG(1),9004) SUBNAM                               URGETX    604
               WRITE(MSG(3),9480) REAL1                                 URGETX    605
               WRITE(MSG(2),9470)                                       URGETX    606
               WRITE(MSG(4),9490)                                       URGETX    607
               CALL PRTMSG(4)                                           URGETX    608
                  IERCNT = IERCNT + 1                                   URGETX    609
               END IF                                                   URGETX    610
            END IF                                                      URGETX    611
         ELSE                                                           URGETX    612
            READ (NEW,9208,IOSTAT=IO) INTG                              URGETX    613
            IF (IO .GT. 0) FOUND = .FALSE.                              URGETX    614
         END IF                                                         URGETX    615
C                                                                       URGETX    616
      END IF                                                            URGETX    617
C                                                                       URGETX    618
C                                                                       URGETX    619
      IF (ENDBLK .AND. .NOT. EOF) THEN                                  URGETX    620
         READ (INFILE,9202,IOSTAT=IOS) BUFFER                           URGETX    621
         IF (IOS.LT.0) THEN                                             URGETX    622
            EOF = .TRUE.                                                URGETX    623
            ENDBLK = .TRUE.                                             URGETX    624
         END IF                                                         URGETX    625
         IPOSN = 0                                                      URGETX    626
      END IF                                                            URGETX    627
C                                                                       URGETX    628
      RETURN                                                            URGETX    629
C                                                                       URGETX    630
9202  FORMAT (A80)                                                      URGETX    631
9204  FORMAT (F12.0)                                                    URGETX    632
9208  FORMAT (I12)                                                      URGETX    633
C                                                                       URGETX    634
C---------------------------------------------------------------------  URGETX    635
C                                                                       URGETX    636
      ENTRY URGETC (STRING, FOUND)                                      URGETX    637
CD -------------------------------------------------------------------  URGETX    638
CD                                                                      URGETX    639
CD              *****     URGETCD ROUTINE   *****                       URGETX    640
CD                                                                      URGETX    641
CD -------------------------------------------------------------------  URGETX    642
CD                                                                      URGETX    643
CD       PURPOSE:  This subroutine retrieves a character string from    URGETX    644
CD                 a buffer.  The delimiter used is a comma.  If there  URGETX    645
CD                 is a string found, then FOUND is true.  If the end   URGETX    646
CD                 of line character is found, then ENDBLK is true.     URGETX    647
CD                                                                      URGETX    648
CD -------------------------------------------------------------------  URGETX    649
C                                                                       URGETX    650
      IF(SDBG)THEN                                                      URGETX    651
         SUBNAM = 'URGETC ROUTINE.'                                     URGETX    652
      ELSE                                                              URGETX    653
         SUBNAM = ' '                                                   URGETX    654
      ENDIF                                                             URGETX    655
C                                                                       URGETX    656
C                                                                       URGETX    657
      EOF =.FALSE.                                                      URGETX    658
      FOUND =.FALSE.                                                    URGETX    659
      COMMNT =.FALSE.                                                   URGETX    660
      ENDBLK =.FALSE.                                                   URGETX    661
      QUOTE = .FALSE.                                                   URGETX    662
      LENSTR = 0                                                        URGETX    663
C                                                                       URGETX    664
      DO 420 I = 1, 72                                                  URGETX    665
         STRING(I:I) = ' '                                              URGETX    666
420    CONTINUE                                                         URGETX    667
C                                                                       URGETX    668
C     Check is remainder of card is blank.                              URGETX    669
C                                                                       URGETX    670
      IF(IPOSN.GT.0)THEN                                                URGETX    671
         FOUND =.FALSE.                                                 URGETX    672
         DO 440 I = IPOSN, 80                                           URGETX    673
            IF(BUFFER(I:I).NE.' ') FOUND =.TRUE.                        URGETX    674
440      CONTINUE                                                       URGETX    675
         IF(.NOT.FOUND)THEN                                             URGETX    676
            READ (INFILE,9002,IOSTAT=IOS) BUFFER                        URGETX    677
            IF(IOS.LT.0)  THEN                                          URGETX    678
               EOF =.TRUE.                                              URGETX    679
               ENDBLK =.TRUE.                                           URGETX    680
            ENDIF                                                       URGETX    681
            IPOSN = 0                                                   URGETX    682
         ENDIF                                                          URGETX    683
      ENDIF                                                             URGETX    684
C                                                                       URGETX    685
      FOUND =.FALSE.                                                    URGETX    686
C                                                                       URGETX    687
C     Remove the character string.                                      URGETX    688
C                                                                       URGETX    689
460   IF(FOUND.OR.ENDBLK.OR.EOF) GO TO 480                              URGETX    690
C                                                                       URGETX    691
         IPOSN = IPOSN + 1                                              URGETX    692
C                                                                       URGETX    693
         IF(IPOSN.GT.80)THEN                                            URGETX    694
C                                                                       URGETX    695
            READ (INFILE,9302,IOSTAT=IOS) BUFFER                        URGETX    696
            IF(IOS.LT.0)THEN                                            URGETX    697
               EOF =.TRUE.                                              URGETX    698
               ENDBLK =.TRUE.                                           URGETX    699
            ENDIF                                                       URGETX    700
            IPOSN = 0                                                   URGETX    701
C                                                                       URGETX    702
         ELSEIF(BUFFER(IPOSN:IPOSN).EQ.'*'.AND..NOT.QUOTE)THEN          URGETX    703
C                                                                       URGETX    704
C           Change comment status.                                      URGETX    705
C                                                                       URGETX    706
            COMMNT =.NOT.COMMNT                                         URGETX    707
C                                                                       URGETX    708
         ELSEIF(COMMNT)THEN                                             URGETX    709
C                                                                       URGETX    710
C           Ignore buffer character.                                    URGETX    711
C                                                                       URGETX    712
         ELSEIF(BUFFER(IPOSN:IPOSN).EQ.':'.AND..NOT.QUOTE)THEN          URGETX    713
C                                                                       URGETX    714
C           End of current type.                                        URGETX    715
C                                                                       URGETX    716
            ENDBLK =.TRUE.                                              URGETX    717
            IF(LENSTR.GT.0) FOUND =.TRUE.                               URGETX    718
C                                                                       URGETX    719
         ELSEIF(BUFFER(IPOSN:IPOSN).EQ.','.AND..NOT.QUOTE)THEN          URGETX    720
C                                                                       URGETX    721
C           End of string encountered.                                  URGETX    722
C                                                                       URGETX    723
            FOUND =.TRUE.                                               URGETX    724
C                                                                       URGETX    725
         ELSEIF(BUFFER(IPOSN:IPOSN).EQ.'%'.AND..NOT.QUOTE)THEN          URGETX    726
C                                                                       URGETX    727
C           Ignore string.                                              URGETX    728
C                                                                       URGETX    729
            STRING = '%'                                                URGETX    730
            LENSTR = 1                                                  URGETX    731
C                                                                       URGETX    732
         ELSEIF(BUFFER(IPOSN:IPOSN).EQ.'''')THEN                        URGETX    733
C        Once a quote has been found - treat blanks as blanks until     URGETX    734
C        the second quote is found                                      URGETX    735
            IF(QUOTE) THEN                                              URGETX    736
               FOUND = .TRUE.                                           URGETX    737
            ELSE                                                        URGETX    738
               QUOTE = .TRUE.                                           URGETX    739
            ENDIF                                                       URGETX    740
C                                                                       URGETX    741
         ELSE                                                           URGETX    742
C                                                                       URGETX    743
C           Add current character to the string.                        URGETX    744
C                                                                       URGETX    745
C           If blank occurs inside quotes - keep as blank space         URGETX    746
C                                                                       URGETX    747
            IF(QUOTE.AND.BUFFER(IPOSN:IPOSN).EQ.' ') THEN               URGETX    748
               BUFFER(IPOSN:IPOSN) = '#'                                URGETX    749
            ENDIF                                                       URGETX    750
C                                                                       URGETX    751
            IF(BUFFER(IPOSN:IPOSN).NE.' '.OR.LENSTR.GT.0)THEN           URGETX    752
               IF(LENSTR.GE.72)THEN                                     URGETX    753
               WRITE (MSG(1),9004) SUBNAM                               URGETX    754
               WRITE(MSG(2),9400)                                       URGETX    755
               WRITE(MSG(3),9410)                                       URGETX    756
               WRITE(MSG(4),9420)                                       URGETX    757
               WRITE(MSG(5),9430) STRING(1:40)                          URGETX    758
               WRITE(MSG(6),9440)                                       URGETX    759
               WRITE(MSG(7),9450)                                       URGETX    760
               WRITE(MSG(8),9460)                                       URGETX    761
               CALL PRTMSG(8)                                           URGETX    762
                  FOUND =.TRUE.                                         URGETX    763
               ELSE                                                     URGETX    764
                  IF(BUFFER(IPOSN:IPOSN).EQ.'#')THEN                    URGETX    765
                     BUFFER(IPOSN:IPOSN) = ' '                          URGETX    766
                  ENDIF                                                 URGETX    767
                  LENSTR = LENSTR + 1                                   URGETX    768
                  STRING(LENSTR:LENSTR) = BUFFER(IPOSN:IPOSN)           URGETX    769
               ENDIF                                                    URGETX    770
            ENDIF                                                       URGETX    771
C                                                                       URGETX    772
         ENDIF                                                          URGETX    773
C                                                                       URGETX    774
         GO TO 460                                                      URGETX    775
480   CONTINUE                                                          URGETX    776
C                                                                       URGETX    777
C     Check that string is not a null string.                           URGETX    778
C                                                                       URGETX    779
      IF(LENSTR.EQ.0)THEN                                               URGETX    780
         FOUND =.FALSE.                                                 URGETX    781
      ENDIF                                                             URGETX    782
C                                                                       URGETX    783
C     If the string indicates the end of udc data, do not force         URGETX    784
C     another read.                                                     URGETX    785
C                                                                       URGETX    786
      IF(ENDBLK.AND..NOT.EOF)THEN                                       URGETX    787
         READ (INFILE,9302,IOSTAT=IOS) BUFFER                           URGETX    788
         IF(IOS.LT.0)THEN                                               URGETX    789
            EOF =.TRUE.                                                 URGETX    790
            ENDBLK =.TRUE.                                              URGETX    791
         ENDIF                                                          URGETX    792
         IPOSN = 0                                                      URGETX    793
      ENDIF                                                             URGETX    794
C                                                                       URGETX    795
      RETURN                                                            URGETX    796
C                                                                       URGETX    797
9302  FORMAT (A)                                                        URGETX    798
9004  FORMAT(' *** WARNING', 5X, A)                                     URGETX    799
9400  FORMAT(5X,'DURING THE READING OF THE UDC BLOCKS, A STRING OF')    URGETX    800
9410  FORMAT(5X,'CHARACTERS WAS RETRIEVED FROM THE UDC INPUT FILE')     URGETX    801
9420  FORMAT(5X,'WHICH EXCEEDS THE MAX LENGTH OF 72.')                  URGETX    802
9430  FORMAT(5X,'STRING(1:40) IS "',A,'"')                              URGETX    803
9440  FORMAT(5X,'NOTE: PROBABLY MISSING "," OR ":" OR TRYING TO')       URGETX    804
9450  FORMAT(5X,'      PROCESS A COMMENT AS DATA.  CHECK YOUR UDC')     URGETX    805
9460  FORMAT(5X,'      INPUT FILE FOR ERRORS.')                         URGETX    806
9470  FORMAT(5X,'DURING THE READING OF THE UDC BLOCKS, A REAL VALUE')   URGETX    807
9480  FORMAT(5X,'OF ', F12.6, ' WAS FOUND, WHEN AN INTEGER WAS')        URGETX    808
9490  FORMAT(5X,'EXPECTED.  CHECK YOUR UDC INPUT FILE FOR ERRORS.')     URGETX    809
C                                                                       URGETX    810
C---------------------------------------------------------------------  URGETX    811
C                                                                       URGETX    812
      END                                                               URGETX    813
