CFPRIME SVCLN                                                           SVCLN       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 SVCLN(IPATH,KSELF,NSEN,EPD,EPQ,IDMSN)                  SVCLN       3
CD                                                                      SVCLN       4
CD     TO FORMULATE THE JACOBIAN MATRICES A, B AND C FOR SVC FOR USE    SVCLN       5
CD     IN THE TRAPEZOIDAL INTEGRATION METHOD.                           SVCLN       6
CD                                                                      SVCLN       7
CD     IPATH   = 1  FORM NORMAL JACOBIAN MATRICES FOR USE IN TRAPEZOIDALSVCLN       8
CD                  INTEGRATION METHOD                                  SVCLN       9
CD             = 2  FORM MACHINE JACOBIAN MATRICES FOR USE IN CALCULATIOSVCLN      10
CD                  OF SECOND ORDER DERIVATIVES                         SVCLN      11
CD                                                                      SVCLN      12
CD     CEFJM   =    CONSTANT IN RESIDUE EQUATION                        SVCLN      13
CD                                                                      SVCLN      14
CD     IDMSN   =    DYNAMIC DIMENSION OF THE SVC                        SVCLN      15
CD                                                                      SVCLN      16
      INCLUDE 'PARX.INS'                                                SVCLN      17
      INCLUDE 'CNB4.INS'                                                SVCLN      18
      INCLUDE 'CNB8.INS'                                                SVCLN      19
      INCLUDE 'CNB9.INS'                                                SVCLN      20
      INCLUDE 'CNB19.INS'                                               SVCLN      21
      INCLUDE 'CNEXC.INS'                                               SVCLN      22
      INCLUDE 'CNSVS.INS'                                               SVCLN      23
      INCLUDE 'CNUDM.INS'                                               SVCLN      24
      INCLUDE 'CNUDMA.INS'                                              SVCLN      25
      INCLUDE 'CNUDMB.INS'                                              SVCLN      26
      INCLUDE 'CNUDMK.INS'                                              SVCLN      27
      INCLUDE 'CNGDAT.INS'                                              SVCLN      28
      INCLUDE 'CNPRGV.INS'                                              SVCLN      29
      INCLUDE 'CNSTAB.INS'                                              SVCLN      30
      INCLUDE 'CNYVAR.INS'                                              SVCLN      31
      INCLUDE 'CNMDAT.INS'                                              SVCLN      32
      INCLUDE 'CNMSTA.INS'                                              SVCLN      33
      INCLUDE 'CNFLAG.INS'                                              SVCLN      34
      INCLUDE 'CNPARX.INS'                                              SVCLN      35
      INCLUDE 'CNUNIT.INS'                                              SVCLN      36
      INCLUDE 'CNJCOB.INS'                                              SVCLN      37
      INCLUDE 'CNXSTA.INS'                                              SVCLN      38
      INCLUDE 'CNIMPR.INS'                                              SVCLN      39
      INCLUDE 'CNABAK.INS'                                              SVCLN      40
C                                                                       SVCLN      41
      CHARACTER*80 MSG                                                  SVCLN      42
      DIMENSION CDEV(2),YSEL(2,2)                                       SVCLN      43
C                                                                       SVCLN      44
      LDEB=.FALSE.                                                      SVCLN      45
      ICOLBV=0                                                          SVCLN      46
      IROWAK=2                                                          SVCLN      47
C                                                                       SVCLN      48
      DO 100 I=1,IDMSN                                                  SVCLN      49
         DO 110 J=1,IDMSN                                               SVCLN      50
            A(I,J)=0.0                                                  SVCLN      51
  110    CONTINUE                                                       SVCLN      52
         DO 115 J=1,20                                                  SVCLN      53
            B(I,J)=0.0                                                  SVCLN      54
            B(I,J)=0.0                                                  SVCLN      55
  115    CONTINUE                                                       SVCLN      56
         AK(1,I)=0.0                                                    SVCLN      57
         AK(2,I)=0.0                                                    SVCLN      58
  100 CONTINUE                                                          SVCLN      59
C                                                                       SVCLN      60
      YD(1,1)=0.0                                                       SVCLN      61
      YD(1,2)=0.0                                                       SVCLN      62
      YD(2,1)=0.0                                                       SVCLN      63
      YD(2,2)=0.0                                                       SVCLN      64
