CFPRIME DEMOTL                                                          DEMOTL      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 DEMOTL(H)                                              DEMOTL      3
CD                                                                      DEMOTL      4
CD    TO CALCULATE THE DERIVATIVES OF THE STATES OF INDUCTION MOTOR FOR DEMOTL      5
CD    USE IN THE RUNGE-KUTTA METHOD.                                    DEMOTL      6
CD                                                                      DEMOTL      7
CD    UPDATE THE STATES FOR THE CURRENT TIME STEP BY THE RUNGE-KUTTA    DEMOTL      8
CD    FORMULA.                                                          DEMOTL      9
CD                                                                      DEMOTL     10
CD    THE DATA STRUCTURE OF INDUCTION MOTOR IS GIVEN BELOW.             DEMOTL     11
CD                                                                      DEMOTL     12
CD  JM=JMDAT(NMOTL)        :  POINTER FOR 'DDAT' (DATA)                 DEMOTL     13
CD  NLF=NMOTB(NMOTL)       :  BUS NUMBER (LOAD FLOW NUMBER)             DEMOTL     14
CD                           > 0  NORMAL MOTOR                          DEMOTL     15
CD                           < 0  MOTOR WITHIN ALOAD                    DEMOTL     16
CD   MLF=NMOLD(NMOTL)      :  BUS NUMBER (PROGRAM NUMBER)               DEMOTL     17
CD   MUID=NDMC(NMOTL)      :  UNIT I.D.                                 DEMOTL     18
CD   JSTATE=JXIMO(NMOTL)   :  POINTER FOR 'XSTATE' (STATE VECTOR)       DEMOTL     19
CD                                                                      DEMOTL     20
CD   MOTOR TYPE CONVENTION :                                            DEMOTL     21
CD   ---------------------                                              DEMOTL     22
CD                                                                      DEMOTL     23
CD   TYPE 1  -- SINGLE CAGE MODEL, WITH 3 STATES                        DEMOTL     24
CD   TYPE 2  -- DEEP BAR ROTOR MODEL, WITH 3 STATES                     DEMOTL     25
CD   TYPE 3  -- DOUBLE CAGE MODEL, WITH 3 STATES                        DEMOTL     26
CD   TYPE 6  -- SIMPLIFIED SINGLE CAGE MODEL, WITH 1 STATE              DEMOTL     27
CD   TYPE 7  -- SIMPLIFIED DEEP BAR ROTOR MODEL, WITH 1 STATE           DEMOTL     28
CD   TYPE 8  -- SIMPLIFIED DOUBLE CAGE MODEL, WITH 1 STATE              DEMOTL     29
CD   TYPE 11 -- SAME AS TYPE 1 WITHIN ALOAD                             DEMOTL     30
CD   TYPE 12 -- SAME AS TYPE 2 WITHIN ALOAD                             DEMOTL     31
CD   TYPE 13 -- SAME AS TYPE 3 WITHIN ALOAD                             DEMOTL     32
CD   TYPE 16 -- SAME AS TYPE 6 WITHIN ALOAD                             DEMOTL     33
CD   TYPE 17 -- SAME AS TYPE 7 WITHIN ALOAD                             DEMOTL     34
CD   TYPE 18 -- SAME AS TYPE 8 WITHIN ALOAD                             DEMOTL     35
CD                                                                      DEMOTL     36
CD   FOR MOTOR TYPES WITH 3 STATES (FULL MODELS), THE STATES ARE        DEMOTL     37
CD                                                                      DEMOTL     38
CD   REAL PART OF STATOR VOLTAGE VD                                     DEMOTL     39
CD   IMAGINARY PART OF STATOR VOLTAGE VQ                                DEMOTL     40
CD   SLIP S                                                             DEMOTL     41
CD                                                                      DEMOTL     42
CD   FOR SIMPLIFIED MOTOR MODELS, THE ONLY STATE IS SLIP S.             DEMOTL     43
CD                                                                      DEMOTL     44
CD   DDAT MAPPING :                                                     DEMOTL     45
CD   ------------                                                       DEMOTL     46
CD                                                                      DEMOTL     47
CD   INDUCTION MOTOR TYPE 1                                             DEMOTL     48
CD                                                                      DEMOTL     49
CD   IDDAT(JM+ 1)  =  NTYPE                                             DEMOTL     50
CD   IDDAT(JM+ 2)  =  IPFAX                                             DEMOTL     51
CD    DDAT(JM+ 3)  =  QFAX                                              DEMOTL     52
CD   IDDAT(JM+ 4)  =  ISATX                                             DEMOTL     53
CD   IDDAT(JM+ 5)  =  ILTYPE                                            DEMOTL     54
CD    DDAT(JM+ 6)  =  H                                                 DEMOTL     55
CD    DDAT(JM+ 7)  =  N                                                 DEMOTL     56
CD    DDAT(JM+ 8)  =  M                                                 DEMOTL     57
CD    DDAT(JM+ 9)  =  K1                                                DEMOTL     58
CD    DDAT(JM+10)  =  K2                                                DEMOTL     59
CD    DDAT(JM+11)  =  BASPR                                             DEMOTL     60
CD    DDAT(JM+12)  =  BASVR                                             DEMOTL     61
CD    DDAT(JM+13)  =  WXBASE,     in rad/s                              DEMOTL     62
CD    DDAT(JM+14)  =  V2                                                DEMOTL     63
CD    DDAT(JM+15)  =  I2                                                DEMOTL     64
CD    DDAT(JM+16)  =  XM                                                DEMOTL     65
CD    DDAT(JM+17)  =  XS                                                DEMOTL     66
CD    DDAT(JM+18)  =  RS                                                DEMOTL     67
CD    DDAT(JM+19)  =  XR                                                DEMOTL     68
CD    DDAT(JM+20)  =  RR                                                DEMOTL     69
CD    DDAT(JM+21)  =  XS1                                               DEMOTL     70
CD    DDAT(JM+22)  =  DR                                                DEMOTL     71
CD    DDAT(JM+23)  =  DS                                                DEMOTL     72
CD    DDAT(JM+24)  =  XSO                                               DEMOTL     73
CD    DDAT(JM+25)  =  XRO                                               DEMOTL     74
CD    DDAT(JM+26)  =  CSO                                               DEMOTL     75
CD    DDAT(JM+27)  =  CRO                                               DEMOTL     76
CD    DDAT(JM+28)  =  V1                                                DEMOTL     77
CD    DDAT(JM+29)  =  V2                                                DEMOTL     78
CD    DDAT(JM+30)  =  G1                                                DEMOTL     79
CD    DDAT(JM+31)  =  G2                                                DEMOTL     80
CD                                                                      DEMOTL     81
CD   INDUCTION MOTOR TYPE 2                                             DEMOTL     82
CD                                                                      DEMOTL     83
CD   Same DDAT data as TYPE 1, except                                   DEMOTL     84
CD                                                                      DEMOTL     85
CD   DDAT(JM+13)  =  DBF                                                DEMOTL     86
CD                                                                      DEMOTL     87
CD   INDUCTION MOTOR TYPE 3                                             DEMOTL     88
CD                                                                      DEMOTL     89
CD   Same DDAT data as TYPE 1, adding                                   DEMOTL     90
CD                                                                      DEMOTL     91
CD   DDAT(JM+26)  =  X2                                                 DEMOTL     92
CD   DDAT(JM+27)  =  R2                                                 DEMOTL     93
CD                                                                      DEMOTL     94
CD   INDUCTION MOTOR TYPES 6, 7, AND 8                                  DEMOTL     95
CD                                                                      DEMOTL     96
CD   Same DDAT data as TYPE 1, 2 and 3 respectively                     DEMOTL     97
CD                                                                      DEMOTL     98
CD   INDUCTION MOTOR TYPES 11, 12, 13, 16, 17, AND 18                   DEMOTL     99
CD                                                                      DEMOTL    100
CD   Same DDAT data as TYPE 1, 2, 3, 6, 7 and 8 respectively, adding    DEMOTL    101
CD                                                                      DEMOTL    102
CD   IDDAT(JM+28)  =  1 for large motor in ALOAD                        DEMOTL    103
CD                    2 for small motor in ALOAD                        DEMOTL    104
CD    DDAT(JM+29)  =  VREAL of the low tension bus at the ALOAD         DEMOTL    105
CD    DDAT(JM+30)  =  VIMAG of the low tension bus at the ALOAD         DEMOTL    106
CD                                                                      DEMOTL    107
      INCLUDE 'PARX.INS'                                                DEMOTL    108
      INCLUDE 'CNPT.INS'                                                DEMOTL    109
      INCLUDE 'CNB4.INS'                                                DEMOTL    110
      INCLUDE 'CNB9.INS'                                                DEMOTL    111
      INCLUDE 'CNB19.INS'                                               DEMOTL    112
      INCLUDE 'CNMPAR.INS'                                              DEMOTL    113
      INCLUDE 'CNPARX.INS'                                              DEMOTL    114
      INCLUDE 'CNIPTR.INS'                                              DEMOTL    115
      INCLUDE 'CNXSTA.INS'                                              DEMOTL    116
      INCLUDE 'CNQSTA.INS'                                              DEMOTL    117
      INCLUDE 'CNZSTA.INS'                                              DEMOTL    118
      INCLUDE 'CNMDAT.INS'                                              DEMOTL    119
      INCLUDE 'CNVOLT.INS'                                              DEMOTL    120
      INCLUDE 'CNMYVA.INS'                                              DEMOTL    121
      INCLUDE 'CNYVAR.INS'                                              DEMOTL    122
      INCLUDE 'CNFLAG.INS'                                              DEMOTL    123
