CFPRIME BFAULT                                                          BFAULT      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 BFAULT(CARD,JTYP,IFAULT,IZV,IEBK,IBFLAG,TS)            BFAULT      3
CD                                                                      BFAULT      4
CD    TO DETERMINE THE BUS NUMBER THAT HAS THREE PHASE FAULT AND SETUP  BFAULT      5
CD    THE LOGIC FOR THREE PHASE FAULT.                                  BFAULT      6
CD                                                                      BFAULT      7
      INCLUDE 'PARX.INS'                                                BFAULT      8
      INCLUDE 'CNPT.INS'                                                BFAULT      9
      INCLUDE 'CNFLAG.INS'                                              BFAULT     10
      INCLUDE 'CNIPTR.INS'                                              BFAULT     11
      INCLUDE 'CNSTN.INS'                                               BFAULT     12
      INCLUDE 'CNB0.INS'                                                BFAULT     13
      INCLUDE 'CNB1.INS'                                                BFAULT     14
      INCLUDE 'CNB3.INS'                                                BFAULT     15
      INCLUDE 'CNB5.INS'                                                BFAULT     16
      INCLUDE 'CNB6.INS'                                                BFAULT     17
      INCLUDE 'CNB8.INS'                                                BFAULT     18
      INCLUDE 'CNB9.INS'                                                BFAULT     19
      INCLUDE 'CNB10.INS'                                               BFAULT     20
      INCLUDE 'CNB19.INS'                                               BFAULT     21
      INCLUDE 'CNPARX.INS'                                              BFAULT     22
      INCLUDE 'CNUNIT.INS'                                              BFAULT     23
      INCLUDE 'CNNNEW.INS'                                              BFAULT     24
      INCLUDE 'CNMSG.INS'                                               BFAULT     25
      CHARACTER*132 CARD                                                BFAULT     26
      CHARACTER*4 BLANK                                                 BFAULT     27
      EQUIVALENCE (BLANK,IBLANK)                                        BFAULT     28
C                                                                       BFAULT     29
      DATA BLANK/'    '/                                                BFAULT     30
C                                                                       BFAULT     31
      LDEB=.FALSE.                                                      BFAULT     32
C                                                                       BFAULT     33
C   READ END CARD                                                       BFAULT     34
C                                                                       BFAULT     35
      READ(CARD,1230) ITYP,IFAULT,IZV,NSLMTH                            BFAULT     36
      IF(NSLMTH.EQ.0)NSLMTH=1                                           BFAULT     37
      JFAULT=0                                                          BFAULT     38
      JZV=0                                                             BFAULT     39
      IF(IFAULT.EQ.0)GOTO 100                                           BFAULT     40
      IF(IFAULT.LT.0)THEN                                               BFAULT     41
      KK=IABS(IFAULT)                                                   BFAULT     42
      JFAULT=NLAD(KK)                                                   BFAULT     43
      IFAULT=NPAD(KK)                                                   BFAULT     44
      IF(IFAULT.NE.0)GOTO 100                                           BFAULT     45
      IEBK=1                                                            BFAULT     46
      WRITE(MSG(1),1240)                                                BFAULT     47
      WRITE(MSG(2),1241) JFAULT                                         BFAULT     48
      CALL PRTMSG(2)                                                    BFAULT     49
      GOTO 100                                                          BFAULT     50
      ELSE                                                              BFAULT     51
      JFAULT=NOLD(IFAULT)                                               BFAULT     52
      ENDIF                                                             BFAULT     53
 100  CONTINUE                                                          BFAULT     54
      IF(IZV.EQ.0)GOTO 110                                              BFAULT     55
      IF(IZV.LT.0)THEN                                                  BFAULT     56
      KK=IABS(IZV)                                                      BFAULT     57
      JZV=NLAD(KK)                                                      BFAULT     58
      IZV=NPAD(KK)                                                      BFAULT     59
      IF(IZV.NE.0)GOTO 110                                              BFAULT     60
      IEBK=1                                                            BFAULT     61
      WRITE(MSG(1),1250)                                                BFAULT     62
      WRITE(MSG(2),1251) JZV                                            BFAULT     63
      CALL PRTMSG(2)                                                    BFAULT     64
      GOTO 110                                                          BFAULT     65
      ELSE                                                              BFAULT     66
      JZV=NOLD(IZV)                                                     BFAULT     67
      ENDIF                                                             BFAULT     68
 110  CONTINUE                                                          BFAULT     69
      JFSTN1=IBLANK                                                     BFAULT     70
      JFSTN2=IBLANK                                                     BFAULT     71
      JFSTN3=IBLANK                                                     BFAULT     72
      IZSTN1=IBLANK                                                     BFAULT     73
      IZSTN2=IBLANK                                                     BFAULT     74
      IZSTN3=IBLANK                                                     BFAULT     75
      IF(IFAULT.EQ.0)GOTO 130                                           BFAULT     76
      IF3=IFAULT*3                                                      BFAULT     77
      JFSTN1=INAME(IF3-2)                                               BFAULT     78
      JFSTN2=INAME(IF3-1)                                               BFAULT     79
      JFSTN3=INAME(IF3)                                                 BFAULT     80
 130  IF(IZV.EQ.0)GOTO 140                                              BFAULT     81
      IZV3=IZV*3                                                        BFAULT     82
      IZSTN1=INAME(IZV3-2)                                              BFAULT     83
      IZSTN2=INAME(IZV3-1)                                              BFAULT     84
      IZSTN3=INAME(IZV3)                                                BFAULT     85
 140  CONTINUE                                                          BFAULT     86
C                                                                       BFAULT     87
      IF(IBFLAG.EQ.0.AND.(JFAULT.NE.0.OR.JZV.NE.0))THEN                 BFAULT     88
C       WRITE(IU17,1260) JFAULT,JFSTN1,JFSTN2,JFSTN3,JZV                BFAULT     89
C     & ,IZSTN1,IZSTN2,IZSTN3                                           BFAULT     90
       WRITE(IU6,1260) JFAULT,JFSTN1,JFSTN2,JFSTN3,JZV                  BFAULT     91
     & ,IZSTN1,IZSTN2,IZSTN3                                            BFAULT     92
      ENDIF                                                             BFAULT     93
C                                                                       BFAULT     94
C                                                                       BFAULT     95
C      ENDIF                                                            BFAULT     96
C                                                                       BFAULT     97
      RETURN                                                            BFAULT     98
C                                                                       BFAULT     99
 1230 FORMAT(A3,3I5)                                                    BFAULT    100
 1240 FORMAT(' *** ERROR  FAULT BUS SPECIFIED IS NOT IN THE SYSTEM')    BFAULT    101
 1241 FORMAT(12X,'JFAULT = ',I5,'  CHECK SWITCHING DATA.')              BFAULT    102
 1250 FORMAT(                                                           BFAULT    103
     *' *** ERROR  ZERO POTENTIAL BUS SPECIFIED IS NOT IN THE SYSTEM')  BFAULT    104
 1251 FORMAT(12X,'JZV = ',I5,'  CHECK SWITCHING DATA.')                 BFAULT    105
 1260 FORMAT (///,'  FAULT BUS',I6,1X,3A4,' ZERO POTENTIAL BUS',I6,1X   BFAULT    106
     *,3A4)                                                             BFAULT    107
C 1260 FORMAT (//,30X,36(' *'),/,31X,'* FAULT BUS',I6,1X,3A4            BFAULT    108
C     1,' ZERO POTENTIAL BUS',I6,1X,3A4,T102,'*')                       BFAULT    109
C                                                                       BFAULT    110
      END                                                               BFAULT    111