C                                                                       SVCLN      65
      IF (NRTYPN.EQ.50) GOTO 1100                                       SVCLN      66
C                                                                       SVCLN      67
C               SVC TYPE                                                SVCLN      68
C                                                                       SVCLN      69
C             1    2    3                                               SVCLN      70
      GOTO (1010,1020,1030), NRTYPN                                     SVCLN      71
C                                                                       SVCLN      72
C     TYPE 1                                                            SVCLN      73
C                                                                       SVCLN      74
 1010 CALL ASVC1(KSELF,NSEN,EPD,EPQ)                                    SVCLN      75
      GOTO 1500                                                         SVCLN      76
C                                                                       SVCLN      77
C     TYPE 2                                                            SVCLN      78
C                                                                       SVCLN      79
 1020 CALL ASVC2(EPD,EPQ)                                               SVCLN      80
      GOTO 1500                                                         SVCLN      81
C                                                                       SVCLN      82
C     TYPE 3                                                            SVCLN      83
C                                                                       SVCLN      84
 1030 CALL ASVC3(IDMSN,KSELF,EPD,EPQ)                                   SVCLN      85
      GOTO 1500                                                         SVCLN      86
C                                                                       SVCLN      87
 1100 CONTINUE                                                          SVCLN      88
C                                                                       SVCLN      89
C     TYPE 50 SVC -- USER DEFINED MODEL                                 SVCLN      90
C                                                                       SVCLN      91
      JEU=JE7-JE1+2                                                     SVCLN      92
      DO 1110 I=1,JEU                                                   SVCLN      93
         UDAT(I)=DDAT(I+JE1-1)                                          SVCLN      94
 1110 CONTINUE                                                          SVCLN      95
C                                                                       SVCLN      96
      IWS1=JS+12                                                        SVCLN      97
      JE1=JE1-IWS1                                                      SVCLN      98
      JE2=JE2-IWS1                                                      SVCLN      99
      JE3=JE3-IWS1                                                      SVCLN     100
      JE4=JE4-IWS1                                                      SVCLN     101
      JE5=JE5-IWS1                                                      SVCLN     102
      JE6=JE6-IWS1                                                      SVCLN     103
      JE7=JE7-IWS1                                                      SVCLN     104
C                                                                       SVCLN     105
C      JE1=1                                                            SVCLN     106
C      KINPU=0                                                          SVCLN     107
C      NUF=5                                                            SVCLN     108
C      CALL UDMINT(NUF,VMG,0.0,0.0,0.0)                                 SVCLN     109
C      IF (KERUDM.NE.0) GOTO 1300                                       SVCLN     110
C                                                                       SVCLN     111
C     FORM: DEL I=CDEV*DEL BSVC+YDEV*DEL V                              SVCLN     112
C                                                                       SVCLN     113
      BSVCNO=BSVCO(JY+3)                                                SVCLN     114
      YSEL(1,1)=0.0                                                     SVCLN     115
      YSEL(1,2)=BSVCNO                                                  SVCLN     116
      YSEL(2,1)=-BSVCNO                                                 SVCLN     117
      YSEL(2,2)=0.0                                                     SVCLN     118
      BSVCN=BSVC(JY+2)                                                  SVCLN     119
      BASERT=BASER(JY+4)                                                SVCLN     120
      IF(BASERT.GT.0.0) THEN                                            SVCLN     121
         CDEV(1)=VIM                                                    SVCLN     122
         CDEV(2)=-VRE                                                   SVCLN     123
         YDEVS(1,1)=0.0                                                 SVCLN     124
         YDEVS(1,2)=BSVCN                                               SVCLN     125
         YDEVS(2,1)=-BSVCN                                              SVCLN     126
         YDEVS(2,2)=0.0                                                 SVCLN     127
      ELSE                                                              SVCLN     128
         CDEV(1)=VIM/VMG                                                SVCLN     129
         CDEV(2)=-VRE/VMG                                               SVCLN     130
         YDEVS(1,1)=-BSVCN*VIM*VRE/VMG/VMG/VMG                          SVCLN     131
         YDEVS(1,2)=BSVCN*VRE*VRE/VMG/VMG/VMG                           SVCLN     132
         YDEVS(2,1)=-BSVCN*VIM*VIM/VMG/VMG/VMG                          SVCLN     133
         YDEVS(2,2)=BSVCN*VIM*VRE/VMG/VMG/VMG                           SVCLN     134
      ENDIF                                                             SVCLN     135