C                                                                       DEMOTL    124
C      INTEGER*2 NMTNLD                                                 DEMOTL    125
C      COMPLEX VOLBAR                                                   DEMOTL    126
C      COMMON/MOTVOL/VOLBAR(NZL),NMTNLD(2*NZL)                          DEMOTL    127
C                                                                       DEMOTL    128
      LOGICAL LIMFLT                                                    DEMOTL    129
      COMMON /MOTVF/ VOLDRE(NMT), VOLDIM(NMT), BUSFRQ(NMT), TSPREV,     DEMOTL    130
     &               GSMOLD, BSMOLD, LIMFLT                             DEMOTL    131
C                                                                       DEMOTL    132
      COMPLEX VOLMOT                                                    DEMOTL    133
C                                                                       DEMOTL    134
      IF (NMOTL.EQ.0) RETURN                                            DEMOTL    135
      LDEB = (JDEB(400).NE.0)                                           DEMOTL    136
C                                                                       DEMOTL    137
      XS=0.0                                                            DEMOTL    138
C                                                                       DEMOTL    139
      DO 120 K=1,NMOTL                                                  DEMOTL    140
      I=NMOLD(K)                                                        DEMOTL    141
      IF (NTHM(2,I).EQ.0) GO TO 120                                     DEMOTL    142
      JM=JMDAT(K)                                                       DEMOTL    143
      IF (DDAT(JM+15).LT.0.0) GOTO 120                                  DEMOTL    144
      JSTATE=JXIMO(K)                                                   DEMOTL    145
      JY=JVIMO(K)                                                       DEMOTL    146
      IF (IDDAT(JM+1) .LT. 0) GOTO 120                                  DEMOTL    147
      MOTYPK=IDDAT(JM+1)                                                DEMOTL    148
      IF (DDAT(JM+35) .EQ. -1.0) THEN                                   DEMOTL    149
         ZEXT=1.0E5                                                     DEMOTL    150
      ELSE                                                              DEMOTL    151
         ZEXT=0.0                                                       DEMOTL    152
      ENDIF                                                             DEMOTL    153
