CFPRIME DESVC                                                           DESVC       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 DESVC (H)                                              DESVC       3
CD                                                                      DESVC       4
CD    TO CALCULATE THE DERIVATIVES OF THE STATES OF SVC FOR USE IN      DESVC       5
CD    THE RUNGE-KUTTA METHOD.                                           DESVC       6
CD                                                                      DESVC       7
CD    UPDATE THE STATES FOR THE CURRENT TIME STEP BY THE RUNGE-KUTTA    DESVC       8
CD    FORMULA.                                                          DESVC       9
CD                                                                      DESVC      10
      INCLUDE 'PARX.INS'                                                DESVC      11
      INCLUDE 'CNPT.INS'                                                DESVC      12
      INCLUDE 'CNIPTR.INS'                                              DESVC      13
      INCLUDE 'CNB1.INS'                                                DESVC      14
      INCLUDE 'CNB4.INS'                                                DESVC      15
      INCLUDE 'CNB9.INS'                                                DESVC      16
      INCLUDE 'CNB19.INS'                                               DESVC      17
      INCLUDE 'CNB91.INS'                                               DESVC      18
      INCLUDE 'CNSVS.INS'                                               DESVC      19
      INCLUDE 'CNUDM.INS'                                               DESVC      20
C                                                                       DESVC      21
      INCLUDE 'CNXSTA.INS'                                              DESVC      22
      INCLUDE 'CNQSTA.INS'                                              DESVC      23
      INCLUDE 'CNZSTA.INS'                                              DESVC      24
      INCLUDE 'CNMDAT.INS'                                              DESVC      25
      INCLUDE 'CNVOLT.INS'                                              DESVC      26
      INCLUDE 'CNMYVA.INS'                                              DESVC      27
      INCLUDE 'CNYVAR.INS'                                              DESVC      28
C                                                                       DESVC      29
      CHARACTER*2 CID                                                   DESVC      30
C                                                                       DESVC      31
      VI2=0.0                                                           DESVC      32
C                                                                       DESVC      33
      DO 540 N=1,NSVC                                                   DESVC      34
      JS=JSDAT(N)                                                       DESVC      35
      JSTATE=JXSVR(N)                                                   DESVC      36
      CID=NSVCID(N)(3:4)                                                DESVC      37
      JY=JVSVR(N)                                                       DESVC      38
      NRTYPN=IDDAT(JS+9)                                                DESVC      39
      KS=NROLD(N)                                                       DESVC      40
      K13=KS*3                                                          DESVC      41
      NLF1=NOLD(KS)                                                     DESVC      42
      IF(NRTYPN.NE.50) GO TO 180                                        DESVC      43
      IF(H.LT.0.001) THEN                                               DESVC      44
         NSUBD=1                                                        DESVC      45
      ELSE                                                              DESVC      46
         NSUBD=IDDAT(JS+12)                                             DESVC      47
      ENDIF                                                             DESVC      48
      IF(NSUBD.GT.1.AND..NOT.LIR1) GO TO 540                            DESVC      49
      HSUB=H/NSUBD                                                      DESVC      50
      LSTATE=0                                                          DESVC      51
C                                                                       DESVC      52
C     GET THE INPUT VALUES                                              DESVC      53
C                                                                       DESVC      54
      JE0=JS                                                            DESVC      55
      JE1=JE0+13                                                        DESVC      56
      CALL RINUDM                                                       DESVC      57
C                                                                       DESVC      58
      VRE=REAL(VOLT(KS))                                                DESVC      59
      VIM=AIMAG(VOLT(KS))                                               DESVC      60
      VMG=SQRT(VRE*VRE+VIM*VIM)                                         DESVC      61
      VALIN(7)=VMG                                                      DESVC      62
      VALIN(8)=0.0                                                      DESVC      63
      IF(VMG.GT.0.05)THEN                                               DESVC      64
         VAG=ATAN2(VIM,VRE)                                             DESVC      65
         VAGD=DDAT(JE0+2)-VAG                                           DESVC      66
         DDAT(JE0+2)=VAG                                                DESVC      67
         IF(VAGD.GT.3.15) THEN                                          DESVC      68
            IDDAT(JE0+1)=IDDAT(JE0+1)+1                                 DESVC      69
         ELSEIF(VAGD.LT.-3.15) THEN                                     DESVC      70
            IDDAT(JE0+1)=IDDAT(JE0+1)-1                                 DESVC      71
         ENDIF                                                          DESVC      72
         VALIN(9)=VAG+6.2831853*IDDAT(JE0+1)                            DESVC      73
      ELSE                                                              DESVC      74
         VALIN(9)=DDAT(JE0+2)+6.2831853*IDDAT(JE0+1)                    DESVC      75
      ENDIF                                                             DESVC      76
      VALIN(10)=0.0                                                     DESVC      77
      IF(BASER(JY+4).GT.0.0) THEN                                       DESVC      78
         VALIN(1)=VMG*BDEV(JY+5)                                        DESVC      79
         VALIN(2)=VMG*BTCR(JY+6)                                        DESVC      80
         VALIN(3)=VMG*VALIN(1)                                          DESVC      81
         VALIN(4)=VMG*VALIN(2)                                          DESVC      82
      ELSE                                                              DESVC      83
         VALIN(3)=VMG*BDEV(JY+5)                                        DESVC      84
         IF(VMG.GT.0.0001) THEN                                         DESVC      85
            VALIN(5)=BDEV(JY+5)/VMG                                     DESVC      86
         ELSE                                                           DESVC      87
            VALIN(5)=0.0                                                DESVC      88
         ENDIF                                                          DESVC      89
      ENDIF                                                             DESVC      90
      VALIN(20)=RVREF(JY+1)                                             DESVC      91
