CFPRIME SCRPMT                                                          SCRPMT      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 SCRPMT(LOUT,MSG,LN)                                    SCRPMT      3
CD                                                                      SCRPMT      4
CD         THIS ROUTINE PRINT MESSAGE ON THE SCREEN                     SCRPMT      5
CD                                                                      SCRPMT      6
CD         CALLING PARAMETERS :                                         SCRPMT      7
CD                                                                      SCRPMT      8
CD                       LOUT - LOGICAL UNIT FOR OUTPUT                 SCRPMT      9
CD                       MSG  - INPUT MESSAGE                           SCRPMT     10
CD                       LN   - NUMBER OF CHARACTERS IN THE MESSAGE     SCRPMT     11
CD                                                                      SCRPMT     12
      CHARACTER*(*) MSG                                                 SCRPMT     13
                                                                        SCRPMT     14
      WRITE(LOUT,1000)MSG(1:LN)                                         SCRPMT     15
*IF -MIBM                                                               SCRPMT     16
 1000 FORMAT(1X,A,'-->',$)                                              SCRPMT     17
*ENDIF                                                                  SCRPMT     18
*IF MIBM                                                                SCRPMT     19
*ENDIF                                                                  SCRPMT     21
      RETURN                                                            SCRPMT     22
      END                                                               SCRPMT     23
                                                                        SCRPMT     24
      SUBROUTINE PMTRED(LLOUT,LLIN,IOERR,LN,MSG,HELP,REBUF)             SCRPMT     25
CD                                                                      SCRPMT     26
CD        THIS ROUTINE ASKS FOR AND READ THE USER INPUT COMMAND         SCRPMT     27
CD                                                                      SCRPMT     28
CD        CALLING PARAMETERS :                                          SCRPMT     29
CD                                                                      SCRPMT     30
CD                    LLOUT  -  NOT USED                                SCRPMT     31
CD                    LLIN   -  NOT USED                                SCRPMT     32
CD                    IOERR  -  ERROR FLAG                              SCRPMT     33
CD                              0 : NO ERROR IN READING THE COMMAND     SCRPMT     34
CD                             -1 : ERROR IN READING THE COMMAND        SCRPMT     35
CD                    LN     -  NO OF CHARACTER IN THE MESSAGE          SCRPMT     36
CD                    MSG    -  INPUT MESSAGE                           SCRPMT     37
CD                    HELP   -  THE HELP TOPIC KEY WORD                 SCRPMT     38
CD                    REBUF  -  INPUT COMMAND                           SCRPMT     39
CD                                                                      SCRPMT     40
      INCLUDE 'SOAPC1.INS'                                              SCRPMT     41
      CHARACTER*(*) MSG                                                 SCRPMT     42
      CHARACTER*(*) REBUF                                               SCRPMT     43
      CHARACTER*(*)   HELP                                              SCRPMT     44
 100  CONTINUE                                                          SCRPMT     45
      IOERR=0                                                           SCRPMT     46
      WRITE(LOUT,1000)MSG(1:LN)                                         SCRPMT     47
      IF(RECORD)WRITE(IREC,1005)MSG(1:LN)                               SCRPMT     48
 1005 FORMAT('?',A)                                                     SCRPMT     49
*IF -MIBM                                                               SCRPMT     50
 1000 FORMAT(1X,A,'-->',$)                                              SCRPMT     51
*ENDIF                                                                  SCRPMT     52
*IF MIBM                                                                SCRPMT     53
*ENDIF                                                                  SCRPMT     55
                                                                        SCRPMT     56
 1010 FORMAT(A)                                                         SCRPMT     57
C                                                                       SCRPMT     58
  150 CONTINUE                                                          SCRPMT     59
      READ(LIN,1010,IOSTAT=IOS) REBUF                                   SCRPMT     60
      IF(IOS.NE.0) GOTO 2000                                            SCRPMT     61
      IL=LEN(REBUF)                                                     SCRPMT     62
      IK=IFNBLK(REBUF,IL-1)                                             SCRPMT     63
      IF(IK.EQ.0) GOTO 100                                              SCRPMT     64
      IF(REBUF(IK:IK).EQ.'?') GOTO 150                                  SCRPMT     65
      IF((REBUF(IK:IK+4).EQ.'HEL')) THEN                                SCRPMT     66
        CALL HELPSC(HELP,3)                                             SCRPMT     67
        GOTO 100                                                        SCRPMT     68
      ENDIF                                                             SCRPMT     69
      GOTO 9999                                                         SCRPMT     70
 2000 CONTINUE                                                          SCRPMT     71
      IOERR=-1                                                          SCRPMT     72
 9999 CONTINUE                                                          SCRPMT     73
      RETURN                                                            SCRPMT     74
      END                                                               SCRPMT     75
                                                                        SCRPMT     76
                                                                        SCRPMT     77
