CFPRIME DESTP                                                           DESTP       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 DESTP (H)                                              DESTP       3
CD                                                                      DESTP       4
CD    TO CALCULATE THE DERIVATIVES OF THE STATES OF STP FOR USE IN      DESTP       5
CD    THE RUNGE-KUTTA METHOD.                                           DESTP       6
CD                                                                      DESTP       7
CD    UPDATE THE STATES FOR THE CURRENT TIME STEP BY THE RUNGE-KUTTA    DESTP       8
CD    FORMULA.                                                          DESTP       9
CD                                                                      DESTP      10
      INCLUDE 'PARX.INS'                                                DESTP      11
      INCLUDE 'CNPT.INS'                                                DESTP      12
      INCLUDE 'CNIPTR.INS'                                              DESTP      13
      INCLUDE 'CNB4.INS'                                                DESTP      14
      INCLUDE 'CNB9.INS'                                                DESTP      15
      INCLUDE 'CNB91.INS'                                               DESTP      16
      INCLUDE 'CNSTP.INS'                                               DESTP      17
      INCLUDE 'CNUDM.INS'                                               DESTP      18
C                                                                       DESTP      19
      INCLUDE 'CNXSTA.INS'                                              DESTP      20
      INCLUDE 'CNQSTA.INS'                                              DESTP      21
      INCLUDE 'CNZSTA.INS'                                              DESTP      22
      INCLUDE 'CNMDAT.INS'                                              DESTP      23
      INCLUDE 'CNVOLT.INS'                                              DESTP      24
      INCLUDE 'CNMYVA.INS'                                              DESTP      25
      INCLUDE 'CNYVAR.INS'                                              DESTP      26
C                                                                       DESTP      27
      CHARACTER*2 LCKT                                                  DESTP      28
      CHARACTER*4 CKID                                                  DESTP      29
      INTEGER*4 JCKID                                                   DESTP      30
      EQUIVALENCE (JCKID,CKID)                                          DESTP      31
C                                                                       DESTP      32
      X1=0.0                                                            DESTP      33
      X2=0.0                                                            DESTP      34
      Y1=0.0                                                            DESTP      35
      Y2=0.0                                                            DESTP      36
C                                                                       DESTP      37
      DO 280 N=1,NTCPS                                                  DESTP      38
      JTP=JTPDAT(N)                                                     DESTP      39
      IF(H.LT.0.001) THEN                                               DESTP      40
         NSUBD=1                                                        DESTP      41
      ELSE                                                              DESTP      42
         NSUBD=IDDAT(JTP+20)                                            DESTP      43
      ENDIF                                                             DESTP      44
      IF(NSUBD.GT.1.AND..NOT.LIR1) GO TO 280                            DESTP      45
      HSUB=H/NSUBD                                                      DESTP      46
      IOFSET=JXSTC(N)                                                   DESTP      47
      JY1=JVSTP(N)                                                      DESTP      48
      K1=IDDAT(JTP+1)                                                   DESTP      49
      K2=IDDAT(JTP+2)                                                   DESTP      50
      NLF1=NOLD(K1)                                                     DESTP      51
      K13=K1*3                                                          DESTP      52
      JCKID=IDDAT(JTP+3)                                                DESTP      53
      LCKT(1:2)=CKID(3:4)                                               DESTP      54
      VR1=REAL(VOLT(K1))                                                DESTP      55
      VI1=AIMAG(VOLT(K1))                                               DESTP      56
      VM1=SQRT(VR1*VR1+VI1*VI1)                                         DESTP      57
      VR2=REAL(VOLT(K2))                                                DESTP      58
      VI2=AIMAG(VOLT(K2))                                               DESTP      59
      VM2=SQRT(VR2*VR2+VI2*VI2)                                         DESTP      60
      NTTYPN=IDDAT(JTP+4)                                               DESTP      61
      NPTYPN=IDDAT(JTP+5)                                               DESTP      62
      JYTC=JVSTC(N)                                                     DESTP      63
      JYPS=JVSPS(N)                                                     DESTP      64
      ITABT=IDDAT(JTP+6)                                                DESTP      65
      ITABP=IDDAT(JTP+7)                                                DESTP      66
      ATT=DDAT(JTP+8)                                                   DESTP      67
      XTT=DDAT(JTP+9)                                                   DESTP      68
      ATP=DDAT(JTP+10)                                                  DESTP      69
      XTP=DDAT(JTP+11)                                                  DESTP      70
      YSTP=DDAT(JTP+12)                                                 DESTP      71
      ASTP=DDAT(JTP+13)                                                 DESTP      72