C                                                                       DESVC      92
      DO 170 JJ=1,NSUBD                                                 DESVC      93
      IF(LIR1) THEN                                                     DESVC      94
         JE0=0                                                          DESVC      95
      ELSE                                                              DESVC      96
         JE0=1                                                          DESVC      97
      ENDIF                                                             DESVC      98
      GOTO ( 110, 120, 130, 130, 130, 140), INTMTH                      DESVC      99
  110 CONTINUE                                                          DESVC     100
      IR1=0                                                             DESVC     101
      GOTO 140                                                          DESVC     102
  120 CONTINUE                                                          DESVC     103
      IR1=1                                                             DESVC     104
      GOTO 140                                                          DESVC     105
  130 CONTINUE                                                          DESVC     106
      IR1=2                                                             DESVC     107
  140 IR1=IR1+1                                                         DESVC     108
      NXS=0                                                             DESVC     109
C                                                                       DESVC     110
      IF(BASER(JY+4).GT.0.0) THEN                                       DESVC     111
         VALIN(5)=BDEV(JY+5)                                            DESVC     112
         VALIN(6)=BTCR(JY+6)                                            DESVC     113
         VALIN(11)=STCR(JY+7)                                           DESVC     114
      ELSE                                                              DESVC     115
         VALIN(1)=BDEV(JY+5)                                            DESVC     116
         VALIN(12)=STCR(JY+7)                                           DESVC     117
      ENDIF                                                             DESVC     118
C                                                                       DESVC     119
C      IF(LIR4.OR.IR1.EQ.4) THEN                                        DESVC     120
C         JE0=0                                                         DESVC     121
C      ELSE                                                             DESVC     122
C         JE0=1                                                         DESVC     123
C      ENDIF                                                            DESVC     124
      CALL DEUDM(HSUB,NXS,NLF1,K13,CID)                                 DESVC     125
      JE0=1                                                             DESVC     126
C                                                                       DESVC     127
      IOUT=IDDAT(JE7+1)                                                 DESVC     128
      BSVC(JY+2)=VALOUT(IOUT)*ABS(BASER(JY+4))+BSVCO(JY+8)              DESVC     129
      BDEV(JY+5)=VALOUT(IOUT)                                           DESVC     130
      IF(BASER(JY+4).GT.0.0) THEN                                       DESVC     131
         BTCR(JY+6)=VALIN(6)                                            DESVC     132
         STCR(JY+7)=VALIN(11)                                           DESVC     133
      ELSE                                                              DESVC     134
         STCR(JY+7)=VALIN(12)                                           DESVC     135
      ENDIF                                                             DESVC     136
C                                                                       DESVC     137
      IF(NSUBD.EQ.1) THEN                                               DESVC     138
         CALL RKG(NXS,JSTATE,XSTATE,DSTATE,QSTATE,ZSTATE,H)             DESVC     139
         IF(LIR4) THEN                                                  DESVC     140
            JYUDM=JY+8                                                  DESVC     141
            DO 150 J=1,NUDB                                             DESVC     142
            YVAR(JYUDM+J)=VALOUT(J)                                     DESVC     143
  150       CONTINUE                                                    DESVC     144
            CALL UDMNWL(3)                                              DESVC     145
         ENDIF                                                          DESVC     146
      ELSE                                                              DESVC     147
         CALL ICOEF1                                                    DESVC     148
         CALL RKG1(NXS,0,JSTATE,XSTATE,DSTATE,QSTATE,ZSTATE,HSUB)       DESVC     149
         IF(IR1.LT.4) GO TO 140                                         DESVC     150
         IF(JJ.EQ.NSUBD) THEN                                           DESVC     151
            JYUDM=JY+8                                                  DESVC     152
            DO 160 J=1,NUDB                                             DESVC     153
            YVAR(JYUDM+J)=VALOUT(J)                                     DESVC     154
  160       CONTINUE                                                    DESVC     155
         ENDIF                                                          DESVC     156
         CALL UDMNWL(3)                                                 DESVC     157
      ENDIF                                                             DESVC     158
  170 CONTINUE                                                          DESVC     159
      GO TO 540                                                         DESVC     160
