CFPRIME RDASCI                                                          RDASCI      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 RDASCI                                                 RDASCI      3
CD                                                                      RDASCI      4
CD   THIS SUBROUTINE SAVES THE DATA IN THE PLOT BUFFERS                 RDASCI      5
CD   INTO A USER SPECIFIED ASCII FILE                                   RDASCI      6
CD                                                                      RDASCI      7
C                                                                       RDASCI      8
      INCLUDE 'PARAM.INS'                                               RDASCI      9
      INCLUDE 'SOAPC1.INS'                                              RDASCI     10
      INCLUDE 'XYARAY.INS'                                              RDASCI     11
      INCLUDE 'CHDISP.INS'                                              RDASCI     12
C                                                                       RDASCI     13
      CHARACTER STRING*80,MSG*80,LLINE*528,LINE*132,FILNAM*80           RDASCI     14
      CHARACTER*90 LSTRNG                                               RDASCI     15
      DIMENSION IY(6),XY(100)                                           RDASCI     16
      SAVE IUF,JMAX,IX,FILNAM                                           RDASCI     17
      DATA IUF/0/                                                       RDASCI     18
C                                                                       RDASCI     19
      IF(IUF.EQ.0)THEN                                                  RDASCI     20
        WRITE(LOUT,5000)                                                RDASCI     21
        GOTO 9999                                                       RDASCI     22
      ENDIF                                                             RDASCI     23
C                                                                       RDASCI     24
      IF(IPLTYP.GT.1)THEN                                               RDASCI     25
        WRITE(LOUT,5600)                                                RDASCI     26
        WRITE(LOUT,5200)                                                RDASCI     27
        GOTO 9999                                                       RDASCI     28
      ENDIF                                                             RDASCI     29
C                                                                       RDASCI     30
      IF(KCH(1).EQ.6)THEN                                               RDASCI     31
        WRITE(LOUT,5100)                                                RDASCI     32
        WRITE(LOUT,5200)                                                RDASCI     33
        GOTO 9999                                                       RDASCI     34
      ENDIF                                                             RDASCI     35
C                                                                       RDASCI     36
      IF(JMAX.LE.0)THEN                                                 RDASCI     37
        MSG='Enter the number of columns '//                            RDASCI     38
     +      '(Min-2, Max-100, including time): '                        RDASCI     39
  150   CALL PMTRED(LOUT,LIN,JERR,62,MSG,'FIL',STRING)                  RDASCI     40
        IF(JERR.LT.0) GOTO 150                                          RDASCI     41
        IF(RECORD) WRITE(IREC,'(A)') STRING                             RDASCI     42
        READ(STRING,*,IOSTAT=IOS) JMAX                                  RDASCI     43
        IF(IOS.NE.0.OR.JMAX.LE.1.OR.JMAX.GT.100) GOTO 150               RDASCI     44
      ENDIF                                                             RDASCI     45
C                                                                       RDASCI     46
      MSG='Enter Time-Axis column number: '                             RDASCI     47
  200 CALL PMTRED(LOUT,LIN,JERR,31,MSG,'FIL',STRING)                    RDASCI     48
      IF(JERR.LT.0) GOTO 200                                            RDASCI     49
      IF(RECORD) WRITE(IREC,'(A)') STRING                               RDASCI     50
      READ(STRING,*,IOSTAT=IOS) IX                                      RDASCI     51
      IF(IOS.NE.0) GOTO 200                                             RDASCI     52
      IF(IX.LE.0.OR.IX.GT.JMAX)THEN                                     RDASCI     53
        WRITE(LOUT,5300)                                                RDASCI     54
        GOTO 200                                                        RDASCI     55
      ENDIF                                                             RDASCI     56
C                                                                       RDASCI     57
      IMORE=6-KCH(1)                                                    RDASCI     58
      MSG='Enter Y-Axis column numbers (up to - columns): '             RDASCI     59
      WRITE(MSG(36:36),'(I1)')IMORE                                     RDASCI     60
  400 CALL PMTRED(LOUT,LIN,JERR,47,MSG,'FIL',STRING)                    RDASCI     61
      IF(JERR.LT.0) GOTO 400                                            RDASCI     62
      IF(RECORD) WRITE(IREC,'(A)') STRING                               RDASCI     63
      LSTRNG=STRING//' 0 0 0 0 0'                                       RDASCI     64
      READ(LSTRNG,*,IOSTAT=IOS)(IY(I),I=1,6)                            RDASCI     65
      IF(IOS.NE.0)GOTO 400                                              RDASCI     66
      IF(IY(1).EQ.0)THEN                                                RDASCI     67
        WRITE(LOUT,5300)                                                RDASCI     68
        GOTO 400                                                        RDASCI     69
      ENDIF                                                             RDASCI     70