C                                                                       DEMOTL    154
      IF (MOTYPK.LT.10) THEN                                            DEMOTL    155
         VOLMOT=VOLT(I)                                                 DEMOTL    156
      ELSE                                                              DEMOTL    157
         VOLMOT=CMPLX(DDAT(JM+36),DDAT(JM+37))                          DEMOTL    158
         MOTYPK=MOTYPK-10                                               DEMOTL    159
      END IF                                                            DEMOTL    160
      XSO=DDAT(JM+24)                                                   DEMOTL    161
      XRO=DDAT(JM+25)                                                   DEMOTL    162
      XMMK=DDAT(JM+16)/DXM(JY+1)                                        DEMOTL    163
      IF (MOTYPK.LE.3) THEN                                             DEMOTL    164
         V1D=XSTATE(JSTATE+1)                                           DEMOTL    165
         V1Q=XSTATE(JSTATE+2)                                           DEMOTL    166
         SLIP=XSTATE(JSTATE+3)                                          DEMOTL    167
         SA=ABS(SLIP)                                                   DEMOTL    168
      ELSE                                                              DEMOTL    169
         V1D=VC1D(JY+10)                                                DEMOTL    170
         V1Q=VC1Q(JY+11)                                                DEMOTL    171
         SLIP=XSTATE(JSTATE+1)                                          DEMOTL    172
         SA=ABS(SLIP)                                                   DEMOTL    173
      END IF                                                            DEMOTL    174
      IF (IR.EQ.1) THEN                                                 DEMOTL    175
        IF (H.EQ.0.0) THEN                                              DEMOTL    176
          IF (BUSFRQ(K).EQ.0.0) BUSFRQ(K) = WOBASE                      DEMOTL    177
        ELSE                                                            DEMOTL    178
          IF (TS.NE.0.0 .AND. TS.NE.TSPREV) THEN                        DEMOTL    179
            VNEWRE = REAL(VOLMOT)                                       DEMOTL    180
            VNEWIM = AIMAG(VOLMOT)                                      DEMOTL    181
            BUSFRQ(K) = WOBASE + (VNEWIM*VOLDRE(K)-VNEWRE*VOLDIM(K)) /  DEMOTL    182
     &                ((VNEWRE * VNEWRE + VNEWIM * VNEWIM) * H)         DEMOTL    183
          ENDIF                                                         DEMOTL    184
        ENDIF                                                           DEMOTL    185
        TSPREV = TS                                                     DEMOTL    186
      IF (LDEB .AND. IR.EQ.1) WRITE(IUD6,1000) IR,BUSFRQ(K),TS,H,SLIP,  DEMOTL    187
     &    SS,LDISC, VOLMOT, V1D, V1Q                                    DEMOTL    188
      ENDIF                                                             DEMOTL    189
      IF (MOTYPK .LE. 3) THEN                                           DEMOTL    190
         IF (ZEXT .GT. 0.0) THEN                                        DEMOTL    191
           SS=SLIP                                                      DEMOTL    192
         ELSE                                                           DEMOTL    193
           SS=(1.0-DDAT(JM+13)/BUSFRQ(K)*(1.0-SLIP))                    DEMOTL    194
         ENDIF                                                          DEMOTL    195
      ENDIF                                                             DEMOTL    196
      IF (MOTYPK.EQ.2.OR.MOTYPK.EQ.7) THEN                              DEMOTL    197
         IF (SA.LT.1.E-04) THEN                                         DEMOTL    198
            XR=DDAT(JM+20)*DDAT(JM+19)*DDAT(JM+19)/6.                   DEMOTL    199
            RR=DDAT(JM+20)                                              DEMOTL    200
         ELSE                                                           DEMOTL    201
            B2=DDAT(JM+18)*SQRT(SA)                                     DEMOTL    202
            DEM=COSH(B2)-COS(B2)                                        DEMOTL    203
