CFPRIME MSAVE                                                           MSAVE       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 MSAVE                                                  MSAVE       3
CD                                                                      MSAVE       4
CD    This subroutine performs the multiple save function.              MSAVE       5
CD                                                                      MSAVE       6
C                                                                       MSAVE       7
      INCLUDE 'PARAM.INS'                                               MSAVE       8
      INCLUDE 'SOAPC1.INS'                                              MSAVE       9
      INCLUDE 'XYARAY.INS'                                              MSAVE      10
      INCLUDE 'GTIT.INS'                                                MSAVE      11
      INCLUDE 'JJNAME.INS'                                              MSAVE      12
      COMMON /RECPT/ KRSTRT,ISTNAM,IIDARY,ITYARY,IHREC,ICHAN,NPFL       MSAVE      13
     *   ,LRREC,IRREC                                                   MSAVE      14
      DIMENSION LRECFD(MCHNL,2),XA(MXPT),YA(MXPT)                       MSAVE      15
      CHARACTER*2 UID                                                   MSAVE      16
      CHARACTER*80 MSG,STRING,TITLE                                     MSAVE      17
      SAVE KSAVE                                                        MSAVE      18
      DATA KSAVE/0/                                                     MSAVE      19
C                                                                       MSAVE      20
      LRECFD(1,1)=0                                                     MSAVE      21
      LRECFD(1,2)=0                                                     MSAVE      22
      WRITE(LOUT,'(/,A,/)') ' SAVING CHANNELS INTO A FILE.'             MSAVE      23
C                                                                       MSAVE      24
      IF(KSAVE.EQ.0)THEN                                                MSAVE      25
         MSG='ENTER THE CHOICE CHANNEL (N)UMBER OR (V)ARIABLE:'         MSAVE      26
  100    CALL PMTRED(LOUT,LIN,IERR,47,MSG,'XXX',STRING)                 MSAVE      27
         IF(IERR.LT.0) GOTO 100                                         MSAVE      28
         IF(RECORD) WRITE(IREC,'(A)') STRING                            MSAVE      29
         IF(STRING(1:1).EQ.'N'.OR.STRING(1:1).EQ.'n')THEN               MSAVE      30
            ICV=1                                                       MSAVE      31
         ELSEIF(STRING(1:1).EQ.'V'.OR.STRING(1:1).EQ.'v')THEN           MSAVE      32
            ICV=2                                                       MSAVE      33
         ELSEIF(STRING(1:1).EQ.'Q'.OR.STRING(1:1).EQ.'q')THEN           MSAVE      34
            RETURN                                                      MSAVE      35
         ELSE                                                           MSAVE      36
            GOTO 100                                                    MSAVE      37
         ENDIF                                                          MSAVE      38
         KSAVE=9                                                        MSAVE      39
         MSG='Enter output file name'                                   MSAVE      40
         CALL OPFILE(MSG,KSAVE,JERR)                                    MSAVE      41
         IF(JERR.EQ.1) RETURN                                           MSAVE      42
C                                                                       MSAVE      43
         DO 110 II=1,6                                                  MSAVE      44
           WRITE(KSAVE,'(A)')PTITLE(II)                                 MSAVE      45
  110    CONTINUE                                                       MSAVE      46
C                                                                       MSAVE      47
      ENDIF                                                             MSAVE      48
C                                                                       MSAVE      49
  200 CONTINUE                                                          MSAVE      50
      IF(ICV.EQ.1)THEN                                                  MSAVE      51
         MSG='ENTER CHANNEL # (Q TO QUIT):'                             MSAVE      52
  300    CALL PMTRED(LOUT,LIN,IERR,28,MSG,'XXX',STRING)                 MSAVE      53
         IF(IERR.LT.0) GOTO 300                                         MSAVE      54
         IF(RECORD) WRITE(IREC,'(A)') STRING                            MSAVE      55
         IF(STRING(1:1).EQ.'Q'.OR.STRING(1:1).EQ.'q') RETURN            MSAVE      56
         READ(STRING,*,IOSTAT=IOS) KCHAN                                MSAVE      57
         IF(IOS.NE.0.OR.KCHAN.LE.10.OR.KCHAN.GT.ICHAN) GOTO 300         MSAVE      58
      ELSE                                                              MSAVE      59
         CALL GETYPE(KCHAN,NTYPE)                                       MSAVE      60
         IF(NTYPE.LT.0) RETURN                                          MSAVE      61
      ENDIF                                                             MSAVE      62