C                                                                       DESTP      73
      VALIN(7)=VM1                                                      DESTP      74
      VALIN(8)=VM2                                                      DESTP      75
      IF(VM1.GT.0.05) THEN                                              DESTP      76
         VA1=ATAN2(VI1,VR1)                                             DESTP      77
         VAGD=DDAT(JTP+17)-VA1                                          DESTP      78
         DDAT(JTP+17)=VA1                                               DESTP      79
         IF(VAGD.GT.3.15) THEN                                          DESTP      80
            IDDAT(JTP+16)=IDDAT(JTP+16)+1                               DESTP      81
         ELSEIF(VAGD.LT.-3.15) THEN                                     DESTP      82
            IDDAT(JTP+16)=IDDAT(JTP+16)-1                               DESTP      83
         ENDIF                                                          DESTP      84
         VALIN(9)=VA1+6.2831853*IDDAT(JTP+16)                           DESTP      85
      ELSE                                                              DESTP      86
         VALIN(9)=DDAT(JTP+17)+6.2831853*IDDAT(JTP+16)                  DESTP      87
      ENDIF                                                             DESTP      88
      IF(VM2.GT.0.05) THEN                                              DESTP      89
         VA2=ATAN2(VI2,VR2)                                             DESTP      90
         VAGD=DDAT(JTP+19)-VA2                                          DESTP      91
         DDAT(JTP+19)=VA2                                               DESTP      92
         IF(VAGD.GT.3.15) THEN                                          DESTP      93
            IDDAT(JTP+18)=IDDAT(JTP+18)+1                               DESTP      94
         ELSEIF(VAGD.LT.-3.15) THEN                                     DESTP      95
            IDDAT(JTP+18)=IDDAT(JTP+18)-1                               DESTP      96
         ENDIF                                                          DESTP      97
         VALIN(10)=VA2+6.2831853*IDDAT(JTP+18)                          DESTP      98
      ELSE                                                              DESTP      99
         VALIN(10)=DDAT(JTP+19)+6.2831853*IDDAT(JTP+18)                 DESTP     100
      ENDIF                                                             DESTP     101
      JTP=JTP+20                                                        DESTP     102
C                                                                       DESTP     103
      G11=YVAR(JY1+1)                                                   DESTP     104
      B11=YVAR(JY1+2)                                                   DESTP     105
      G12=YVAR(JY1+3)                                                   DESTP     106
      B12=YVAR(JY1+4)                                                   DESTP     107
      G21=YVAR(JY1+5)                                                   DESTP     108
      B21=YVAR(JY1+6)                                                   DESTP     109
      G22=YVAR(JY1+7)                                                   DESTP     110
      B22=YVAR(JY1+8)                                                   DESTP     111
      CR1=G11*VR1-B11*VI1+G12*VR2-B12*VI2                               DESTP     112
      CI1=B11*VR1+G11*VI1+B12*VR2+G12*VI2                               DESTP     113
      CR2=G21*VR1-B21*VI1+G22*VR2-B22*VI2                               DESTP     114
      CI2=B21*VR1+G21*VI1+B22*VR2+G22*VI2                               DESTP     115
      CM1=SQRT(CR1*CR1+CI1*CI1)                                         DESTP     116
      CM2=SQRT(CR2*CR2+CI2*CI2)                                         DESTP     117
      PM1=VR1*CR1+VI1*CI1                                               DESTP     118
      PM2=VR2*CR2+VI2*CI2                                               DESTP     119
      QM1=VI1*CR1-VR1*CI1                                               DESTP     120
      QM2=VI2*CR2-VR2*CI2                                               DESTP     121
      VALIN(1)=CM1                                                      DESTP     122
      VALIN(2)=CM2                                                      DESTP     123
      VALIN(3)=PM1                                                      DESTP     124
      VALIN(4)=PM2                                                      DESTP     125
      VALIN(15)=QM1                                                     DESTP     126
      VALIN(16)=QM2                                                     DESTP     127