C            XR=DDAT(JM+20)*B2*.5/SA*(SINH(B2)-SIN(B2))/DEM             DEMOTL    204
            XR=DDAT(JM+20)*B2*.5/ABS(SS)*(SINH(B2)-SIN(B2))/DEM         DEMOTL    205
            RR=DDAT(JM+20)*B2*.5*(SINH(B2)+SIN(B2))/DEM                 DEMOTL    206
         END IF                                                         DEMOTL    207
C         XB=XMMK+XRO+XR*DDAT(JM+22)                                    DEMOTL    208
         XB=XMMK+2.0*XRO+XR*DDAT(JM+22)                                 DEMOTL    209
      ELSE IF (MOTYPK.EQ.3.OR.MOTYPK.EQ.8) THEN                         DEMOTL    210
         RRO=DDAT(JM+20)*DDAT(JM+33)/(DDAT(JM+20)+DDAT(JM+33))          DEMOTL    211
         QM=(DDAT(JM+20)+DDAT(JM+33))/DDAT(JM+32)                       DEMOTL    212
C         RX=QM*RRO/(QM*QM+SA*SA)                                       DEMOTL    213
         RX=QM*RRO/(QM*QM+SS*SS)                                        DEMOTL    214
         XR=DDAT(JM+20)/DDAT(JM+33)*RX                                  DEMOTL    215