C                                                                       RDASCI     71
      NY=0                                                              RDASCI     72
      DO 500 I=1,IMORE                                                  RDASCI     73
        IF(IY(I).EQ.0)GOTO 600                                          RDASCI     74
        IF(IY(I).LT.0.OR.IY(I).GT.JMAX)THEN                             RDASCI     75
          WRITE(LOUT,5300)                                              RDASCI     76
          GOTO 400                                                      RDASCI     77
        ELSE                                                            RDASCI     78
          NY=NY+1                                                       RDASCI     79
          IY(NY)=IY(I)                                                  RDASCI     80
        ENDIF                                                           RDASCI     81
  500 CONTINUE                                                          RDASCI     82
C                                                                       RDASCI     83
  600 NCHO=KCH(1)                                                       RDASCI     84
C                                                                       RDASCI     85
C                 Set up the titles                                     RDASCI     86
C                                                                       RDASCI     87
      DO 700 II=1,NY                                                    RDASCI     88
        JJ=NCHO+II                                                      RDASCI     89
        MSG='Enter Y-axis title for column --: '                        RDASCI     90
        WRITE(MSG(31:32),'(I2)')IY(II)                                  RDASCI     91
  710   CALL PMTRED(LOUT,LIN,JERR,34,MSG,'FIL',YTITLE(JJ))              RDASCI     92
        IF(JERR.LT.0)GOTO 710                                           RDASCI     93
        IF(RECORD)WRITE(IREC,'(A)')YTITLE(JJ)                           RDASCI     94
        KCHAN=10+II                                                     RDASCI     95
        KCH(JJ+1)=KCHAN                                                 RDASCI     96
        CASEID(JJ)=' '                                                  RDASCI     97
        LTITLE(JJ)=' '                                                  RDASCI     98
        LTITL2(JJ)=' '                                                  RDASCI     99
        CTITLE(JJ)=' '                                                  RDASCI    100
        CTITL2(JJ)=' '                                                  RDASCI    101
        FILCHN(JJ)=FILNAM                                               RDASCI    102
        ICHTYP(JJ)=2                                                    RDASCI    103
        DISPCH(1,JJ)='         COLUMN -- FROM FILE: '                   RDASCI    104
     +               //FILCHN(JJ)(1:50)                                 RDASCI    105
        WRITE(DISPCH(1,JJ)(1:6),'(I6)')KCH(JJ+1)                        RDASCI    106
        WRITE(DISPCH(1,JJ)(17:18),'(I2)')IY(II)                         RDASCI    107
        DISPCH(2,JJ)=' '                                                RDASCI    108
  700 CONTINUE                                                          RDASCI    109
C                                                                       RDASCI    110
C                 Read the data from ASCII file                         RDASCI    111
C                                                                       RDASCI    112
      IL=0                                                              RDASCI    113
      LLINE=' '                                                         RDASCI    114
  800 IL=IL+132                                                         RDASCI    115
      READ(IUF,'(A)',IOSTAT=IOS) LINE                                   RDASCI    116
      IF(IOS.LT.0.OR.IL.GT.528)THEN                                     RDASCI    117
         WRITE(LOUT,5400)                                               RDASCI    118
         WRITE(LOUT,5200)                                               RDASCI    119
         CLOSE(IUF)                                                     RDASCI    120
         IUF=0                                                          RDASCI    121
         GOTO 9999                                                      RDASCI    122
      ENDIF                                                             RDASCI    123
      LLINE(IL-131:IL)=LINE                                             RDASCI    124
      READ(LLINE,*,IOSTAT=IOS) (XY(I),I=1,JMAX)                         RDASCI    125
      IF(IOS.NE.0) GOTO 800                                             RDASCI    126
C                                                                       RDASCI    127
      J=0                                                               RDASCI    128
  900 J=J+1                                                             RDASCI    129
      READ(LLINE,*,IOSTAT=IOS) (XY(I),I=1,JMAX)                         RDASCI    130
      DO 1000 I=1,NY                                                    RDASCI    131
        JJ=NCHO+I                                                       RDASCI    132
        T(J,JJ)=XY(IX)                                                  RDASCI    133
        YARAY(J,JJ)=XY(IY(I))                                           RDASCI    134
 1000 CONTINUE                                                          RDASCI    135
