CFPRIME FRELAY                                                          FRELAY      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 FRELAY(BNAME,J,ANGLE,CENTRE,RADIUS)                    FRELAY      3
CD                                                                      FRELAY      4
CD    TO GET RELAY CHARACTERISTICS FROM RELAY DATA BASE.                FRELAY      5
CD                                                                      FRELAY      6
      PARAMETER(MLENG=128,MAXSTN=4096)                                  FRELAY      7
C                                                                       FRELAY      8
      DIMENSION  IHREC(20),RDATA(15),RCNAME(12*MAXSTN),RNAME(MLENG)     FRELAY      9
      COMMON /SCRAT4/ ICNAME(12,MAXSTN)                                 FRELAY     10
      CHARACTER*4 BNAME(3),CNAME(12,MAXSTN)                             FRELAY     11
     *,CCTIDA(3)                                                        FRELAY     12
      EQUIVALENCE (RCNAME(1),ICNAME(1,1),CNAME(1,1))                    FRELAY     13
      CHARACTER*32 FILENA                                               FRELAY     14
C                                                                       FRELAY     15
      INCLUDE 'CNUNIT.INS'                                              FRELAY     16
      INCLUDE 'CNLUN.INS'                                               FRELAY     17
      INCLUDE 'CNMSG.INS'                                               FRELAY     18
      INCLUDE 'CNB19.INS'                                               FRELAY     19
C                                                                       FRELAY     20
      DATA NOENTY/0/                                                    FRELAY     21
C                                                                       FRELAY     22
      R=0.0                                                             FRELAY     23
      X=0.0                                                             FRELAY     24
      Y=0.0                                                             FRELAY     25
      JFOUND=0                                                          FRELAY     26
      CCTIDA(1)=BNAME(1)                                                FRELAY     27
      CCTIDA(2)=BNAME(2)(1:1)//BNAME(3)(4:4)//'  '                      FRELAY     28
      CCTIDA(3)=BNAME(2)(3:4)//BNAME(3)(1:2)                            FRELAY     29
C                                                                       FRELAY     30
      IF(.NOT.LUNITS(IU33)) GOTO 500                                    FRELAY     31
C                                                                       FRELAY     32
C     FIND THE CIRCUIT                                                  FRELAY     33
C                                                                       FRELAY     34
  20  J=NOENTY+1                                                        FRELAY     35
      ISMALL=0                                                          FRELAY     36
      ASSIGN 200 TO I400                                                FRELAY     37
C                                                                       FRELAY     38
  70  ILARGE=J                                                          FRELAY     39
      GOTO 100                                                          FRELAY     40
  80  ISMALL=J                                                          FRELAY     41
 100  IF(ILARGE.EQ.(ISMALL+1)) GOTO 150                                 FRELAY     42
      J=(ILARGE+ISMALL)/2                                               FRELAY     43
C                                                                       FRELAY     44
      IF (CNAME(1,J).GT.CCTIDA(1)) GOTO 70                              FRELAY     45
      IF (CNAME(1,J).LT.CCTIDA(1)) GOTO 80                              FRELAY     46
      IF (CNAME(2,J).GT.CCTIDA(2)) GOTO 70                              FRELAY     47
      IF (CNAME(2,J).LT.CCTIDA(2)) GOTO 80                              FRELAY     48
      IF (CCTIDA(3).EQ.'    ') GOTO 400                                 FRELAY     49
      IF (CNAME(3,J).GT.CCTIDA(3)) GOTO 70                              FRELAY     50
      IF (CNAME(3,J).LT.CCTIDA(3)) GOTO 80                              FRELAY     51
 400  IREC=ICNAME(10,J)                                                 FRELAY     52
      CALL DAFLWR(IU33,1,IREC,RDATA(1),15)                              FRELAY     53
C                                                                       FRELAY     54
      RADIUS=RDATA(13)                                                  FRELAY     55
      CENTRE=RDATA(14)                                                  FRELAY     56
      ANGLE=RDATA(15)                                                   FRELAY     57
      IF (CCTIDA(3).NE.'    ') THEN                                     FRELAY     58
         J=J+10                                                         FRELAY     59
         RETURN                                                         FRELAY     60
      ENDIF                                                             FRELAY     61
C                                                                       FRELAY     62
      CALL COMPOS(R,X,Y,RADIUS,CENTRE,ANGLE)                            FRELAY     63
C                                                                       FRELAY     64
      GOTO I400                                                         FRELAY     65
C                                                                       FRELAY     66
C     THE CIRCUIT IS NOT IN RELAY DATA BASE                             FRELAY     67
C                                                                       FRELAY     68
 150  J=1                                                               FRELAY     69
      RETURN                                                            FRELAY     70
C                                                                       FRELAY     71
C  LOOKING FOR DIFFERENT BUILT DATE LINE                                FRELAY     72
C                                                                       FRELAY     73
 200  JFOUND=JFOUND+1                                                   FRELAY     74
      J=J-1                                                             FRELAY     75
      IF (CNAME(1,J).EQ.CCTIDA(1).AND.                                  FRELAY     76
     *         CNAME(2,J).EQ.CCTIDA(2)) GOTO 400                        FRELAY     77