C         RR=RX*(QM+SA*SA*DDAT(JM+20)/RRO)                              DEMOTL    216
         RR=RX*(QM+SS*SS*DDAT(JM+20)/RRO)                               DEMOTL    217
         XB=XMMK+XRO+DDAT(JM+19)*DDAT(JM+22)+XR                         DEMOTL    218
      ELSE                                                              DEMOTL    219
         XR=DDAT(JM+19)                                                 DEMOTL    220
         RR=DDAT(JM+20)                                                 DEMOTL    221
         XB=XMMK+XRO+XR*DDAT(JM+22)                                     DEMOTL    222
      END IF                                                            DEMOTL    223
C                                                                       DEMOTL    224
C     SATURATION                                                        DEMOTL    225
C                                                                       DEMOTL    226
      IF (IDDAT(JM+4).EQ.0) THEN                                        DEMOTL    227
         IF (MOTYPK.EQ.2.OR.MOTYPK.EQ.7) THEN                           DEMOTL    228
           XR=XR+2*XRO                                                  DEMOTL    229
         ELSE                                                           DEMOTL    230
           XR=XR+XRO                                                    DEMOTL    231
         ENDIF                                                          DEMOTL    232
         XS=XSO+DDAT(JM+17)+ZEXT                                        DEMOTL    233
C                                                                       DEMOTL    234
C/* NEED TO BE VERIFIED                                                 DEMOTL    235
         IF (LIMFLT) THEN                                               DEMOTL    236
           IF (MOTYPK.LE.3) THEN                                        DEMOTL    237
             IF (DDAT(JM+35) .EQ. -1.0) THEN                            DEMOTL    238
               GSMOLD = GSM(JY+4)                                       DEMOTL    239
               BSMOLD = BSM(JY+5)                                       DEMOTL    240
               GSM(JY+4)=1.0/ZEXT                                       DEMOTL    241
               BSM(JY+5)=1.0/ZEXT                                       DEMOTL    242
             ELSEIF (DDAT(JM+35) .EQ. 0.0) THEN                         DEMOTL    243
               GSM(JY+4) = GSMOLD                                       DEMOTL    244
               BSM(JY+5) = BSMOLD                                       DEMOTL    245
             ENDIF                                                      DEMOTL    246
           ENDIF                                                        DEMOTL    247
           LIMFLT=.FALSE.                                               DEMOTL    248
         ENDIF                                                          DEMOTL    249
C*/                                                                     DEMOTL    250
      ELSE                                                              DEMOTL    251
         IF (SA.LT.1.E-04) GO TO 110                                    DEMOTL    252
         CROMK=DDAT(JM+27)                                              DEMOTL    253
         CSOMK=DDAT(JM+26)                                              DEMOTL    254
         XS1=DDAT(JM+21)                                                DEMOTL    255
         RS=DDAT(JM+18)                                                 DEMOTL    256
         CRD=V1Q/XMMK-XMMK/XB*CDM(JY+8)                                 DEMOTL    257
         CRQ=-V1D/XMMK-XMMK/XB*CQM(JY+9)                                DEMOTL    258
         CR=SQRT(CRD*CRD+CRQ*CRQ)                                       DEMOTL    259
         CS=SQRT(CDM(JY+8)*CDM(JY+8)+CQM(JY+9)*CQM(JY+9))               DEMOTL    260
         D=1.0                                                          DEMOTL    261
         IF (CR.LE.CROMK) GO TO 70                                      DEMOTL    262
         RATIO=CROMK/CR                                                 DEMOTL    263
         FACT=SQRT(1.0-RATIO*RATIO)                                     DEMOTL    264
         ANGX=ATAN(RATIO/FACT)                                          DEMOTL    265
         D=(ANGX+RATIO*FACT)*PI                                         DEMOTL    266
70       CONTINUE                                                       DEMOTL    267
         IF (MOTYPK.EQ.2.OR.MOTYPK.EQ.7) THEN                           DEMOTL    268
            XR=XRO+XRO*D+XR                                             DEMOTL    269
         ELSEIF (MOTYPK.EQ.3.OR.MOTYPK.EQ.8) THEN                       DEMOTL    270
            XR=XRO+XR+DDAT(JM+19)*D                                     DEMOTL    271
         ELSE                                                           DEMOTL    272
            XR=XRO+XR*D                                                 DEMOTL    273
         END IF                                                         DEMOTL    274
         DDAT(JM+22)=D                                                  DEMOTL    275
         D=1.0                                                          DEMOTL    276
         IF (CS.LE.CSOMK) GO TO 100                                     DEMOTL    277
         RATIO=CSOMK/CS                                                 DEMOTL    278
         FACT=SQRT(1.0-RATIO*RATIO)                                     DEMOTL    279
         ANGX=ATAN(RATIO/FACT)                                          DEMOTL    280
         D=(ANGX+RATIO*FACT)*PI                                         DEMOTL    281