C                                                                       SVCLN     136
C     FORM: DEL U0=XUI*DEL I+XUV*DEL V+XUY*DEL YB+XUREF*DEL VREF        SVCLN     137
C                                                                       SVCLN     138
      DO 50 I=1,20                                                      SVCLN     139
      DO 40 J=1,NXUDB                                                   SVCLN     140
      XUY(I,J)=0.0                                                      SVCLN     141
  40  CONTINUE                                                          SVCLN     142
      DO 50 J=1,LOUTP                                                   SVCLN     143
      XUI(I,J)=0.0                                                      SVCLN     144
      XUV(I,J)=0.0                                                      SVCLN     145
  50  CONTINUE                                                          SVCLN     146
C      CALL FMOVE(0,XUI,XUI,20*LOUTP)                                   SVCLN     147
C      CALL FMOVE(0,XUV,XUV,20*LOUTP)                                   SVCLN     148
C      CALL FMOVE(0,XUY,XUY,20*NXUDB)                                   SVCLN     149
C                                                                       SVCLN     150
      IBEND=IUDAT(JE7+1)                                                SVCLN     151
      IF(BASERT.GT.0.0) THEN                                            SVCLN     152
         FACT1=VALIN(5)/VMG                                             SVCLN     153
         FACT2=VALIN(6)/VMG                                             SVCLN     154
         XUV(1,1)=FACT1*VRE                                             SVCLN     155
         XUV(1,2)=FACT1*VIM                                             SVCLN     156
         XUV(2,1)=FACT2*VRE                                             SVCLN     157
         XUV(2,2)=FACT2*VIM                                             SVCLN     158
         XUV(3,1)=2.0*FACT1*VRE*VMG                                     SVCLN     159
         XUV(3,2)=2.0*FACT1*VIM*VMG                                     SVCLN     160
         XUV(4,1)=2.0*FACT2*VRE*VMG                                     SVCLN     161
         XUV(4,2)=2.0*FACT2*VIM*VMG                                     SVCLN     162
         XUY(1,IBEND)=VMG                                               SVCLN     163
         XUY(2,IBEND)=VMG                                               SVCLN     164
         XUY(3,IBEND)=VMG**2                                            SVCLN     165
         XUY(4,IBEND)=VMG**2                                            SVCLN     166
         XUY(5,IBEND)=1.0                                               SVCLN     167
         XUY(6,IBEND)=1.0                                               SVCLN     168
      ELSE                                                              SVCLN     169
         FACT1=VALIN(1)/VMG                                             SVCLN     170
         XUV(3,1)=FACT1*VRE                                             SVCLN     171
         XUV(3,2)=FACT1*VIM                                             SVCLN     172
         XUV(5,1)=-XUV(3,1)/VMG/VMG                                     SVCLN     173
         XUV(5,2)=-XUV(3,2)/VMG/VMG                                     SVCLN     174
         XUY(1,IBEND)=1.0                                               SVCLN     175
         XUY(3,IBEND)=VMG                                               SVCLN     176
         XUY(5,IBEND)=1.0/VMG                                           SVCLN     177
      ENDIF                                                             SVCLN     178
C                                                                       SVCLN     179
      XUV(7,1)=VRE/VMG                                                  SVCLN     180
      XUV(7,2)=VIM/VMG                                                  SVCLN     181
      XUV(9,1)=-VIM/VMG/VMG                                             SVCLN     182
      XUV(9,2)=VRE/VMG/VMG                                              SVCLN     183
C                                                                       SVCLN     184
C     FORM THE REMOTE BUS ARRAY AND CONTROL A B C D MATRICES            SVCLN     185
C                                                                       SVCLN     186
      LCYO=1                                                            SVCLN     187
      LWIF=0                                                            SVCLN     188
      NBUSS=1                                                           SVCLN     189
      NBUSR=0                                                           SVCLN     190
      BASERT=ABS(BASERT)                                                SVCLN     191
      CALL AUDMB(LCYO,LWIF,NBUSR,NBUSS)                                 SVCLN     192
      IF (KERUDM.NE.0) GOTO 1300                                        SVCLN     193