C                                                                       FRELAY     78
      ASSIGN 300 TO I400                                                FRELAY     79
      J=J+JFOUND                                                        FRELAY     80
 300  J=J+1                                                             FRELAY     81
      IF (CNAME(1,J).EQ.CCTIDA(1).AND.                                  FRELAY     82
     *         CNAME(2,J).EQ.CCTIDA(2)) GOTO 400                        FRELAY     83
C                                                                       FRELAY     84
      RADIUS=R                                                          FRELAY     85
      CENTRE=SQRT(X*X+Y*Y)                                              FRELAY     86
      ANGLE=ATAN(Y/X)*57.2958                                           FRELAY     87
C                                                                       FRELAY     88
      J=I16BH+J+9                                                       FRELAY     89
      RETURN                                                            FRELAY     90
C                                                                       FRELAY     91
C                                                                       FRELAY     92
C                                                                       FRELAY     93
C     OPEN RELAY DATA BASE                                              FRELAY     94
C                                                                       FRELAY     95
 500  CONTINUE                                                          FRELAY     96
C                                                                       FRELAY     97
      JLENG=MLENG                                                       FRELAY     98
      IKEY=3                                                            FRELAY     99
      FILENA='SP031:[DYW.RELAY]DBASE_RELAY.BAS'                         FRELAY    100
      LFN=32                                                            FRELAY    101
      CALL OPENRE(IU33,FILENA,JLENG,IKEY,ISTAT,LFN)                     FRELAY    102
C                                                                       FRELAY    103
      IF(ISTAT.NE.0)THEN                                                FRELAY    104
          MSG(1)=' *** RELAY DATABASE FILE OPEN ERROR'                  FRELAY    105
          CALL PRTMSG(1)                                                FRELAY    106
          CALL ASTOP('FRELAY: FATAL ERROR',19)                          FRELAY    107
      ELSE                                                              FRELAY    108
          LUNITS(IU33)=.TRUE.                                           FRELAY    109
      ENDIF                                                             FRELAY    110
C                                                                       FRELAY    111
      JREC=1                                                            FRELAY    112
      CALL DAIWR(IU33,1,JREC,IHREC(1),20)                               FRELAY    113
C                                                                       FRELAY    114
      NOENTY=IHREC(12)                                                  FRELAY    115
      JREC=IHREC(16)                                                    FRELAY    116
      LREC=IHREC(17)                                                    FRELAY    117
      KK=-MLENG                                                         FRELAY    118
      DO 550 LL=1,LREC                                                  FRELAY    119
      KK=KK+MLENG                                                       FRELAY    120
      CALL DAFLWR(IU33,1,JREC,RNAME,MLENG)                              FRELAY    121
      DO 550 LK=1,MLENG                                                 FRELAY    122
      RCNAME(KK+LK)=RNAME(LK)                                           FRELAY    123
 550  CONTINUE                                                          FRELAY    124
C                                                                       FRELAY    125
      GOTO 20                                                           FRELAY    126
C                                                                       FRELAY    127
      END                                                               FRELAY    128
C  -------------------------------------------------                    FRELAY    129
      SUBROUTINE COMPOS(R,X,Y,RADIUS,CENTRE,ANGLE)                      FRELAY    130
CD                                                                      FRELAY    131
CD    TO CALCULATE THE COMPOSITE RELAY CHARACTERISTIC.                  FRELAY    132
CD                                                                      FRELAY    133
      X1=CENTRE*COS(ANGLE*0.017453)                                     FRELAY    134
      Y1=CENTRE*SIN(ANGLE*0.017453)                                     FRELAY    135
C                                                                       FRELAY    136
C   COMPUTE THE DISTANCE BETWEEN THE CENTRES                            FRELAY    137
C                                                                       FRELAY    138
      D1=SQRT((X-X1)*(X-X1)+(Y-Y1)*(Y-Y1))                              FRELAY    139
C                                                                       FRELAY    140
C   DETERMINE IF THE INPUT CIRCLE IS GREATER THAN THE COMPOSITED CIRCLE FRELAY    141
C                                                                       FRELAY    142
      IF(R.GE.(RADIUS+D1))RETURN                                        FRELAY    143
      IF(RADIUS.GE.(R+D1))THEN                                          FRELAY    144
            R=RADIUS                                                    FRELAY    145
            X=X1                                                        FRELAY    146
            Y=Y1                                                        FRELAY    147
            RETURN                                                      FRELAY    148
      ENDIF                                                             FRELAY    149
C                                                                       FRELAY    150
      R=(R+D1+RADIUS)*0.5                                               FRELAY    151
      D2=R-RADIUS                                                       FRELAY    152
      X=X1-D2*(X1-X)/D1                                                 FRELAY    153
      Y=Y1-D2*(Y1-Y)/D1                                                 FRELAY    154
C                                                                       FRELAY    155
      RETURN                                                            FRELAY    156
      END                                                               FRELAY    157
                                                                        FRELAY    158