C                                                                       DESTP     128
      DO 230 JJ=1,NSUBD                                                 DESTP     129
      GOTO ( 100, 110, 120, 120, 120, 130), INTMTH                      DESTP     130
  100 CONTINUE                                                          DESTP     131
      IR1=0                                                             DESTP     132
      GOTO 130                                                          DESTP     133
  110 CONTINUE                                                          DESTP     134
      IR1=1                                                             DESTP     135
      GOTO 130                                                          DESTP     136
  120 CONTINUE                                                          DESTP     137
      IR1=2                                                             DESTP     138
  130 IR1=IR1+1                                                         DESTP     139
C                                                                       DESTP     140
      LSTATE=0                                                          DESTP     141
      IF(NTTYPN.NE.50) GO TO 160                                        DESTP     142
C                                                                       DESTP     143
C     GET THE INPUT VALUES                                              DESTP     144
C                                                                       DESTP     145
      JE0=JTDAT(N)                                                      DESTP     146
      JE1=JE0+1                                                         DESTP     147
      CALL RINUDM                                                       DESTP     148
C                                                                       DESTP     149
      VALIN(5)=TSTC(JYTC+2)                                             DESTP     150
      VALIN(11)=SSTC(JYTC+3)                                            DESTP     151
      VALIN(20)=VREF(JYTC+1)                                            DESTP     152
C                                                                       DESTP     153
      KORD=0                                                            DESTP     154
      JSTATE=JXSTC(N)                                                   DESTP     155
      CALL DEUDM(HSUB,KORD,NLF1,K13,LCKT)                               DESTP     156
      LSTATE=LSTATE+KORD                                                DESTP     157
C                                                                       DESTP     158
      IOUT=IDDAT(JE7+1)                                                 DESTP     159
      TSTC(JYTC+2)=VALOUT(IOUT)                                         DESTP     160
      SSTC(JYTC+3)=VALIN(11)                                            DESTP     161
C                                                                       DESTP     162
      IF(NSUBD.EQ.1) THEN                                               DESTP     163
         IF(LIR4) THEN                                                  DESTP     164
            JYUDM=JYTC+4                                                DESTP     165
            DO 140 J=1,NUDB                                             DESTP     166
            YVAR(JYUDM+J)=VALOUT(J)                                     DESTP     167
  140       CONTINUE                                                    DESTP     168
         ENDIF                                                          DESTP     169
      ELSE                                                              DESTP     170
         IF(JJ.EQ.NSUBD) THEN                                           DESTP     171
            JYUDM=JYTC+4                                                DESTP     172
            DO 150 J=1,NUDB                                             DESTP     173
            YVAR(JYUDM+J)=VALOUT(J)                                     DESTP     174
  150       CONTINUE                                                    DESTP     175
         ENDIF                                                          DESTP     176
      ENDIF                                                             DESTP     177
  160 CONTINUE                                                          DESTP     178
      IF(NPTYPN.NE.50) GO TO 190                                        DESTP     179
C                                                                       DESTP     180
C     GET THE INPUT VALUES                                              DESTP     181
C                                                                       DESTP     182
      JE0=JPDAT(N)                                                      DESTP     183
      JE1=JE0+1                                                         DESTP     184
      CALL RINUDM                                                       DESTP     185
      VALIN(6)=TSPS(JYPS+2)                                             DESTP     186
      VALIN(12)=SSPS(JYPS+3)                                            DESTP     187
      VALIN(20)=VREF(JYPS+1)                                            DESTP     188
C                                                                       DESTP     189
      KORD=0                                                            DESTP     190
      JSTATE=JXSPS(N)                                                   DESTP     191
      CALL DEUDM(HSUB,KORD,NLF1,K13,LCKT)                               DESTP     192
      LSTATE=LSTATE+KORD                                                DESTP     193
C                                                                       DESTP     194
      IOUT=IDDAT(JE7+1)                                                 DESTP     195
      TSPS(JYPS+2)=VALOUT(IOUT)                                         DESTP     196
      SSPS(JYPS+3)=VALIN(12)                                            DESTP     197
C                                                                       DESTP     198
      IF(NSUBD.EQ.1) THEN                                               DESTP     199
         IF(LIR4) THEN                                                  DESTP     200
            JYUDM=JYPS+4                                                DESTP     201
            DO 170 J=1,NUDB                                             DESTP     202
            YVAR(JYUDM+J)=VALOUT(J)                                     DESTP     203
  170       CONTINUE                                                    DESTP     204
         ENDIF                                                          DESTP     205
      ELSE                                                              DESTP     206
         IF(JJ.EQ.NSUBD) THEN                                           DESTP     207
            JYUDM=JYPS+4                                                DESTP     208
            DO 180 J=1,NUDB                                             DESTP     209
            YVAR(JYUDM+J)=VALOUT(J)                                     DESTP     210
  180       CONTINUE                                                    DESTP     211
         ENDIF                                                          DESTP     212
      ENDIF                                                             DESTP     213