C                                                                       MSAVE      63
      CALL REMAS1(XA,YA,MXPT,ICHNL,KCHAN,MAXPNT)                        MSAVE      64
C   Channel #, file name and case ID                                    MSAVE      65
      WRITE(KSAVE,'(A,I6,1X,A,1X,A)')'CH# ',KCHAN,CHNLFI(1:56),CASID    MSAVE      66
C   Y-axis label                                                        MSAVE      67
      CALL UNPACK(UID,NTYPE,ITY(1,KCHAN))                               MSAVE      68
      CALL WNTYPE(NTYPE,NTIT,NSTATE)                                    MSAVE      69
      TITLE=GRPTIL(NTIT)                                                MSAVE      70
      IF(NTIT.EQ.54.OR.NTIT.EQ.55)WRITE(TITLE(30:35),'(I6)')NSTATE      MSAVE      71
      WRITE(KSAVE,'(A)')TITLE                                           MSAVE      72
C   Channel description                                                 MSAVE      73
      CALL BUSNAM(TITLE,KCHAN,KLFO,III)                                 MSAVE      74
      WRITE(KSAVE,'(A)')TITLE                                           MSAVE      75
C   File description 1                                                  MSAVE      76
      WRITE(TITLE,'(A,I3)')'CH# ',KCHAN                                 MSAVE      77
      WRITE(KSAVE,'(A)')TITLE                                           MSAVE      78
C   File description 2                                                  MSAVE      79
      TITLE=CHNLFI                                                      MSAVE      80
      WRITE(KSAVE,'(A)')TITLE                                           MSAVE      81
C                                                                       MSAVE      82
      DO 400 I=1,MAXPNT                                                 MSAVE      83
        WRITE(KSAVE,'(2F12.5)') XA(I),YA(I)                             MSAVE      84
  400 CONTINUE                                                          MSAVE      85
      WRITE(KSAVE,'(A)') ' END'                                         MSAVE      86
      GOTO 200                                                          MSAVE      87
      END                                                               MSAVE      88
C                                                                       MSAVE      89
      SUBROUTINE BSAVE                                                  MSAVE      90
CD                                                                      MSAVE      91
CD    This subroutine performs the buffer save function.                MSAVE      92
CD                                                                      MSAVE      93
C                                                                       MSAVE      94
      INCLUDE 'PARAM.INS'                                               MSAVE      95
      INCLUDE 'SOAPC1.INS'                                              MSAVE      96
      INCLUDE 'XYARAY.INS'                                              MSAVE      97
      COMMON /BSAVEM/ ISLAST                                            MSAVE      98
      CHARACTER*80 MSG                                                  MSAVE      99
      SAVE KSAVE                                                        MSAVE     100
      DATA KSAVE/0/                                                     MSAVE     101
C                                                                       MSAVE     102
      WRITE(LOUT,'(/,A,/)') ' SAVING CHANNELS INTO A FILE.'             MSAVE     103
C                                                                       MSAVE     104
      IF(KSAVE.EQ.0)THEN                                                MSAVE     105
         KSAVE=27                                                       MSAVE     106
         MSG='Enter output file name'                                   MSAVE     107
         CALL OPFILE(MSG,KSAVE,JERR)                                    MSAVE     108
         IF(JERR.EQ.1) RETURN                                           MSAVE     109
C                                                                       MSAVE     110
         DO 100 II=1,6                                                  MSAVE     111
           WRITE(KSAVE,'(A)')PTITLE(II)                                 MSAVE     112
  100    CONTINUE                                                       MSAVE     113
C                                                                       MSAVE     114
         ISLAST=0                                                       MSAVE     115
      ENDIF                                                             MSAVE     116
C                                                                       MSAVE     117
      DO 500 J=ISLAST+1,KCH(1)                                          MSAVE     118
C   Channel #, file name and case ID                                    MSAVE     119
        KCHAN=KCH(J+1)                                                  MSAVE     120
        WRITE(KSAVE,'(A,I6,1X,A,1X,A)')'CH# ',KCHAN,FILCHN(J)(1:56),    MSAVE     121
     +                                 CASEID(J)                        MSAVE     122
C   Y-axis label                                                        MSAVE     123
        WRITE(KSAVE,'(A)')YTITLE(J)                                     MSAVE     124
C   Channel description                                                 MSAVE     125
        WRITE(KSAVE,'(A)')LTITLE(J)                                     MSAVE     126
C   File description 1                                                  MSAVE     127
        WRITE(KSAVE,'(A)')LTITL2(J)                                     MSAVE     128
C   File description 2                                                  MSAVE     129
        WRITE(KSAVE,'(A)')CTITL2(J)                                     MSAVE     130
