CFPRIME REFCHN                                                          REFCHN      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 REFCHN(ICMMD)                                          REFCHN      3
CD                                                                      REFCHN      4
CD              THIS ROUTINE PARSE THE REFERENCE BUS NUMBER FOR         REFCHN      5
CD              RELATIVE ANGLE CALCULATION                              REFCHN      6
CD                                                                      REFCHN      7
      INCLUDE 'PARAM.INS'                                               REFCHN      8
      INCLUDE 'SOAPC1.INS'                                              REFCHN      9
      INCLUDE 'JJNAME.INS'                                              REFCHN     10
C                                                                       REFCHN     11
      INTEGER *4 LFNO(NBUF1),IBUSS                                      REFCHN     12
      CHARACTER*2 GID                                                   REFCHN     13
      CHARACTER*12 BNAME1,BNAME                                         REFCHN     14
      DIMENSION KNAME(3)                                                REFCHN     15
      EQUIVALENCE (BNAME,KNAME(1))                                      REFCHN     16
      CHARACTER*80 STRING,MSG                                           REFCHN     17
      COMMON /LFNOID/ LFNO                                              REFCHN     18
      COMMON /RECPT/ KRSTRT, ISTNAM, IIDARY, ITYARY, IHREC,ICHAN,       REFCHN     19
     *   NPFL,LRREC,IRREC                                               REFCHN     20
C                                                                       REFCHN     21
      IF(ICMMD.EQ.0)THEN                                                REFCHN     22
        RELATE=.FALSE.                                                  REFCHN     23
        WRITE(LOUT,1100)                                                REFCHN     24
 1100   FORMAT(/,                                                       REFCHN     25
     +   '* *  Generator Absolute Angle Plot is Activated  * * *',//)   REFCHN     26
        RETURN                                                          REFCHN     27
      ENDIF                                                             REFCHN     28
C                                                                       REFCHN     29
      WRITE(LOUT,1110)                                                  REFCHN     30
 1110    FORMAT(/,                                                      REFCHN     31
     +   '* *  Generator Relative Angle Plot is Activated  * * *',//)   REFCHN     32
      IF(KLFO.GT.0)THEN                                                 REFCHN     33
       MSG='Enter reference ;BUS NAME (;ID) (Q)uit)'                    REFCHN     34
      ELSE                                                              REFCHN     35
       MSG='Enter reference ;BUS NUMBER (;ID) (Q)uit)'                  REFCHN     36
      ENDIF                                                             REFCHN     37
   10 CONTINUE                                                          REFCHN     38
      CALL PMTRED(LOUT,LIN,JERR,ISLEN(MSG),MSG,'REL',STRING)            REFCHN     39
      IF(RECORD) WRITE(IREC,'(A)') STRING                               REFCHN     40
      IF(STRING(1:1).EQ.'Q'.OR.STRING(1:1).EQ.'q')RETURN                REFCHN     41
      I1=INDEX(STRING,';')                                              REFCHN     42
      IF(I1.EQ.0) GOTO 10                                               REFCHN     43
      I2=INDEX(STRING(I1+1:80),';')+I1                                  REFCHN     44
      IF(I2.EQ.I1) GOTO 10                                              REFCHN     45
      IF(KLFO.GT.0)THEN                                                 REFCHN     46
         I3=I2-1                                                        REFCHN     47
         IF(I3.GT.I1+12)I3=I1+12                                        REFCHN     48
         BNAME1=STRING(I1+1:I3)                                         REFCHN     49
      ELSE                                                              REFCHN     50
         READ(STRING(I1+1:I2-1),*,IOSTAT=IOS) NLF                       REFCHN     51
      ENDIF                                                             REFCHN     52
C                                                                       REFCHN     53
      ICHK=1                                                            REFCHN     54
   15 CONTINUE                                                          REFCHN     55
C                                                                       REFCHN     56
      DO 20 IBUSS=11,ICHAN                                              REFCHN     57
         CALL UNPACK(GID,ITY1,ITY(1,IBUSS))                             REFCHN     58
         IF(ITY1.NE.4) GOTO 20                                          REFCHN     59
         IF(STRING(I2+1:I2+2).NE.GID.AND.                               REFCHN     60
     *      (GID(1:1).NE.' '.OR.GID(2:2).NE.STRING(I2+1:I2+1))) GOTO 20 REFCHN     61
         IF(ITY(2,IBUSS).EQ.0) GOTO 20                                  REFCHN     62
         IF(KLFO.NE.0)THEN                                              REFCHN     63
            KNAME(1)=JNAME(1,IBUSS)                                     REFCHN     64
            KNAME(2)=JNAME(2,IBUSS)                                     REFCHN     65
            KNAME(3)=JNAME(3,IBUSS)                                     REFCHN     66
            IF(ICHK.EQ.1)THEN                                           REFCHN     67
              IF(BNAME.EQ.BNAME1) GOTO 30                               REFCHN     68
            ELSE                                                        REFCHN     69
              READ(BNAME(9:12),*,IOSTAT=IOS)BKV                         REFCHN     70
              IF(IOS.NE.0)GOTO 20                                       REFCHN     71
              READ(BNAME1(9:12),*,IOSTAT=IOS)BKV1                       REFCHN     72
              IF(IOS.NE.0)GOTO 20                                       REFCHN     73
              DBKV=ABS(BKV-BKV1)                                        REFCHN     74
              IF(BNAME(1:8).EQ.BNAME(1:8).AND.DBKV.LE.0.0001) GOTO 30   REFCHN     75
            ENDIF                                                       REFCHN     76
         ELSEIF(ITY(2,IBUSS).EQ.NLF)THEN                                REFCHN     77
            GOTO 30                                                     REFCHN     78
         ENDIF                                                          REFCHN     79
   20 CONTINUE                                                          REFCHN     80
C                                                                       REFCHN     81
      IF(KLFO.NE.0.AND.ICHK.EQ.1)THEN                                   REFCHN     82
        ICHK=0                                                          REFCHN     83
        GOTO 15                                                         REFCHN     84
      ENDIF                                                             REFCHN     85
C                                                                       REFCHN     86
      IREF=0                                                            REFCHN     87
      WRITE(LOUT,1000)                                                  REFCHN     88
      GOTO 10                                                           REFCHN     89
C                                                                       REFCHN     90
   30 CONTINUE                                                          REFCHN     91
      IREF=IBUSS                                                        REFCHN     92
      RELATE=.TRUE.                                                     REFCHN     93
      RETURN                                                            REFCHN     94
 1000 FORMAT(/                                                          REFCHN     95
     *,10X,'*******************************',/                          REFCHN     96
     *,10X,'*    BUS NOT MONITORED OR     *',/                          REFCHN     97
     *,10X,'*    IS NOT A GENERATOR BUS   *',/                          REFCHN     98
     *,10X,'*******************************')                           REFCHN     99
      END                                                               REFCHN    100