C                                                                       SCRPMT     78
C  WHEN GENERATE A COMPUTER VERSION,                                    SCRPMT     79
C    SET FLAG DWSUN TO GET YYMMDD ROUTINE FOR SUN                       SCRPMT     80
C    SET FLAG DMVAX TO GET YYMMDD ROUTINE FOR VAX/VMS                   SCRPMT     81
C    SET FLAG DWVAX TO GET YYMMDD ROUTINE FOR VAX/WORK STATION          SCRPMT     82
C    SET FLAG DMIBM TO GET YYMMDD ROUTINE FOR MAIN FRAME IBM            SCRPMT     83
C    SET FLAG DWIBM TO GET YYMMDD ROUTINE FOR IBM RISC/600 WORK STATION SCRPMT     84
C    SET FLAG DPRIME TO GET YYMMDD ROUTINE FOR PRIME                    SCRPMT     85
C    ALL THESE FLAGS HAVE BEEN SET FALSE IN SETTING UP THE LIBRARY      SCRPMT     86
C                                                                       SCRPMT     87
*IF DWSUN                                                               SCRPMT     88
      SUBROUTINE YYMMDD (VDATE)                                         SCRPMT     89
      CHARACTER*9 VDATE                                                 SCRPMT     90
      CHARACTER*24 SUNDAY                                               SCRPMT     91
      CALL FDATE(SUNDAY)                                                SCRPMT     92
      WRITE(VDATE,100)SUNDAY(5:11), SUNDAY(23:24)                       SCRPMT     93
 100  FORMAT(A7,A2)                                                     SCRPMT     94
      RETURN                                                            SCRPMT     95
      END                                                               SCRPMT     96
*ENDIF                                                                  SCRPMT     97
*IF DWDEC                                                               SCRPMT     98
*ENDIF                                                                  SCRPMT    104
*IF DMVAX                                                               SCRPMT    105
*ENDIF                                                                  SCRPMT    121
*IF DPRIME                                                              SCRPMT    122
*ENDIF                                                                  SCRPMT    131
*IF DMIBM                                                               SCRPMT    132
*ENDIF                                                                  SCRPMT    146
*IF LAHEY                                                               SCRPMT    147
*ENDIF                                                                  SCRPMT    169
*IF DAPOLO                                                              SCRPMT    170
*ENDIF                                                                  SCRPMT    193
*IF DWIBM                                                               SCRPMT    194
*ENDIF                                                                  SCRPMT    245
                                                                        SCRPMT    246
C                                                                       SCRPMT    247
C  WHEN GENERATE A COMPUTER VERSION,                                    SCRPMT    248
C    SET FLAG DWSUN TO GET YYMMDD ROUTINE FOR SUN                       SCRPMT    249
C    SET FLAG DMVAX TO GET YYMMDD ROUTINE FOR VAX/VMS                   SCRPMT    250
C    SET FLAG DWVAX TO GET YYMMDD ROUTINE FOR VAX/WORK STATION          SCRPMT    251
C    SET FLAG DMIBM TO GET YYMMDD ROUTINE FOR MAIN FRAME IBM            SCRPMT    252
C    SET FLAG DWIBM TO GET YYMMDD ROUTINE FOR IBM RISC/600 WORK STATION SCRPMT    253
C    SET FLAG DPRIME TO GET YYMMDD ROUTINE FOR PRIME                    SCRPMT    254
C    ALL THESE FLAGS HAVE BEEN SET FALSE IN SETTING UP THE LIBRARY      SCRPMT    255
C                                                                       SCRPMT    256
                                                                        SCRPMT    257
*IF VAX                                                                 SCRPMT    258
*ENDIF                                                                  SCRPMT    274
*IF DMIBM                                                               SCRPMT    275
*ENDIF                                                                  SCRPMT    287
*IF LAHEY                                                               SCRPMT    288
*ENDIF                                                                  SCRPMT    296
*IF DPRIME                                                              SCRPMT    297
*ENDIF                                                                  SCRPMT    305
*IF DWSUN                                                               SCRPMT    306
      SUBROUTINE HHMMSS (CTIME)                                         SCRPMT    307
      CHARACTER*(*) CTIME                                               SCRPMT    308
      CHARACTER*24 SUNDAY                                               SCRPMT    309
      CALL FDATE(SUNDAY)                                                SCRPMT    310
      WRITE(CTIME,100)SUNDAY(12:19)                                     SCRPMT    311
 100  FORMAT(A8)                                                        SCRPMT    312
      RETURN                                                            SCRPMT    313
      END                                                               SCRPMT    314