C                                                                       DESTP     214
      GO TO 200                                                         DESTP     215
  190 CONTINUE                                                          DESTP     216
C                                                                       DESTP     217
  200 CONTINUE                                                          DESTP     218
      IF(NSUBD.EQ.1) THEN                                               DESTP     219
         CALL RKG(LSTATE,IOFSET,XSTATE,DSTATE,QSTATE,ZSTATE,H)          DESTP     220
         IF(LIR4) THEN                                                  DESTP     221
            IF(NTTYPN.EQ.50) THEN                                       DESTP     222
               JE0=JTDAT(N)                                             DESTP     223
               JE1=JE0+1                                                DESTP     224
               NRBUS=IDDAT(JE1)                                         DESTP     225
               JE2=JE1+3*NRBUS+1                                        DESTP     226
               NRLIN=IDDAT(JE2)                                         DESTP     227
               JE3=JE2+4*NRLIN+1                                        DESTP     228
               NUDB=IDDAT(JE3)                                          DESTP     229
               JE4=JE3+17*NUDB+1                                        DESTP     230
               JY=JYTC                                                  DESTP     231
               CALL UDMNWL(4)                                           DESTP     232
               GO TO 210                                                DESTP     233
            ENDIF                                                       DESTP     234
  210       CONTINUE                                                    DESTP     235
            IF(NPTYPN.EQ.50) THEN                                       DESTP     236
               JE0=JPDAT(N)                                             DESTP     237
               JE1=JE0+1                                                DESTP     238
               NRBUS=IDDAT(JE1)                                         DESTP     239
               JE2=JE1+3*NRBUS+1                                        DESTP     240
               NRLIN=IDDAT(JE2)                                         DESTP     241
               JE3=JE2+4*NRLIN+1                                        DESTP     242
               NUDB=IDDAT(JE3)                                          DESTP     243
               JE4=JE3+17*NUDB+1                                        DESTP     244
               JY=JYPS                                                  DESTP     245
               CALL UDMNWL(5)                                           DESTP     246
            ENDIF                                                       DESTP     247
         ENDIF                                                          DESTP     248
      ELSE                                                              DESTP     249
         CALL ICOEF1                                                    DESTP     250
         CALL RKG1(LSTATE,0,IOFSET,XSTATE,DSTATE,QSTATE,ZSTATE,HSUB)    DESTP     251
         IF(IR1.LT.4) GO TO 130                                         DESTP     252
         IF(NTTYPN.EQ.50) THEN                                          DESTP     253
            JE0=JTDAT(N)                                                DESTP     254
            JE1=JE0+1                                                   DESTP     255
            NRBUS=IDDAT(JE1)                                            DESTP     256
            JE2=JE1+3*NRBUS+1                                           DESTP     257
            NRLIN=IDDAT(JE2)                                            DESTP     258
            JE3=JE2+4*NRLIN+1                                           DESTP     259
            NUDB=IDDAT(JE3)                                             DESTP     260
            JE4=JE3+17*NUDB+1                                           DESTP     261
            JY=JYTC                                                     DESTP     262
            CALL UDMNWL(4)                                              DESTP     263
            GO TO 220                                                   DESTP     264
         ENDIF                                                          DESTP     265
  220    CONTINUE                                                       DESTP     266
         IF(NPTYPN.EQ.50) THEN                                          DESTP     267
            JE0=JPDAT(N)                                                DESTP     268
            JE1=JE0+1                                                   DESTP     269
            NRBUS=IDDAT(JE1)                                            DESTP     270
            JE2=JE1+3*NRBUS+1                                           DESTP     271
            NRLIN=IDDAT(JE2)                                            DESTP     272
            JE3=JE2+4*NRLIN+1                                           DESTP     273
            NUDB=IDDAT(JE3)                                             DESTP     274
            JE4=JE3+17*NUDB+1                                           DESTP     275
            JY=JYPS                                                     DESTP     276
            CALL UDMNWL(5)                                              DESTP     277
         ENDIF                                                          DESTP     278
      ENDIF                                                             DESTP     279
  230 CONTINUE                                                          DESTP     280