C                                                                       SVCLN     194
      ICOLBV=1                                                          SVCLN     195
      NBR(1)=KSELF                                                      SVCLN     196
      IF (NBUSR.NE.0) THEN                                              SVCLN     197
         DO 1120 I=1,NBUSR                                              SVCLN     198
            ICOLBV=ICOLBV+1                                             SVCLN     199
            NBR(ICOLBV)=MBUSR(NBUSS+I)                                  SVCLN     200
 1120    CONTINUE                                                       SVCLN     201
      END IF                                                            SVCLN     202
C                                                                       SVCLN     203
C     SOLVE THE CONTROL EQUATIONS                                       SVCLN     204
C                                                                       SVCLN     205
      LREM=2*NBUSR                                                      SVCLN     206
      CALL AUDMC(IROWAK,LCYO,LWIF,LREM)                                 SVCLN     207
      IF (KERUDM.NE.0) GOTO 1300                                        SVCLN     208
C                                                                       SVCLN     209
C     FORM: XDOT=AX*X+BXI*DEL I+BXV*DEL V(S&R)+BREF*DEL VREF            SVCLN     210
C          DEL I=CX*X+ADEV*DEL I+YDEV*DEL V+YDEVR*DEL VR+CREF*DEL VREF  SVCLN     211
C                                                                       SVCLN     212
      DO 1130 I=1,KORD                                                  SVCLN     213
      DO 1130 J=1,KORD                                                  SVCLN     214
         AX(J,I)=AXB(J,I)                                               SVCLN     215
 1130 CONTINUE                                                          SVCLN     216
C                                                                       SVCLN     217
      DO 1140 I=1,KORD                                                  SVCLN     218
         BREF(I,1)=BUREF(I)                                             SVCLN     219
         BXI(I,1)=BUI(I,1)                                              SVCLN     220
         BXI(I,2)=BUI(I,2)                                              SVCLN     221
         BXV(I,1)=BUV(I,1)                                              SVCLN     222
         BXV(I,1)=BUV(I,2)                                              SVCLN     223
         CX(1,I)=CDEV(1)*CYX(1,I)                                       SVCLN     224
         CX(2,I)=CDEV(2)*CYX(1,I)                                       SVCLN     225
 1140 CONTINUE                                                          SVCLN     226
C                                                                       SVCLN     227
         CREF(1,1)=CDEV(1)*CYREF(1)                                     SVCLN     228
         CREF(2,1)=CDEV(2)*CYREF(1)                                     SVCLN     229
         ADEV(1,1)=CDEV(1)*CYI(1,1)                                     SVCLN     230
         ADEV(2,1)=CDEV(2)*CYI(1,1)                                     SVCLN     231
         ADEV(1,2)=CDEV(1)*CYI(1,2)                                     SVCLN     232
         ADEV(2,2)=CDEV(2)*CYI(1,2)                                     SVCLN     233
         YDEVS(1,1)=YDEVS(1,1)+CDEV(1)*CYV(1,1)                         SVCLN     234
         YDEVS(2,1)=YDEVS(2,1)+CDEV(2)*CYV(1,1)                         SVCLN     235
         YDEVS(1,2)=YDEVS(1,2)+CDEV(1)*CYV(1,2)                         SVCLN     236
         YDEVS(2,2)=YDEVS(2,2)+CDEV(2)*CYV(1,2)                         SVCLN     237
C                                                                       SVCLN     238
      IF (NBUSR.NE.0) THEN                                              SVCLN     239
         DO 1180 I=1,KORD                                               SVCLN     240
         DO 1180 J=1,2*NBUSR                                            SVCLN     241
            BXV(I,J+2)=BUVR(I,J)                                        SVCLN     242
 1180    CONTINUE                                                       SVCLN     243
         DO 1190 I=1,2*NBUSR                                            SVCLN     244
         YDEVR(1,I)=CDEV(1)*CYVR(1,I)                                   SVCLN     245
         YDEVR(2,I)=CDEV(2)*CYVR(1,I)                                   SVCLN     246
 1190    CONTINUE                                                       SVCLN     247
      END IF                                                            SVCLN     248