*ENDIF                                                                  SCRPMT    315
*IF DWIBM                                                               SCRPMT    316
*ENDIF                                                                  SCRPMT    324
*IF DWDEC                                                               SCRPMT    325
*ENDIF                                                                  SCRPMT    333
*IF DAPOLO                                                              SCRPMT    334
*ENDIF                                                                  SCRPMT    340
                                                                        SCRPMT    341
      SUBROUTINE SETCAP( STRNG )                                        SCRPMT    342
CD                                                                      SCRPMT    343
CD          THIS ROUTINE SET A CHARACTER STRING TO UPPER CASE           SCRPMT    344
CD                                                                      SCRPMT    345
CD          CALLING PARAMETER :                                         SCRPMT    346
CD                                                                      SCRPMT    347
CD                     STRNG  -  CHARACTER STRING ,UPON EXIT, ALL       SCRPMT    348
CD                               LOWER CASE CHARACTERS WILL BE          SCRPMT    349
CD                               CONVERTED TO UPPER CASE                SCRPMT    350
CD                                                                      SCRPMT    351
      CHARACTER*(*) STRNG                                               SCRPMT    352
      INTEGER TRMLEN                                                    SCRPMT    353
C                                                                       SCRPMT    354
      NLEN=TRMLEN(STRNG)                                                SCRPMT    355
      DO 100 I=1,NLEN                                                   SCRPMT    356
        IF(STRNG(I:I).EQ.'=')GOTO 999                                   SCRPMT    357
        JCHAR=ICHAR(STRNG(I:I))                                         SCRPMT    358
        IF(JCHAR.GE.ICHAR('a').AND.JCHAR.LE.ICHAR('z'))                 SCRPMT    359
     *    STRNG(I:I)=CHAR(JCHAR-ICHAR('a')+ICHAR('A'))                  SCRPMT    360
100   CONTINUE                                                          SCRPMT    361
999   RETURN                                                            SCRPMT    362
      END                                                               SCRPMT    363
C                                                                       SCRPMT    364
      INTEGER FUNCTION TRMLEN( STRNG )                                  SCRPMT    365
CD                                                                      SCRPMT    366
CD     TO GET THE LENGTH OF A CHARACTER STRING                          SCRPMT    367
CD     AFTER TRIMMING THE TRAILING BLANKS                               SCRPMT    368
CD                                                                      SCRPMT    369
      INTEGER MAXLEN, L, J                                              SCRPMT    370
      CHARACTER*(*) STRNG                                               SCRPMT    371
      CHARACTER*1   SPCE10(10)                                          SCRPMT    372
      CHARACTER*10  SPACES                                              SCRPMT    373
      EQUIVALENCE ( SPACES,SPCE10 )                                     SCRPMT    374
C                                                                       SCRPMT    375
      DATA  SPCE10 /10*' '/                                             SCRPMT    376
C                                                                       SCRPMT    377
      MAXLEN = LEN( STRNG )                                             SCRPMT    378
      IF( MAXLEN.LE.10 ) THEN                                           SCRPMT    379
        TRMLEN = 1                                                      SCRPMT    380
        L = MAXLEN                                                      SCRPMT    381
        GOTO 20                                                         SCRPMT    382
      ENDIF                                                             SCRPMT    383
      TRMLEN = MAXLEN - 9                                               SCRPMT    384
C                                                                       SCRPMT    385
10    CONTINUE                                                          SCRPMT    386
      L = TRMLEN + 9                                                    SCRPMT    387
      IF( STRNG(TRMLEN:L) .EQ. SPACES ) THEN                            SCRPMT    388
        TRMLEN = TRMLEN - 10                                            SCRPMT    389
        IF( TRMLEN .GT. 0 ) GOTO 10                                     SCRPMT    390
        TRMLEN = 1                                                      SCRPMT    391
      END IF                                                            SCRPMT    392
C                                                                       SCRPMT    393
      IF( TRMLEN .EQ. 0 ) THEN                                          SCRPMT    394
        TRMLEN = 1                                                      SCRPMT    395
        RETURN                                                          SCRPMT    396
      ENDIF                                                             SCRPMT    397
      L = TRMLEN + 9                                                    SCRPMT    398
20    DO 100 J=L,TRMLEN,-1                                              SCRPMT    399
        IF( STRNG(J:J) .NE. ' ' ) THEN                                  SCRPMT    400
          TRMLEN = J                                                    SCRPMT    401
          GOTO 150                                                      SCRPMT    402
        ENDIF                                                           SCRPMT    403
100   CONTINUE                                                          SCRPMT    404
150   CONTINUE                                                          SCRPMT    405
C                                                                       SCRPMT    406
      RETURN                                                            SCRPMT    407
      END                                                               SCRPMT    408