C                                                                       MSAVE     131
        DO 400 I=1,MAXPT(J)                                             MSAVE     132
          WRITE(KSAVE,'(2F12.5)') XARAY(I,J),YARAY(I,J)                 MSAVE     133
  400   CONTINUE                                                        MSAVE     134
        WRITE(KSAVE,'(A)') ' END'                                       MSAVE     135
  500 CONTINUE                                                          MSAVE     136
      ISLAST=KCH(1)                                                     MSAVE     137
      RETURN                                                            MSAVE     138
      END                                                               MSAVE     139
C                                                                       MSAVE     140
      SUBROUTINE REMAS1(X,Y,M,IUX,LCHN,MX)                              MSAVE     141
C                                                                       MSAVE     142
      INCLUDE 'PARAM.INS'                                               MSAVE     143
      INCLUDE 'JJNAME.INS'                                              MSAVE     144
      INCLUDE 'SOAPC1.INS'                                              MSAVE     145
C                                                                       MSAVE     146
      REAL X(*),Y(*)                                                    MSAVE     147
      REAL TBUF(128)                                                    MSAVE     148
      CHARACTER*2 UID                                                   MSAVE     149
      LOGICAL IEND                                                      MSAVE     150
      COMMON /REC9/ IRECS,NREC,IREC9(128)                               MSAVE     151
      COMMON /RECPT/ KRSTRT,ISTNAM,IIDARY,IHREC,ICHAN,NPFL,IRREC,MMAX   MSAVE     152
     *   ,NSTART                                                        MSAVE     153
C                                                                       MSAVE     154
      CALL UNPACK(UID,NTYPE,ITY(1,LCHN))                                MSAVE     155
C                                                                       MSAVE     156
      NREC=KRSTRT                                                       MSAVE     157
      MX=M                                                              MSAVE     158
      IT=1                                                              MSAVE     159
      II=0                                                              MSAVE     160
      NM=1                                                              MSAVE     161
      MM=0                                                              MSAVE     162
  100 MM=MM+1                                                           MSAVE     163
      IF(MM.GT.MX)THEN                                                  MSAVE     164
        IF(MM.GT.M) WRITE(LOUT,1000) X(MX)                              MSAVE     165
  400   IT=IT+1                                                         MSAVE     166
        II=II+128                                                       MSAVE     167
        IF(IT.GT.IRECS) RETURN                                          MSAVE     168
        IF(LCHN.LE.II+128.AND.LCHN.GT.II) GOTO 500                      MSAVE     169
        GOTO 400                                                        MSAVE     170
  500   NREC=KRSTRT+IT-1                                                MSAVE     171
      ENDIF                                                             MSAVE     172
C                                                                       MSAVE     173
C  READ BUFFER                                                          MSAVE     174
C                                                                       MSAVE     175
      CALL DAFLWR(IUX,1,NREC,TBUF,128,IEND)                             MSAVE     176
C                                                                       MSAVE     177
C  RETRIEVE TIME POINTS                                                 MSAVE     178
C                                                                       MSAVE     179
      IF(IT.EQ.1)THEN                                                   MSAVE     180
        IF(TBUF(2).GT.99999) MX=MM-1                                    MSAVE     181
        X(MM)=TBUF(2)                                                   MSAVE     182
      ENDIF                                                             MSAVE     183
C                                                                       MSAVE     184
C  RETRIEVE CHANNEL POINTS                                              MSAVE     185
C                                                                       MSAVE     186
      IF(LCHN.GT.II+128.OR.LCHN.LE.II) GOTO 200                         MSAVE     187
C                                                                       MSAVE     188
      IJ=LCHN-II                                                        MSAVE     189
      IF(LTYPE.EQ.2.OR.LTYPE.EQ.3.OR.LTYPE.EQ.23.OR.                    MSAVE     190
     *   LTYPE.EQ.24.OR.(LTYPE.GE.33.AND.LTYPE.LE.37.AND.               MSAVE     191
     *   LTYPE.NE.35).OR.LTYPE.EQ.42.OR.LTYPE.EQ.43)THEN                MSAVE     192
        Y(MM)=TBUF(IJ)*BASPC                                            MSAVE     193
      ELSEIF(LTYPE.EQ.5)THEN                                            MSAVE     194
        Y(MM)=(1.0+TBUF(IJ))*FQBASE                                     MSAVE     195
      ELSEIF(LTYPE.EQ.25)THEN                                           MSAVE     196
        Y(MM)=(1.0-TBUF(IJ))*FQBASE                                     MSAVE     197
      ELSE                                                              MSAVE     198
        Y(MM)=TBUF(IJ)                                                  MSAVE     199
      ENDIF                                                             MSAVE     200
