CFPRIME DESDB                                                           DESDB       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 DESDB (H)                                              DESDB       3
CD                                                                      DESDB       4
CD    TO CALCULATE THE DERIVATIVES OF THE STATES OF SDB FOR USE IN      DESDB       5
CD    THE RUNGE-KUTTA METHOD.                                           DESDB       6
CD                                                                      DESDB       7
CD    UPDATE THE STATES FOR THE CURRENT TIME STEP BY THE RUNGE-KUTTA    DESDB       8
CD    FORMULA.                                                          DESDB       9
CD                                                                      DESDB      10
      INCLUDE 'PARX.INS'                                                DESDB      11
      INCLUDE 'CNPT.INS'                                                DESDB      12
      INCLUDE 'CNIPTR.INS'                                              DESDB      13
      INCLUDE 'CNB4.INS'                                                DESDB      14
      INCLUDE 'CNB9.INS'                                                DESDB      15
      INCLUDE 'CNB91.INS'                                               DESDB      16
      INCLUDE 'CNSDB.INS'                                               DESDB      17
      INCLUDE 'CNUDM.INS'                                               DESDB      18
C                                                                       DESDB      19
      INCLUDE 'CNXSTA.INS'                                              DESDB      20
      INCLUDE 'CNQSTA.INS'                                              DESDB      21
      INCLUDE 'CNZSTA.INS'                                              DESDB      22
      INCLUDE 'CNMDAT.INS'                                              DESDB      23
      INCLUDE 'CNVOLT.INS'                                              DESDB      24
      INCLUDE 'CNMYVA.INS'                                              DESDB      25
      INCLUDE 'CNYVAR.INS'                                              DESDB      26
C                                                                       DESDB      27
      CHARACTER*2 LCKT                                                  DESDB      28
      DATA LCKT/'  '/                                                   DESDB      29
C                                                                       DESDB      30
      DO 500 N=1,NSDB                                                   DESDB      31
      JD=JDDAT(N)                                                       DESDB      32
      IF(H.LT.0.001) THEN                                               DESDB      33
         NSUBD=1                                                        DESDB      34
      ELSE                                                              DESDB      35
         NSUBD=IDDAT(JD+3)                                              DESDB      36
      ENDIF                                                             DESDB      37
      IF(NSUBD.GT.1.AND..NOT.LIR1) GO TO 500                            DESDB      38
      HSUB=H/NSUBD                                                      DESDB      39
      JSTATE=JXSDB(N)                                                   DESDB      40
      JY=JVSDB(N)                                                       DESDB      41
      NDTYPN=IDDAT(JD+2)                                                DESDB      42
      IF(NDTYPN.NE.50) GO TO 180                                        DESDB      43
C                                                                       DESDB      44
C     GET THE INPUT VALUES                                              DESDB      45
C                                                                       DESDB      46
      LSTATE=0                                                          DESDB      47
      JE0=JD+3                                                          DESDB      48
      JE1=JE0+3                                                         DESDB      49
      CALL RINUDM                                                       DESDB      50
C                                                                       DESDB      51
      K1=IDDAT(JD+1)                                                    DESDB      52
      NLF1=NOLD(K1)                                                     DESDB      53
      K13=K1*3                                                          DESDB      54
      VRE=REAL(VOLT(K1))                                                DESDB      55
      VIM=AIMAG(VOLT(K1))                                               DESDB      56
      VMG=SQRT(VRE*VRE+VIM*VIM)                                         DESDB      57
      VALIN(7)=VMG                                                      DESDB      58
      IF(VMG.GT.0.05)THEN                                               DESDB      59
         VAG=ATAN2(VIM,VRE)                                             DESDB      60
         VAGD=DDAT(JE0+2)-VAG                                           DESDB      61
         DDAT(JE0+2)=VAG                                                DESDB      62
         IF(VAGD.GT.3.15) THEN                                          DESDB      63
            IDDAT(JE0+1)=IDDAT(JE0+1)+1                                 DESDB      64
         ELSEIF(VAGD.LT.-3.15) THEN                                     DESDB      65
            IDDAT(JE0+1)=IDDAT(JE0+1)-1                                 DESDB      66
         ENDIF                                                          DESDB      67
         VALIN(9)=VAG+6.2831853*IDDAT(JE0+1)                            DESDB      68
      ELSE                                                              DESDB      69
         VALIN(9)=DDAT(JE0+2)+6.2831853*IDDAT(JE0+1)                    DESDB      70
      ENDIF                                                             DESDB      71
      VALIN(1)=VMG*YDEV(JY+2)                                           DESDB      72
      VALIN(3)=VMG*VALIN(1)                                             DESDB      73