C                                                                       DESTP     281
      TSTCN=TSTC(JYTC+2)+TSTC(JYTC+4)                                   DESTP     282
      TSPSN=TSPS(JYPS+2)+TSPS(JYPS+4)                                   DESTP     283
      YFACTT=1.0                                                        DESTP     284
      YFACTP=1.0                                                        DESTP     285
      IF(ITABT.GT.0) THEN                                               DESTP     286
         TN=TSTCN                                                       DESTP     287
         DO 240 I=2,ITABT                                               DESTP     288
         NTAB=2*I                                                       DESTP     289
         Y2=DDAT(JTP+NTAB)                                              DESTP     290
         X2=DDAT(JTP+NTAB-1)                                            DESTP     291
         Y1=DDAT(JTP+NTAB-2)                                            DESTP     292
         X1=DDAT(JTP+NTAB-3)                                            DESTP     293
         IF(TN.LE.X2) GO TO 250                                         DESTP     294
  240    CONTINUE                                                       DESTP     295
  250    YFACTT=1.0/(Y1+(TN-X1)*(Y2-Y1)/(X2-X1))                        DESTP     296
      ENDIF                                                             DESTP     297
      JTP1=JTP+2*ITABT                                                  DESTP     298
      IF(ITABP.GT.0) THEN                                               DESTP     299
         TN=TSPSN                                                       DESTP     300
         DO 260 I=2,ITABP                                               DESTP     301
         NTAB=2*I                                                       DESTP     302
         Y2=DDAT(JTP1+NTAB)                                             DESTP     303
         X2=DDAT(JTP1+NTAB-1)                                           DESTP     304
         Y1=DDAT(JTP1+NTAB-2)                                           DESTP     305
         X1=DDAT(JTP1+NTAB-3)                                           DESTP     306
         IF(TN.LE.X2) GO TO 270                                         DESTP     307
  260    CONTINUE                                                       DESTP     308
  270    YFACTP=1.0/(Y1+(TN-X1)*(Y2-Y1)/(X2-X1))                        DESTP     309
      ENDIF                                                             DESTP     310
      YSTPM=YSTP*YFACTT*YFACTP                                          DESTP     311
      GSTP=YSTPM*COS(ASTP)                                              DESTP     312
      BSTP=YSTPM*SIN(ASTP)                                              DESTP     313
C                                                                       DESTP     314
      A1RE=1.0+ATT*(1.0-XTT)*TSTCN                                      DESTP     315
      A1IM=ATP*(1.0-XTP)*TSPSN                                          DESTP     316
      A1M=SQRT(A1RE*A1RE+A1IM*A1IM)                                     DESTP     317
      AA1=ATAN2(A1IM,A1RE)                                              DESTP     318
      A2RE=1.0-ATT*XTT*TSTCN                                            DESTP     319
      A2IM=-ATP*XTP*TSPSN                                               DESTP     320
      A2M=SQRT(A2RE*A2RE+A2IM*A2IM)                                     DESTP     321
      AA2=ATAN2(A2IM,A2RE)                                              DESTP     322
      FACT1=A1M*A1M                                                     DESTP     323
      FACT2=A2M*A2M                                                     DESTP     324
      Y12=YSTPM/A1M/A2M                                                 DESTP     325
      AY12=ASTP+AA1-AA2                                                 DESTP     326
      AY21=ASTP-AA1+AA2                                                 DESTP     327
      YVAR(JY1+1)=GSTP/FACT1                                            DESTP     328
      YVAR(JY1+2)=BSTP/FACT1                                            DESTP     329
      YVAR(JY1+3)=-Y12*COS(AY12)                                        DESTP     330
      YVAR(JY1+4)=-Y12*SIN(AY12)                                        DESTP     331
      YVAR(JY1+5)=-Y12*COS(AY21)                                        DESTP     332
      YVAR(JY1+6)=-Y12*SIN(AY21)                                        DESTP     333
      YVAR(JY1+7)=GSTP/FACT2                                            DESTP     334
      YVAR(JY1+8)=BSTP/FACT2                                            DESTP     335
  280 CONTINUE                                                          DESTP     336
      RETURN                                                            DESTP     337
C                                                                       DESTP     338
      END                                                               DESTP     339