100      CONTINUE                                                       DEMOTL    282
         XS=XSO+DDAT(JM+17)*D+ZEXT                                      DEMOTL    283
         DDAT(JM+23)=D                                                  DEMOTL    284
         VMR=REAL(VOLMOT)-(ZEXT+RS)*CDM(JY+8)+XS*CQM(JY+9)              DEMOTL    285
         VMI=AIMAG(VOLMOT)-(ZEXT+RS)*CQM(JY+9)-XS*CDM(JY+8)             DEMOTL    286
         VM=SQRT(VMR*VMR+VMI*VMI)                                       DEMOTL    287
         V1=DDAT(JM+28)                                                 DEMOTL    288
         V2=DDAT(JM+29)                                                 DEMOTL    289
         G1=DDAT(JM+30)                                                 DEMOTL    290
         G2=DDAT(JM+31)                                                 DEMOTL    291
         CALL SATFU (VM,V1,V2,G1,G2,D)                                  DEMOTL    292
         DXM(JY+1)=D                                                    DEMOTL    293
         XMMK=DDAT(JM+16)/D                                             DEMOTL    294
         XA=XMMK+XR                                                     DEMOTL    295
         XS1K=XS+XMMK*XR/XA                                             DEMOTL    296
         DDAT(JM+21)=XS1K                                               DEMOTL    297
C                                                                       DEMOTL    298
C     CALCULATE BSM & GSM                                               DEMOTL    299
C                                                                       DEMOTL    300
         IF (MOTYPK.LE.3) THEN                                          DEMOTL    301
            RSK=DDAT(JM+18)+ZEXT                                        DEMOTL    302
            YS1=1.0/(RSK**2+XS1K**2)                                    DEMOTL    303
            RSK=RSK*YS1                                                 DEMOTL    304
            XS1K=XS1K*YS1                                               DEMOTL    305
            GSM(JY+4)=RSK                                               DEMOTL    306
            BSM(JY+5)=XS1K                                              DEMOTL    307
         END IF                                                         DEMOTL    308
      END IF                                                            DEMOTL    309
110   CONTINUE                                                          DEMOTL    310
C                                                                       DEMOTL    311
      WXBASE=DDAT(JM+13)                                                DEMOTL    312
      AR=RR*WXBASE/(XMMK+XR)                                            DEMOTL    313
      XSD=XMMK+XS-DDAT(JM+21)                                           DEMOTL    314
      SA1=1.0-SLIP                                                      DEMOTL    315
C                                                                       DEMOTL    316
      ILTYPE=IDDAT(JM+5)                                                DEMOTL    317
      IF (ILTYPE.EQ.1) THEN                                             DEMOTL    318
         IF (SA.LT.1.0) THEN                                            DEMOTL    319
            EXPN=DDAT(JM+7)                                             DEMOTL    320
            EXPM=DDAT(JM+8)                                             DEMOTL    321
            COFK1=DDAT(JM+9)                                            DEMOTL    322
            COFK2=DDAT(JM+10)                                           DEMOTL    323
            TLOAD=COFK1*SA1**EXPN+COFK2*SA**EXPM                        DEMOTL    324
         ELSE                                                           DEMOTL    325
            TLOAD=0.0                                                   DEMOTL    326
         END IF                                                         DEMOTL    327
      ELSE IF (ILTYPE.EQ.2) THEN                                        DEMOTL    328
         IF (SA.LT.1.0) THEN                                            DEMOTL    329
            ALL=DDAT(JM+7)                                              DEMOTL    330
            BLL=DDAT(JM+8)                                              DEMOTL    331
            CLL=DDAT(JM+9)                                              DEMOTL    332
            TLOAD=ALL*SA1**2+BLL*SA1+CLL                                DEMOTL    333
         ELSE                                                           DEMOTL    334
            TLOAD=0.0                                                   DEMOTL    335
         END IF                                                         DEMOTL    336
      ELSE IF (ILTYPE.EQ.3)THEN                                         DEMOTL    337
         TLOAD=TLM(JY+2)                                                DEMOTL    338
      ELSE IF (ILTYPE.GT.3)THEN                                         DEMOTL    339