C                                                                       DESVC     161
  180 CONTINUE                                                          DESVC     162
      VMG=CABS(VOLT(KS))                                                DESVC     163
      IF (NRTYPN.LT.6) GO TO 190                                        DESVC     164
      V1=DDAT(JS+1)                                                     DESVC     165
      V2=DDAT(JS+2)                                                     DESVC     166
      G1=DDAT(JS+3)                                                     DESVC     167
      G2=DDAT(JS+4)                                                     DESVC     168
      CALL SATFU (VMG,V1,V2,G1,G2,FACT)                                 DESVC     169
      DDAT(JS+6)=FACT                                                   DESVC     170
      GO TO 540                                                         DESVC     171
  190 CONTINUE                                                          DESVC     172
      L=IDDAT(JS+10)                                                    DESVC     173
      VL=CABS(VOLT(L))                                                  DESVC     174
      BSVCX=BSVC(JY+2)/BASER(JY+4)                                      DESVC     175
C                                                                       DESVC     176
C     TYPE 1 COMPENSATOR                                                DESVC     177
C                                                                       DESVC     178
      IF (NRTYPN.NE.1) GO TO 290                                        DESVC     179
      IF(H.LT.0.001) THEN                                               DESVC     180
         NSUBD=1                                                        DESVC     181
      ELSE                                                              DESVC     182
         NSUBD=IDDAT(JS+12)                                             DESVC     183
      ENDIF                                                             DESVC     184
      IF(NSUBD.GT.1.AND..NOT.LIR1) GO TO 540                            DESVC     185
      HSUB=H/NSUBD                                                      DESVC     186
C                                                                       DESVC     187
      IF (ABS(VL-DDAT(JS+13)).LT.DBTOL) VL=DDAT(JS+13)                  DESVC     188
C                                                                       DESVC     189
      VSUM=DDAT(JS+1)*(VL-RVREF(JY+1))                                  DESVC     190
      DO 280 JJ=1,NSUBD                                                 DESVC     191
      GOTO ( 200, 210, 220, 220, 220, 230), INTMTH                      DESVC     192
  200 CONTINUE                                                          DESVC     193
      IR1=0                                                             DESVC     194
      GOTO 230                                                          DESVC     195
  210 CONTINUE                                                          DESVC     196
      IR1=1                                                             DESVC     197
      GOTO 230                                                          DESVC     198
  220 CONTINUE                                                          DESVC     199
      IR1=2                                                             DESVC     200
  230 IR1=IR1+1                                                         DESVC     201
      NXS=0                                                             DESVC     202
      IF (DDAT(JS+6).LE.0.0) GO TO 240                                  DESVC     203
      NXS=1                                                             DESVC     204
      DSTATE(NXS)=(VSUM-XSTATE(JSTATE+NXS))*DDAT(JS+6)                  DESVC     205
      T1T3=DDAT(JS+4)*DDAT(JS+6)                                        DESVC     206
      X1=(1.0-T1T3)*XSTATE(JSTATE+NXS)+T1T3*VSUM                        DESVC     207
      GO TO 250                                                         DESVC     208
  240 CONTINUE                                                          DESVC     209
      X1=VSUM                                                           DESVC     210
  250 IF (DDAT(JS+7).LE.0.0) GO TO 260                                  DESVC     211
      NXS=NXS+1                                                         DESVC     212
      DSTATE(NXS)=(X1-XSTATE(JSTATE+NXS))*DDAT(JS+7)                    DESVC     213
      T2T4=DDAT(JS+5)*DDAT(JS+7)                                        DESVC     214
      X1=X1*T2T4+(1.0-T2T4)*XSTATE(JSTATE+NXS)                          DESVC     215
  260 CONTINUE                                                          DESVC     216
      XMIN=-DDAT(JS+3)                                                  DESVC     217
      XMAX=1.0+XMIN                                                     DESVC     218
      IF(X1.GT.XMAX) X1=XMAX                                            DESVC     219
      IF(X1.LT.XMIN) X1=XMIN                                            DESVC     220
      IF (DDAT(JS+8).LE.0.0) GO TO 270                                  DESVC     221
      NXS=NXS+1                                                         DESVC     222
      DSTATE(NXS)=(X1-XSTATE(JSTATE+NXS))*DDAT(JS+8)                    DESVC     223
      X1=XSTATE(JSTATE+NXS)                                             DESVC     224
      IF (X1.GE.XMAX) THEN                                              DESVC     225
         X1=XMAX                                                        DESVC     226
         IF (DSTATE(NXS).GT.0.0) THEN                                   DESVC     227
            DSTATE(NXS)=0.0                                             DESVC     228
            QSTATE(JSTATE+NXS)=0.0                                      DESVC     229
         END IF                                                         DESVC     230
      ELSE IF (X1.LE.XMIN) THEN                                         DESVC     231
         X1=XMIN                                                        DESVC     232
         IF (DSTATE(NXS).LT.0.0) THEN                                   DESVC     233
            DSTATE(NXS)=0.0                                             DESVC     234
            QSTATE(JSTATE+NXS)=0.0                                      DESVC     235
         END IF                                                         DESVC     236
      END IF                                                            DESVC     237
  270 CONTINUE                                                          DESVC     238
      BSVC(JY+2)=X1*BASER(JY+4)                                         DESVC     239
      IF(NSUBD.EQ.1) THEN                                               DESVC     240
         CALL RKG(NXS,JSTATE,XSTATE,DSTATE,QSTATE,ZSTATE,H)             DESVC     241
         IF(LIR4) THEN                                                  DESVC     242
            IF(DDAT(JS+8).LE.0.0) GO TO 540                             DESVC     243
            IF(XSTATE(JSTATE+NXS).GT.XMAX) THEN                         DESVC     244
               XSTATE(JSTATE+NXS)=XMAX                                  DESVC     245
               BSVC(JY+2)=XMAX*BASER(JY+4)                              DESVC     246
               GO TO 540                                                DESVC     247
            ENDIF                                                       DESVC     248
            IF(XSTATE(JSTATE+NXS).LT.XMIN) THEN                         DESVC     249
               XSTATE(JSTATE+NXS)=XMIN                                  DESVC     250
               BSVC(JY+2)=XMIN*BASER(JY+4)                              DESVC     251
            ENDIF                                                       DESVC     252
         ENDIF                                                          DESVC     253
      ELSE                                                              DESVC     254
         CALL ICOEF1                                                    DESVC     255
         CALL RKG1(NXS,0,JSTATE,XSTATE,DSTATE,QSTATE,ZSTATE,HSUB)       DESVC     256
         IF(IR1.LT.4) GO TO 230                                         DESVC     257
         IF(DDAT(JS+8).LE.0.0) GO TO 280                                DESVC     258
         IF(XSTATE(JSTATE+NXS).GT.XMAX) THEN                            DESVC     259
            XSTATE(JSTATE+NXS)=XMAX                                     DESVC     260
            BSVC(JY+2)=XMAX*BASER(JY+4)                                 DESVC     261
            GO TO 280                                                   DESVC     262
         ENDIF                                                          DESVC     263
         IF(XSTATE(JSTATE+NXS).LT.XMIN) THEN                            DESVC     264
            XSTATE(JSTATE+NXS)=XMIN                                     DESVC     265
            BSVC(JY+2)=XMIN*BASER(JY+4)                                 DESVC     266
         ENDIF                                                          DESVC     267
      ENDIF                                                             DESVC     268
  280 CONTINUE                                                          DESVC     269
      GO TO 540                                                         DESVC     270
  290 CONTINUE                                                          DESVC     271