C                                                                       DESDB      74
      DO 170 JJ=1,NSUBD                                                 DESDB      75
      GOTO ( 110, 120, 130, 130, 130, 140), INTMTH                      DESDB      76
  110 CONTINUE                                                          DESDB      77
      IR1=0                                                             DESDB      78
      GOTO 140                                                          DESDB      79
  120 CONTINUE                                                          DESDB      80
      IR1=1                                                             DESDB      81
      GOTO 140                                                          DESDB      82
  130 CONTINUE                                                          DESDB      83
      IR1=2                                                             DESDB      84
  140 IR1=IR1+1                                                         DESDB      85
      NXS=0                                                             DESDB      86
C                                                                       DESDB      87
      VALIN(5)=YDEV(JY+2)                                               DESDB      88
      VALIN(12)=SSDB(JY+3)                                              DESDB      89
C                                                                       DESDB      90
      CALL DEUDM(HSUB,NXS,NLF1,K13,LCKT)                                DESDB      91
C                                                                       DESDB      92
      IOUT=IDDAT(JE7+1)                                                 DESDB      93
      YSDB(JY+1)=VALOUT(IOUT)*BASER(JY+4)                               DESDB      94
      YDEV(JY+2)=VALOUT(IOUT)                                           DESDB      95
      SSDB(JY+3)=VALIN(12)                                              DESDB      96
C                                                                       DESDB      97
      IF(NSUBD.EQ.1) THEN                                               DESDB      98
         CALL RKG(NXS,JSTATE,XSTATE,DSTATE,QSTATE,ZSTATE,H)             DESDB      99
         IF(LIR4) THEN                                                  DESDB     100
            JYUDM=JY+4                                                  DESDB     101
            DO 150 J=1,NUDB                                             DESDB     102
            YVAR(JYUDM+J)=VALOUT(J)                                     DESDB     103
  150       CONTINUE                                                    DESDB     104
            CALL UDMNWL(6)                                              DESDB     105
         ENDIF                                                          DESDB     106
      ELSE                                                              DESDB     107
         CALL ICOEF1                                                    DESDB     108
         CALL RKG1(NXS,0,JSTATE,XSTATE,DSTATE,QSTATE,ZSTATE,HSUB)       DESDB     109
         IF(IR1.LT.4) GO TO 140                                         DESDB     110
         IF(JJ.EQ.NSUBD) THEN                                           DESDB     111
            JYUDM=JY+4                                                  DESDB     112
            DO 160 J=1,NUDB                                             DESDB     113
            YVAR(JYUDM+J)=VALOUT(J)                                     DESDB     114
  160       CONTINUE                                                    DESDB     115
         ENDIF                                                          DESDB     116
         CALL UDMNWL(6)                                                 DESDB     117
      ENDIF                                                             DESDB     118
  170 CONTINUE                                                          DESDB     119
      GO TO 500                                                         DESDB     120
C                                                                       DESDB     121
  180 CONTINUE                                                          DESDB     122
  500 CONTINUE                                                          DESDB     123
      RETURN                                                            DESDB     124
C                                                                       DESDB     125
      END                                                               DESDB     126