C                                                                       DEMOTL    340
         IF (SA.LT.1.0) THEN                                            DEMOTL    341
            NR=IDDAT(JM+36)                                             DEMOTL    342
            ITQN=IDDAT(JM+37)                                           DEMOTL    343
            ISPD=IDDAT(JM+38)                                           DEMOTL    344
            DDAT(NR+ISPD)=1.0-SA                                        DEMOTL    345
            TLOAD=DDAT(NR+ITQN)*DDAT(JM+11)/BASPC                       DEMOTL    346
         ELSE                                                           DEMOTL    347
            TLOAD=0.0                                                   DEMOTL    348
         ENDIF                                                          DEMOTL    349
      END IF                                                            DEMOTL    350
C                                                                       DEMOTL    351
      IF (MOTYPK.LE.3) THEN                                             DEMOTL    352
C                                                                       DEMOTL    353
         SW=WXBASE*SLIP                                                 DEMOTL    354
         DSTATE(1)=-AR*(XSD*CQM(JY+9)+V1D)+SW*V1Q                       DEMOTL    355
         DSTATE(2)=AR*(XSD*CDM(JY+8)-V1Q)-SW*V1D                        DEMOTL    356
         DSTATE(3)=-DDAT(JM+6)*(V1Q*CQM(JY+9)+                          DEMOTL    357
     1             V1D*CDM(JY+8)-TLOAD)                                 DEMOTL    358
         CALL RKG(3,JSTATE,XSTATE,DSTATE,QSTATE,ZSTATE,H)               DEMOTL    359
C                                                                       DEMOTL    360
      ELSE                                                              DEMOTL    361
C                                                                       DEMOTL    362
         TRSW=WXBASE*SLIP/AR                                            DEMOTL    363
         Z12=XSD/(TRSW*TRSW+1.0)                                        DEMOTL    364
         Z11=Z12*TRSW                                                   DEMOTL    365
         V1D=Z11*CDM(JY+8)-Z12*CQM(JY+9)                                DEMOTL    366
         V1Q=Z12*CDM(JY+8)+Z11*CQM(JY+9)                                DEMOTL    367
         VC1D(JY+10)=V1D                                                DEMOTL    368
         VC1Q(JY+11)=V1Q                                                DEMOTL    369
         RSK=DDAT(JM+18)+ZEXT                                           DEMOTL    370
         IF (ABS(RSK) .GT. 1.0E4) THEN                                  DEMOTL    371
            XS1K=DDAT(JM+21)+ZEXT                                       DEMOTL    372
         ELSE                                                           DEMOTL    373
            XS1K=DDAT(JM+21)                                            DEMOTL    374
         ENDIF                                                          DEMOTL    375
         Z11=RSK+Z11                                                    DEMOTL    376
         Z12=XS1K+Z12                                                   DEMOTL    377
         YS1=1.0/(Z11**2+Z12**2)                                        DEMOTL    378
         Z11=Z11*YS1                                                    DEMOTL    379
         Z12=Z12*YS1                                                    DEMOTL    380
         GSM(JY+4)=Z11                                                  DEMOTL    381
         BSM(JY+5)=Z12                                                  DEMOTL    382
C                                                                       DEMOTL    383
         DSTATE(1)=-DDAT(JM+6)*(V1Q*CQM(JY+9)+V1D*CDM(JY+8)-TLOAD)      DEMOTL    384
         CALL RKG(1,JSTATE,XSTATE,DSTATE,QSTATE,ZSTATE,H)               DEMOTL    385
C                                                                       DEMOTL    386
      END IF                                                            DEMOTL    387
C                                                                       DEMOTL    388
120   CONTINUE                                                          DEMOTL    389
C                                                                       DEMOTL    390
 1000 FORMAT(4X,I1,5(1X,F9.5),3X,I2,6(1X,F9.5))                         DEMOTL    391
C                                                                       DEMOTL    392
      RETURN                                                            DEMOTL    393
      END                                                               DEMOTL    394