C                                                                       DESVC     272
      IF(NRTYPN.NE.2.AND.NRTYPN.NE.3) GO TO 540                         DESVC     273
      IF(H.LT.0.001) THEN                                               DESVC     274
         NSUBD=1                                                        DESVC     275
      ELSE                                                              DESVC     276
         NSUBD=IDDAT(JS+12)                                             DESVC     277
      ENDIF                                                             DESVC     278
      IF(NSUBD.GT.1.AND..NOT.LIR1) GO TO 540                            DESVC     279
      HSUB=H/NSUBD                                                      DESVC     280
      INFLAG=0                                                          DESVC     281
      VSCS=0.0                                                          DESVC     282
      DO 530 JJ=1,NSUBD                                                 DESVC     283
      GOTO ( 300, 310, 320, 320, 320, 330), INTMTH                      DESVC     284
  300 CONTINUE                                                          DESVC     285
      IR1=0                                                             DESVC     286
      GOTO 330                                                          DESVC     287
  310 CONTINUE                                                          DESVC     288
      IR1=1                                                             DESVC     289
      GOTO 330                                                          DESVC     290
  320 CONTINUE                                                          DESVC     291
      IR1=2                                                             DESVC     292
  330 IR1=IR1+1                                                         DESVC     293
      NXS=0                                                             DESVC     294