C                                                                       RDASCI    136
      I=0                                                               RDASCI    137
 1100 I=I+132                                                           RDASCI    138
      READ(IUF,'(A)',IOSTAT=IOS) LINE                                   RDASCI    139
      IF(IOS.EQ.0)THEN                                                  RDASCI    140
         LLINE(I-131:I)=LINE                                            RDASCI    141
         IF(I.LT.IL) GOTO 1100                                          RDASCI    142
         IF(J.LT.MXPT) GOTO 900                                         RDASCI    143
         WRITE(LOUT,5500) MXPT                                          RDASCI    144
      ENDIF                                                             RDASCI    145
C                                                                       RDASCI    146
      REWIND(IUF)                                                       RDASCI    147
C                                                                       RDASCI    148
      DO 1200 I=1,NY                                                    RDASCI    149
        JJ=NCHO+I                                                       RDASCI    150
        MAXPT(JJ)=J                                                     RDASCI    151
1200  CONTINUE                                                          RDASCI    152
C                                                                       RDASCI    153
      KCH(1)=NCHO+NY                                                    RDASCI    154
      FILLED=.TRUE.                                                     RDASCI    155
      IPLTYP=1                                                          RDASCI    156
      IFLG=0                                                            RDASCI    157
      STRING(1:7)='RDASCII'                                             RDASCI    158
      CALL GPPAGE                                                       RDASCI    159
      CALL GETCHN(STRING)                                               RDASCI    160
C                                                                       RDASCI    161
 9999 RETURN                                                            RDASCI    162
C                                                                       RDASCI    163
      ENTRY OPASCI                                                      RDASCI    164
C                                                                       RDASCI    165
      IF(IUF.NE.0) CLOSE(IUF)                                           RDASCI    166
C                                                                       RDASCI    167
  100 CONTINUE                                                          RDASCI    168
      MSG='Enter file name (Q to QUIT)'                                 RDASCI    169
      CALL PMTRED(LOUT,LIN,JERR,28,MSG,'FIL',FILNAM)                    RDASCI    170
      IF(JERR.LT.0) GOTO 100                                            RDASCI    171
      IF(RECORD) WRITE(IREC,'(A)') FILNAM                               RDASCI    172
      IF(FILNAM(1:2).EQ.'Q '.OR.FILNAM(1:2).EQ.'q ') RETURN             RDASCI    173
      LENFIL=LENS(FILNAM)                                               RDASCI    174
      CALL PARSIU(FILNAM(1:50),LENFIL,IUF,LO)                           RDASCI    175
      IF(IUF.GT.0)THEN                                                  RDASCI    176
         LENFIL=LO                                                      RDASCI    177
      ELSE                                                              RDASCI    178
         IUF=62                                                         RDASCI    179
      ENDIF                                                             RDASCI    180
      CALL OPENFI(IUF,FILNAM,LENFIL,IERR,'OLD',1)                       RDASCI    181
      IF(IERR.LT.0)THEN                                                 RDASCI    182
         WRITE(LOUT,'(//,A,//)') ' ** FILE OPEN ERROR TRY AGAIN **'     RDASCI    183
         GOTO 100                                                       RDASCI    184
      ENDIF                                                             RDASCI    185
      JMAX=0                                                            RDASCI    186
      RETURN                                                            RDASCI    187
C                                                                       RDASCI    188
 5000 FORMAT(/,10X,31('*'),/,10X,'*   ASCII FILE NOT AVAILABLE  *',/    RDASCI    189
     *,10X,'* USE "OPASCII" COMMAND FIRST *',/,10X,31('*'))             RDASCI    190
 5100 FORMAT(//,1X,'+++ ALL SIX BUFFERS ARE FILLED +++',//)             RDASCI    191
 5200 FORMAT(//,1X,'+++ RDASCII COMMAND ABORTED +++',//)                RDASCI    192
 5300 FORMAT(/,1X,'+++ ILLEGAL COLUMN NUMBER(S) SPECIFIED +++',//)      RDASCI    193
 5400 FORMAT(/,1X,'+++ ERROR READING ASCII FILE +++',//)                RDASCI    194
 5500 FORMAT(' *** ERROR DATA POINTS EXCEED THE LIMIT OF',I6)           RDASCI    195
 5600 FORMAT(/,                                                         RDASCI    196
     + 10X,'BUFFERS CONTAIN INCOMPATIBLE DATA',                         RDASCI    197
     + /,10X,'PLEASE USE DEL=ALL BEFORE READING FROM ASCII FILE')       RDASCI    198
      END                                                               RDASCI    199