C                                                                       MSAVE     201
 200  CONTINUE                                                          MSAVE     202
C                                                                       MSAVE     203
C  UPDATE RECORD NUMBER                                                 MSAVE     204
C                                                                       MSAVE     205
      NREC=NREC+IRECS-1                                                 MSAVE     206
      GOTO 100                                                          MSAVE     207
C                                                                       MSAVE     208
 1000 FORMAT(/                                                          MSAVE     209
     *,10X,'**************************************************',/       MSAVE     210
     *,10X,'* WARNING: TOO MANY DATA POINTS IN CHANNEL FILE. *',/       MSAVE     211
     *,10X,'*          LAST TIME STEP READ IN IS ',F10.5,'  *',//       MSAVE     212
     *,10X,'**************************************************',/)      MSAVE     213
      END                                                               MSAVE     214
C                                                                       MSAVE     215
      SUBROUTINE GETYPE(KCHAN,NTYPE)                                    MSAVE     216
C                                                                       MSAVE     217
      INCLUDE 'SOAPC1.INS'                                              MSAVE     218
      CHARACTER*80 MSG,STRING                                           MSAVE     219
C                                                                       MSAVE     220
      WRITE(LOUT,'(A)') ' Enter Channel specification (Q to quit):'     MSAVE     221
      MSG=' '                                                           MSAVE     222
  100 CALL PMTRED(LOUT,LIN,IERR,1,MSG,'XXX',STRING)                     MSAVE     223
      IF(IERR.LT.0) GOTO 100                                            MSAVE     224
      NTYPE=0                                                           MSAVE     225
      IF(STRING(1:2).EQ.'Q '.OR.STRING(1:2).EQ.'q ') NTYPE=-1           MSAVE     226
      IF(NTYPE.EQ.0)THEN                                                MSAVE     227
         LSTART=1                                                       MSAVE     228
         CALL STRCHN(STRING,KCHAN,NTYPE,LSTART,*100)                    MSAVE     229
         IF(NTYPE.EQ.0) GOTO 100                                        MSAVE     230
      ENDIF                                                             MSAVE     231
      IF(RECORD) WRITE(IREC,'(A)') STRING                               MSAVE     232
      RETURN                                                            MSAVE     233
      END                                                               MSAVE     234
C                                                                       MSAVE     235
      SUBROUTINE OPFILE(MSG,IFILE,JERR)                                 MSAVE     236
C                                                                       MSAVE     237
      INCLUDE 'SOAPC1.INS'                                              MSAVE     238
      CHARACTER*80 MSG,STRING                                           MSAVE     239
C                                                                       MSAVE     240
      JERR=0                                                            MSAVE     241
      LMSG=LENS(MSG)                                                    MSAVE     242
      CALL PMTRED(LOUT,LIN,JERR,LMSG,MSG,'SAV',STRING)                  MSAVE     243
      LENFIL=LENS(STRING)                                               MSAVE     244
      IF(JERR.LT.0.OR.STRING(1:4).EQ.'QUIT'.OR.                         MSAVE     245
     *   STRING(1:5).EQ.'ABORT'.OR.LENFIL.LE.0)THEN                     MSAVE     246
         WRITE(LOUT,'(//,A,//)') ' *** COMMAND ABORTED'                 MSAVE     247
         JERR=1                                                         MSAVE     248
         RETURN                                                         MSAVE     249
      ENDIF                                                             MSAVE     250
      IF(RECORD) WRITE(IREC,'(A)') STRING                               MSAVE     251
      CALL PARSIU(STRING,LENFIL,IU,LO)                                  MSAVE     252
      IF(IU.GT.0)THEN                                                   MSAVE     253
         STRING(LO+1:80)=' '                                            MSAVE     254
         IFILE=IU                                                       MSAVE     255
         LENFIL=LO                                                      MSAVE     256
      ENDIF                                                             MSAVE     257
      CALL OPENFI(IFILE,STRING,LENFIL,IERR,'UNKNOWN',1)                 MSAVE     258
      IF(IERR.LT.0)THEN                                                 MSAVE     259
         WRITE(LOUT,'(//,A,//)') ' *** FILE OPEN ERROR'                 MSAVE     260
         JERR=1                                                         MSAVE     261
      ENDIF                                                             MSAVE     262
      RETURN                                                            MSAVE     263
      END                                                               MSAVE     264