C                                                                       SVCLN     249
C     SOLVE THE DEVICE EQUATIONS                                        SVCLN     250
C                                                                       SVCLN     251
      LREF=1                                                            SVCLN     252
      CALL AUDMD(KORD,IROWAK,LREM,LREF)                                 SVCLN     253
      IF (KERUDM.NE.0) GOTO 1300                                        SVCLN     254
C                                                                       SVCLN     255
C     STORE THE REMOTE BUS ADMITANCE                                    SVCLN     256
C                                                                       SVCLN     257
C      IF (NBUSR.NE.0) THEN                                             SVCLN     258
C         DO 1200 K=1,NBUSR                                             SVCLN     259
C         DO 1200 J=1,2                                                 SVCLN     260
C         DO 1200 I=1,2                                                 SVCLN     261
C            KYUDM=KYUDM+1                                              SVCLN     262
C            YKUDM(KYUDM)=YDEVR(I,J+2*K-2)                              SVCLN     263
C 1200    CONTINUE                                                      SVCLN     264
C      END IF                                                           SVCLN     265
C                                                                       SVCLN     266
C     LOAD A, B, C, D MATRICES TO WORKING ARRAYS                        SVCLN     267
C                                                                       SVCLN     268
      DO 1210 I=1,IDMSN                                                 SVCLN     269
         DO 1220 J=1,IDMSN                                              SVCLN     270
            A(I,J)=AX(I,J)                                              SVCLN     271
 1220    CONTINUE                                                       SVCLN     272
         DO 1230 J=1,2*ICOLBV                                           SVCLN     273
            B(I,J)=BXV(I,J)                                             SVCLN     274
 1230    CONTINUE                                                       SVCLN     275
         AK(1,I)=CX(1,I)                                                SVCLN     276
         AK(2,I)=CX(2,I)                                                SVCLN     277
 1210 CONTINUE                                                          SVCLN     278
      YD(1,1)=YDEVS(1,1)-YSEL(1,1)                                      SVCLN     279
      YD(1,2)=YDEVS(1,2)-YSEL(1,2)                                      SVCLN     280
      YD(2,1)=YDEVS(2,1)-YSEL(2,1)                                      SVCLN     281
      YD(2,2)=YDEVS(2,2)-YSEL(2,2)                                      SVCLN     282
C                                                                       SVCLN     283
      GOTO 1500                                                         SVCLN     284
C                                                                       SVCLN     285
 1300 CONTINUE                                                          SVCLN     286
      MSG='SXDOT: ERROR IN JACOBIAN CALCULATION OF USER DEFINED SVC'    SVCLN     287
      CALL ASTOP(MSG,54)                                                SVCLN     288
C                                                                       SVCLN     289
 1500 CONTINUE                                                          SVCLN     290
C                                                                       SVCLN     291
C     FINALLY FORM AG, BG, CG MATRICES (JACOBIAN MATRICES)              SVCLN     292
C                                                                       SVCLN     293
      NAIDEX=IAIDEX                                                     SVCLN     294
      NBIDEX=IBIDEX                                                     SVCLN     295
      NCIDEX=ICIDEX                                                     SVCLN     296
C                                                                       SVCLN     297
      IF (IPATH.EQ.1) THEN                                              SVCLN     298
C                                                                       SVCLN     299
C     FOR USE IN THE NORMAL TRAPEZOIDAL INTEGRATION METHOD              SVCLN     300
C                                                                       SVCLN     301
      DO 800 I=1,IDMSN                                                  SVCLN     302
         DO 810 J=1,IDMSN                                               SVCLN     303
            IF (IA(I,J).EQ.0) GOTO 810                                  SVCLN     304
            A(I,J)=-CEFJM*A(I,J)                                        SVCLN     305
 810     CONTINUE                                                       SVCLN     306
         A(I,I)=A(I,I)+1.0                                              SVCLN     307
         DO 820 J=1,2*ICOLBV                                            SVCLN     308
            IF (IB(I,J).EQ.0) GOTO 820                                  SVCLN     309
            B(I,J)=-CEFJM*B(I,J)                                        SVCLN     310
 820     CONTINUE                                                       SVCLN     311
 800  CONTINUE                                                          SVCLN     312