C                                                                       DESVC     295
      IF(NRTYPN.NE.3) GO TO 450                                         DESVC     296
      IF(INFLAG.EQ.0) THEN                                              DESVC     297
         INFLAG=1                                                       DESVC     298
         MT1=IDDAT(JS+28)                                               DESVC     299
         MT2=IDDAT(JS+29)                                               DESVC     300
         IF(MT1.NE.0) GO TO 350                                         DESVC     301
         NLF1=IDDAT(JS+30)                                              DESVC     302
         VRE=REAL(VOLT(NLF1))                                           DESVC     303
         VIM=AIMAG(VOLT(NLF1))                                          DESVC     304
         MLIN=IDDAT(JS+8)                                               DESVC     305
         VI1=0.0                                                        DESVC     306
         DO 340 I=1,MLIN                                                DESVC     307
         LOC=IDDAT(JS+45+2*I)                                           DESVC     308
         CALL GETCUR(CURR,CURI,LOC)                                     DESVC     309
         VI1=VI1+VRE*CURR+VIM*CURI                                      DESVC     310
  340    CONTINUE                                                       DESVC     311
  350    IF(MT1.NE.1) GO TO 360                                         DESVC     312
         NLF1=IDDAT(JS+31)                                              DESVC     313
         VRE=REAL(VOLT(NLF1))                                           DESVC     314
         VIM=AIMAG(VOLT(NLF1))                                          DESVC     315
         VMG1=SQRT(VRE*VRE+VIM*VIM)                                     DESVC     316
         IF(VMG1.GT.0.05) THEN                                          DESVC     317
            VI1=ATAN2(VIM,VRE)                                          DESVC     318
            VI1D=DDAT(JS+45)-VI1                                        DESVC     319
            DDAT(JS+45)=VI1                                             DESVC     320
            IF(VI1D.GT.3.15) THEN                                       DESVC     321
               IDDAT(JS+44)=IDDAT(JS+44)+1                              DESVC     322
            ELSEIF(VI1D.LT.-3.15) THEN                                  DESVC     323
               IDDAT(JS+44)=IDDAT(JS+44)-1                              DESVC     324
            ENDIF                                                       DESVC     325
            VI1=VI1+6.2831853*IDDAT(JS+44)                              DESVC     326
         ELSE                                                           DESVC     327
            VI1=DDAT(JS+45)+6.2831853*IDDAT(JS+44)                      DESVC     328
         ENDIF                                                          DESVC     329
         NXS=NXS+1                                                      DESVC     330
         TFINV=DDAT(JS+30)                                              DESVC     331
         DSTATE(NXS)=TFINV*(VI1-XSTATE(JSTATE+NXS))                     DESVC     332
         VI1=DSTATE(NXS)/WOBASE                                         DESVC     333
  360    IF(MT1.NE.2) GO TO 370                                         DESVC     334
         NLF1=IDDAT(JS+30)                                              DESVC     335
         IDGEN=IDDAT(JS+31)                                             DESVC     336
         JYGR=MYVAR(1,IDGEN)                                            DESVC     337
         VI1=YVAR(JYGR+6)                                               DESVC     338
  370    IF(MT2.NE.0) GO TO 380                                         DESVC     339
         VI2=VL                                                         DESVC     340
  380    IF(MT2.NE.1) GO TO 390                                         DESVC     341
         VI2=BSVCX*VMG**2                                               DESVC     342
  390    IF(MT2.NE.2) GO TO 400                                         DESVC     343
         VI2=BSVCX*VMG                                                  DESVC     344
  400    VI1=VI1*DDAT(JS+33)                                            DESVC     345
         VI2=VI2*DDAT(JS+40)                                            DESVC     346
      ENDIF                                                             DESVC     347
      VI1X=VI1                                                          DESVC     348
      VI2X=VI2                                                          DESVC     349
      IF(DDAT(JS+34).LE.0.0) GO TO 410                                  DESVC     350
      NXS=NXS+1                                                         DESVC     351
      TINV=DDAT(JS+34)                                                  DESVC     352
      DSTATE(NXS)=TINV*(VI1X-XSTATE(JSTATE+NXS))                        DESVC     353
      VI1X=XSTATE(JSTATE+NXS)                                           DESVC     354
  410 IF(DDAT(JS+36).LE.0.0) GO TO 420                                  DESVC     355
      NXS=NXS+1                                                         DESVC     356
      TINV=DDAT(JS+36)                                                  DESVC     357
      DSTATE(NXS)=TINV*(VI1X-XSTATE(JSTATE+NXS))                        DESVC     358
      VI1X=DDAT(JS+35)*DSTATE(NXS)+XSTATE(JSTATE+NXS)                   DESVC     359
  420 IF(DDAT(JS+41).LE.0.0) GO TO 430                                  DESVC     360
      NXS=NXS+1                                                         DESVC     361
      TINV=DDAT(JS+41)                                                  DESVC     362
      DSTATE(NXS)=TINV*(VI2X-XSTATE(JSTATE+NXS))                        DESVC     363
      VI2X=XSTATE(JSTATE+NXS)                                           DESVC     364
  430 IF(DDAT(JS+43).LE.0.0) GO TO 440                                  DESVC     365
      NXS=NXS+1                                                         DESVC     366
      TINV=DDAT(JS+43)                                                  DESVC     367
      DSTATE(NXS)=TINV*(VI2X-XSTATE(JSTATE+NXS))                        DESVC     368
      VI2X=DDAT(JS+42)*DSTATE(NXS)+XSTATE(JSTATE+NXS)                   DESVC     369
  440 VIN=VI1X+VI2X                                                     DESVC     370
      NXS=NXS+1                                                         DESVC     371
      TINV=DDAT(JS+37)                                                  DESVC     372
      GAIN=DDAT(JS+38)                                                  DESVC     373
      UMX=VIN-XSTATE(JSTATE+NXS)                                        DESVC     374
      DSTATE(NXS)=TINV*UMX                                              DESVC     375
      VSCS=GAIN*UMX                                                     DESVC     376
      VMAX=DDAT(JS+39)                                                  DESVC     377
      VMIN=-VMAX                                                        DESVC     378
      IF(VSCS.GT.VMAX) VSCS=VMAX                                        DESVC     379
      IF(VSCS.LT.VMIN) VSCS=VMIN                                        DESVC     380
  450 VIN=VL                                                            DESVC     381
      IF(DDAT(JS+1).LE.0.0) GO TO 460                                   DESVC     382
      NXS=NXS+1                                                         DESVC     383
      TINV=DDAT(JS+1)                                                   DESVC     384
      DSTATE(NXS)=TINV*(VIN-XSTATE(JSTATE+NXS))                         DESVC     385
      VIN=XSTATE(JSTATE+NXS)                                            DESVC     386
  460 VERR=VIN-RVREF(JY+1)                                              DESVC     387
      VSUM=VERR+VSCS                                                    DESVC     388
      VEMAX=DDAT(JS+2)                                                  DESVC     389
      VEMIN=DDAT(JS+23)                                                 DESVC     390
      VMAX=DDAT(JS+21)                                                  DESVC     391
      VMIN=DDAT(JS+22)                                                  DESVC     392
      NXS1=NXS                                                          DESVC     393
      IF(VMAX.LT.0.0.OR.VMAX.GT.0.0.OR.VMIN.LT.0.0.OR.VMIN.GT.0.0) THEN DESVC     394
         IF(DDAT(JS+4).LE.0.0) GO TO 469                                DESVC     395
         NXS=NXS+1                                                      DESVC     396
         TINV=DDAT(JS+4)                                                DESVC     397
         DSTATE(NXS)=TINV*(VSUM-XSTATE(JSTATE+NXS))                     DESVC     398
         VSUM=DDAT(JS+3)*DSTATE(NXS)+XSTATE(JSTATE+NXS)                 DESVC     399
         IF(VSUM.GE.VMAX) THEN                                          DESVC     400
            VSUM=VMAX                                                   DESVC     401
            IF(XSTATE(JSTATE+NXS).GE.VSUM) THEN                         DESVC     402
               IF(DSTATE(NXS).GT.0.0) THEN                              DESVC     403
                  DSTATE(NXS)=0.0                                       DESVC     404
                  QSTATE(JSTATE+NXS)=0.0                                DESVC     405
               ENDIF                                                    DESVC     406
            ELSE                                                        DESVC     407
               DSTATE(NXS)=(VSUM-XSTATE(JSTATE+NXS))/DDAT(JS+3)         DESVC     408
            ENDIF                                                       DESVC     409
         ELSEIF(VSUM.LE.VMIN) THEN                                      DESVC     410
            VSUM=VMIN                                                   DESVC     411
            IF(XSTATE(JSTATE+NXS).LE.VSUM) THEN                         DESVC     412
               IF(DSTATE(NXS).LT.0.0) THEN                              DESVC     413
                  DSTATE(NXS)=0.0                                       DESVC     414
                  QSTATE(JSTATE+NXS)=0.0                                DESVC     415
               ENDIF                                                    DESVC     416
            ELSE                                                        DESVC     417
               DSTATE(NXS)=(VSUM-XSTATE(JSTATE+NXS))/DDAT(JS+3)         DESVC     418
            ENDIF                                                       DESVC     419
         ENDIF                                                          DESVC     420
  469    IF(DDAT(JS+6).LE.0.0) GO TO 480                                DESVC     421
         NXS=NXS+1                                                      DESVC     422
         TINV=DDAT(JS+6)                                                DESVC     423
         DSTATE(NXS)=TINV*(VSUM-XSTATE(JSTATE+NXS))                     DESVC     424
         VSUM=DDAT(JS+5)*DSTATE(NXS)+XSTATE(JSTATE+NXS)                 DESVC     425
         IF(VSUM.GE.VEMAX) THEN                                         DESVC     426
            VSUM=VEMAX                                                  DESVC     427
            IF(XSTATE(JSTATE+NXS).GE.VSUM) THEN                         DESVC     428
               IF(DSTATE(NXS).GT.0.0) THEN                              DESVC     429
                  DSTATE(NXS)=0.0                                       DESVC     430
                  QSTATE(JSTATE+NXS)=0.0                                DESVC     431
               ENDIF                                                    DESVC     432
            ELSE                                                        DESVC     433
               DSTATE(NXS)=(VSUM-XSTATE(JSTATE+NXS))/DDAT(JS+5)         DESVC     434
            ENDIF                                                       DESVC     435
         ELSEIF(VSUM.LE.VEMIN) THEN                                     DESVC     436
            VSUM=VEMIN                                                  DESVC     437
            IF(XSTATE(JSTATE+NXS).LE.VSUM) THEN                         DESVC     438
               IF(DSTATE(NXS).LT.0.0) THEN                              DESVC     439
                  DSTATE(NXS)=0.0                                       DESVC     440
                  QSTATE(JSTATE+NXS)=0.0                                DESVC     441
               ENDIF                                                    DESVC     442
            ELSE                                                        DESVC     443
               DSTATE(NXS)=(VSUM-XSTATE(JSTATE+NXS))/DDAT(JS+5)         DESVC     444
            ENDIF                                                       DESVC     445
         ENDIF                                                          DESVC     446
      ELSE                                                              DESVC     447
         IF(VSUM.GT.VEMAX) VSUM=VEMAX                                   DESVC     448
         IF(VSUM.LT.VEMIN) VSUM=VEMIN                                   DESVC     449
         IF(DDAT(JS+4).LE.0.0) GO TO 470                                DESVC     450
         NXS=NXS+1                                                      DESVC     451
         TINV=DDAT(JS+4)                                                DESVC     452
         DSTATE(NXS)=TINV*(VSUM-XSTATE(JSTATE+NXS))                     DESVC     453
         VSUM=DDAT(JS+3)*DSTATE(NXS)+XSTATE(JSTATE+NXS)                 DESVC     454
  470    IF(DDAT(JS+6).LE.0.0) GO TO 480                                DESVC     455
         NXS=NXS+1                                                      DESVC     456
         TINV=DDAT(JS+6)                                                DESVC     457
         DSTATE(NXS)=TINV*(VSUM-XSTATE(JSTATE+NXS))                     DESVC     458
         VSUM=DDAT(JS+5)*DSTATE(NXS)+XSTATE(JSTATE+NXS)                 DESVC     459
      ENDIF                                                             DESVC     460
  480 SVCK=DDAT(JS+7)                                                   DESVC     461
      BRIN=VSUM*SVCK                                                    DESVC     462
      DVHI=DDAT(JS+15)/SVCK                                             DESVC     463
      DVLO=DDAT(JS+16)/SVCK                                             DESVC     464
      IF(IDDAT(JS+19).EQ.0.0) GO TO 490                                 DESVC     465
      DVHI=DDAT(JS+19)                                                  DESVC     466
      DVLO=-DVHI                                                        DESVC     467
  490 BPR=BRIN                                                          DESVC     468
      IF(VERR.LT.DVHI) GO TO 500                                        DESVC     469
      BPR=DDAT(JS+15)                                                   DESVC     470
      IF(BPR.LT.BRIN) BPR=BRIN                                          DESVC     471
      GO TO 510                                                         DESVC     472
  500 IF(VERR.GT.DVLO) GO TO 510                                        DESVC     473
      BPR=DDAT(JS+16)+DDAT(JS+13)*(DDAT(JS+19)+VERR)                    DESVC     474
      IF(BPR.GT.BRIN) BPR=BRIN                                          DESVC     475
  510 BMIN=-DDAT(JS+17)                                                 DESVC     476
      BMAX=1.0+BMIN                                                     DESVC     477
      IF(BPR.GT.BMAX) BPR=BMAX                                          DESVC     478
      IF(BPR.LT.BMIN) BPR=BMIN                                          DESVC     479
      IF(DDAT(JS+18).LE.0.0) GO TO 520                                  DESVC     480
      NXS=NXS+1                                                         DESVC     481
      TINV=DDAT(JS+18)                                                  DESVC     482
      DSTATE(NXS)=TINV*(BPR-XSTATE(JSTATE+NXS))                         DESVC     483
      BPR=XSTATE(JSTATE+NXS)                                            DESVC     484
      IF (BPR.GE.BMAX) THEN                                             DESVC     485
         BPR=BMAX                                                       DESVC     486
         IF (DSTATE(NXS).GT.0.0) THEN                                   DESVC     487
            DSTATE(NXS)=0.0                                             DESVC     488
            QSTATE(JSTATE+NXS)=0.0                                      DESVC     489
         END IF                                                         DESVC     490
      ELSE IF (BPR.LE.BMIN) THEN                                        DESVC     491
         BPR=BMIN                                                       DESVC     492
         IF (DSTATE(NXS).LT.0.0) THEN                                   DESVC     493
            DSTATE(NXS)=0.0                                             DESVC     494
            QSTATE(JSTATE+NXS)=0.0                                      DESVC     495
         END IF                                                         DESVC     496
      END IF                                                            DESVC     497
  520 CONTINUE                                                          DESVC     498
      IF(DDAT(JS+20).GT.-0.1) THEN                                      DESVC     499
         IF(-VERR.LT.DDAT(JS+25)) THEN                                  DESVC     500
            DDAT(JS+20)=TS                                              DESVC     501
         ELSE                                                           DESVC     502
            TDD=TS-DDAT(JS+20)                                          DESVC     503
            IF(TDD.GE.DDAT(JS+27)) THEN                                 DESVC     504
               DDAT(JS+20)=-1.0                                         DESVC     505
               DDAT(JS+24)=DDAT(JS+24)+DDAT(JS+26)                      DESVC     506
            ENDIF                                                       DESVC     507
         ENDIF                                                          DESVC     508
      ENDIF                                                             DESVC     509
      BSVC(JY+2)=(BPR-DDAT(JS+24))*BASER(JY+4)                          DESVC     510
      IF(NSUBD.EQ.1) THEN                                               DESVC     511
         CALL RKG(NXS,JSTATE,XSTATE,DSTATE,QSTATE,ZSTATE,H)             DESVC     512
         IF(LIR4) THEN                                                  DESVC     513
            IF(VMAX.LT.0.0.OR.VMAX.GT.0.0.OR.VMIN.LT.0.0.OR.VMIN.GT.0.0)DESVC     514
     &      THEN                                                        DESVC     515
               IF(DDAT(JS+4).LE.0.0) GO TO 521                          DESVC     516
               NXS1=NXS1+1                                              DESVC     517
               IF(XSTATE(JSTATE+NXS1).GT.VMAX) THEN                     DESVC     518
                  XSTATE(JSTATE+NXS1)=VMAX                              DESVC     519
                  GO TO 521                                             DESVC     520
               ENDIF                                                    DESVC     521
               IF(XSTATE(JSTATE+NXS1).LT.VMIN) THEN                     DESVC     522
                  XSTATE(JSTATE+NXS1)=VMIN                              DESVC     523
               ENDIF                                                    DESVC     524
  521          CONTINUE                                                 DESVC     525
               IF(DDAT(JS+6).LE.0.0) GO TO 522                          DESVC     526
               NXS1=NXS1+1                                              DESVC     527
               IF(XSTATE(JSTATE+NXS1).GT.VEMAX) THEN                    DESVC     528
                  XSTATE(JSTATE+NXS1)=VEMAX                             DESVC     529
                  GO TO 522                                             DESVC     530
               ENDIF                                                    DESVC     531
               IF(XSTATE(JSTATE+NXS1).LT.VEMIN) THEN                    DESVC     532
                  XSTATE(JSTATE+NXS1)=VEMIN                             DESVC     533
               ENDIF                                                    DESVC     534
  522          CONTINUE                                                 DESVC     535
            ENDIF                                                       DESVC     536
            IF(DDAT(JS+18).LE.0.0) GO TO 540                            DESVC     537
            IF(XSTATE(JSTATE+NXS).GT.BMAX) THEN                         DESVC     538
               XSTATE(JSTATE+NXS)=BMAX                                  DESVC     539
               BSVC(JY+2)=(BMAX-DDAT(JS+24))*BASER(JY+4)                DESVC     540
               GO TO 540                                                DESVC     541
            ENDIF                                                       DESVC     542
            IF(XSTATE(JSTATE+NXS).LT.BMIN) THEN                         DESVC     543
               XSTATE(JSTATE+NXS)=BMIN                                  DESVC     544
               BSVC(JY+2)=(BMIN-DDAT(JS+24))*BASER(JY+4)                DESVC     545
            ENDIF                                                       DESVC     546
         ENDIF                                                          DESVC     547
      ELSE                                                              DESVC     548
         CALL ICOEF1                                                    DESVC     549
         CALL RKG1(NXS,0,JSTATE,XSTATE,DSTATE,QSTATE,ZSTATE,HSUB)       DESVC     550
         IF(IR1.LT.4) GO TO 330                                         DESVC     551
         IF(VMAX.LT.0.0.OR.VMAX.GT.0.0.OR.VMIN.LT.0.0.OR.VMIN.GT.0.0)   DESVC     552
     &   THEN                                                           DESVC     553
            IF(DDAT(JS+4).LE.0.0) GO TO 523                             DESVC     554
            NXS1=NXS1+1                                                 DESVC     555
            IF(XSTATE(JSTATE+NXS1).GT.VMAX) THEN                        DESVC     556
               XSTATE(JSTATE+NXS1)=VMAX                                 DESVC     557
               GO TO 523                                                DESVC     558
            ENDIF                                                       DESVC     559
            IF(XSTATE(JSTATE+NXS1).LT.VMIN) THEN                        DESVC     560
               XSTATE(JSTATE+NXS1)=VMIN                                 DESVC     561
            ENDIF                                                       DESVC     562
  523       CONTINUE                                                    DESVC     563
            IF(DDAT(JS+6).LE.0.0) GO TO 524                             DESVC     564
            NXS1=NXS1+1                                                 DESVC     565
            IF(XSTATE(JSTATE+NXS1).GT.VEMAX) THEN                       DESVC     566
               XSTATE(JSTATE+NXS1)=VEMAX                                DESVC     567
               GO TO 524                                                DESVC     568
            ENDIF                                                       DESVC     569
            IF(XSTATE(JSTATE+NXS1).LT.VEMIN) THEN                       DESVC     570
               XSTATE(JSTATE+NXS1)=VEMIN                                DESVC     571
            ENDIF                                                       DESVC     572
  524       CONTINUE                                                    DESVC     573
         ENDIF                                                          DESVC     574
         IF(DDAT(JS+18).LE.0.0) GO TO 530                               DESVC     575
         IF(XSTATE(JSTATE+NXS).GT.BMAX) THEN                            DESVC     576
            XSTATE(JSTATE+NXS)=BMAX                                     DESVC     577
            BSVC(JY+2)=(BMAX-DDAT(JS+24))*BASER(JY+4)                   DESVC     578
            GO TO 530                                                   DESVC     579
         ENDIF                                                          DESVC     580
         IF(XSTATE(JSTATE+NXS).LT.BMIN) THEN                            DESVC     581
            XSTATE(JSTATE+NXS)=BMIN                                     DESVC     582
            BSVC(JY+2)=(BMIN-DDAT(JS+24))*BASER(JY+4)                   DESVC     583
         ENDIF                                                          DESVC     584
      ENDIF                                                             DESVC     585
  530 CONTINUE                                                          DESVC     586
  540 CONTINUE                                                          DESVC     587
      RETURN                                                            DESVC     588
C                                                                       DESVC     589
      END                                                               DESVC     590