C                                                                       SVCLN     313
      IF (IDMSN.EQ.0) GOTO 825                                          SVCLN     314
C                                                                       SVCLN     315
C     PERFORM LU FACTORIZATION FOR A                                    SVCLN     316
C                                                                       SVCLN     317
      CALL LUDCM(IDMSN)                                                 SVCLN     318
C                                                                       SVCLN     319
C     COMPUTE INVERSE(A)*B                                              SVCLN     320
C                                                                       SVCLN     321
      CALL FBSUBA(IDMSN)                                                SVCLN     322
C                                                                       SVCLN     323
C     STORE AK IN CJCOB ARRAY                                           SVCLN     324
C                                                                       SVCLN     325
         DO 840 J=1,IDMSN                                               SVCLN     326
         NCIDEX=NCIDEX+1                                                SVCLN     327
         CJCOB(NCIDEX)=-AK(1,J)                                         SVCLN     328
         CJCOB(NCIDEX+IDMSN)=-AK(2,J)                                   SVCLN     329
 840     CONTINUE                                                       SVCLN     330
         NCIDEX=NCIDEX+IDMSN                                            SVCLN     331
C                                                                       SVCLN     332
C     STORE A AND B IN AJCOB AND BJCOB ARRAY                            SVCLN     333
C                                                                       SVCLN     334
      DO 850 I=1,IDMSN                                                  SVCLN     335
         DO 860 J=1,IDMSN                                               SVCLN     336
            NAIDEX=NAIDEX+1                                             SVCLN     337
            AJCOB(NAIDEX)=A(I,J)                                        SVCLN     338
  860    CONTINUE                                                       SVCLN     339
  850 CONTINUE                                                          SVCLN     340
C                                                                       SVCLN     341
      DO 865 I=1,ICOLBV                                                 SVCLN     342
         NBIDEX=NBIDEX+1                                                SVCLN     343
         IBJCOB(NBIDEX)=NBR(I)                                          SVCLN     344
         IWS1=2*I                                                       SVCLN     345
         DO 866 J=1,IDMSN                                               SVCLN     346
            NBIDEX=NBIDEX+2                                             SVCLN     347
            BJCOB(NBIDEX-1)=B(J,IWS1-1)                                 SVCLN     348
            BJCOB(NBIDEX)=B(J,IWS1)                                     SVCLN     349
  866    CONTINUE                                                       SVCLN     350
  865 CONTINUE                                                          SVCLN     351
C                                                                       SVCLN     352
  825 CONTINUE                                                          SVCLN     353
C                                                                       SVCLN     354
      NBIDEX=NBIDEX+1                                                   SVCLN     355
      IBJCOB(NBIDEX)=0                                                  SVCLN     356
C                                                                       SVCLN     357
      ELSE                                                              SVCLN     358
C                                                                       SVCLN     359
C     FOR USE IN GEAR'S METHOD TO CALCULATE THE SECOND ORDER DERIVATIVESSVCLN     360
C                                                                       SVCLN     361
C      DO 860 ILR=1,ISTATE                                              SVCLN     362
C         DO 870 ILC=1,ISTATE                                           SVCLN     363
C            ADGEN(ILR,ILC,N)=A(ILR,ILC)                                SVCLN     364
C 870     CONTINUE                                                      SVCLN     365
C         DO 880 ILC=1,ICOLBV                                           SVCLN     366
C            BDGEN(ILR,ILC,N)=B(ILR,ILC)                                SVCLN     367
C 880     CONTINUE                                                      SVCLN     368
C         DO 890 ILC=1,IROWAK                                           SVCLN     369
C            AKDGEN(ILC,ILR,N)=-AK(ILC,ILR)                             SVCLN     370
C 890     CONTINUE                                                      SVCLN     371
C 860  CONTINUE                                                         SVCLN     372
C                                                                       SVCLN     373
      END IF                                                            SVCLN     374
C                                                                       SVCLN     375
      RETURN                                                            SVCLN     376
      END                                                               SVCLN     377
